[Git][ghc/ghc][master] 2 commits: Move LeadingUnderscore into Platform (#17957)
Marge Bot
gitlab at gitlab.haskell.org
Wed May 6 08:43:33 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
cab1871a by Sylvain Henry at 2020-05-06T04:43:21-04:00
Move LeadingUnderscore into Platform (#17957)
Avoid direct use of DynFlags to know if symbols must be prefixed by an
underscore.
- - - - -
94e7c563 by Sylvain Henry at 2020-05-06T04:43:21-04:00
Don't use DynFlags in showLinkerState (#17957)
- - - - -
8 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Runtime/Linker.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- ghc/GHCi/UI.hs
- libraries/ghc-boot/GHC/Platform.hs
- libraries/ghc-boot/GHC/Settings/Platform.hs
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -1218,7 +1218,7 @@ pprCLabel dflags = \case
maybe_underscore :: SDoc -> SDoc
maybe_underscore doc =
- if platformMisc_leadingUnderscore $ platformMisc dflags
+ if platformLeadingUnderscore platform
then pp_cSEP <> doc
else doc
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -135,7 +135,6 @@ module GHC.Driver.Session (
sGhcWithSMP,
sGhcRTSWays,
sTablesNextToCode,
- sLeadingUnderscore,
sLibFFI,
sGhcThreaded,
sGhcDebugged,
=====================================
compiler/GHC/Runtime/Linker.hs
=====================================
@@ -234,11 +234,10 @@ withExtendedLinkEnv dl new_env action
-- | Display the persistent linker state.
-showLinkerState :: DynLinker -> DynFlags -> IO ()
-showLinkerState dl dflags
+showLinkerState :: DynLinker -> IO SDoc
+showLinkerState dl
= do pls <- readPLS dl
- putLogMsg dflags NoReason SevDump noSrcSpan
- $ withPprStyle defaultDumpStyle
+ return $ withPprStyle defaultDumpStyle
(vcat [text "----- Linker state -----",
text "Pkgs:" <+> ppr (pkgs_loaded pls),
text "Objs:" <+> ppr (objs_loaded pls),
=====================================
compiler/GHC/Settings.hs
=====================================
@@ -62,7 +62,6 @@ module GHC.Settings
, sGhcWithSMP
, sGhcRTSWays
, sTablesNextToCode
- , sLeadingUnderscore
, sLibFFI
, sGhcThreaded
, sGhcDebugged
@@ -277,8 +276,6 @@ sGhcRTSWays :: Settings -> String
sGhcRTSWays = platformMisc_ghcRTSWays . sPlatformMisc
sTablesNextToCode :: Settings -> Bool
sTablesNextToCode = platformMisc_tablesNextToCode . sPlatformMisc
-sLeadingUnderscore :: Settings -> Bool
-sLeadingUnderscore = platformMisc_leadingUnderscore . sPlatformMisc
sLibFFI :: Settings -> Bool
sLibFFI = platformMisc_libFFI . sPlatformMisc
sGhcThreaded :: Settings -> Bool
=====================================
compiler/GHC/Settings/IO.hs
=====================================
@@ -166,7 +166,6 @@ initSettings top_dir = do
ghcWithNativeCodeGen <- getBooleanSetting "Use native code generator"
ghcWithSMP <- getBooleanSetting "Support SMP"
ghcRTSWays <- getSetting "RTS ways"
- leadingUnderscore <- getBooleanSetting "Leading underscore"
useLibFFI <- getBooleanSetting "Use LibFFI"
ghcThreaded <- getBooleanSetting "Use Threads"
ghcDebugged <- getBooleanSetting "Use Debugging"
@@ -237,7 +236,6 @@ initSettings top_dir = do
, platformMisc_ghcWithSMP = ghcWithSMP
, platformMisc_ghcRTSWays = ghcRTSWays
, platformMisc_tablesNextToCode = tablesNextToCode
- , platformMisc_leadingUnderscore = leadingUnderscore
, platformMisc_libFFI = useLibFFI
, platformMisc_ghcThreaded = ghcThreaded
, platformMisc_ghcDebugged = ghcDebugged
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -3047,7 +3047,10 @@ showCmd str = do
, action "imports" $ showImports
, action "modules" $ showModules
, action "bindings" $ showBindings
- , action "linker" $ getDynFlags >>= liftIO . (showLinkerState (hsc_dynLinker hsc_env))
+ , action "linker" $ do
+ msg <- liftIO $ showLinkerState (hsc_dynLinker hsc_env)
+ dflags <- getDynFlags
+ liftIO $ putLogMsg dflags NoReason SevDump noSrcSpan msg
, action "breaks" $ showBkptTable
, action "context" $ showContext
, action "packages" $ showPackages
=====================================
libraries/ghc-boot/GHC/Platform.hs
=====================================
@@ -55,16 +55,17 @@ data PlatformMini
deriving (Read, Show, Eq)
-- | Contains enough information for the native code generator to emit
--- code for this platform.
+-- code for this platform.
data Platform = Platform
- { platformMini :: PlatformMini
- , platformWordSize :: PlatformWordSize
- , platformByteOrder :: ByteOrder
- , platformUnregisterised :: Bool
- , platformHasGnuNonexecStack :: Bool
- , platformHasIdentDirective :: Bool
- , platformHasSubsectionsViaSymbols :: Bool
- , platformIsCrossCompiling :: Bool
+ { platformMini :: !PlatformMini
+ , platformWordSize :: !PlatformWordSize -- ^ Word size
+ , platformByteOrder :: !ByteOrder -- ^ Byte order (endianness)
+ , platformUnregisterised :: !Bool
+ , platformHasGnuNonexecStack :: !Bool
+ , platformHasIdentDirective :: !Bool
+ , platformHasSubsectionsViaSymbols :: !Bool
+ , platformIsCrossCompiling :: !Bool
+ , platformLeadingUnderscore :: !Bool -- ^ Symbols need underscore prefix
}
deriving (Read, Show, Eq)
@@ -301,7 +302,6 @@ data PlatformMisc = PlatformMisc
-- before the entry code, or with an indirection to the entry code. See
-- TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.
, platformMisc_tablesNextToCode :: Bool
- , platformMisc_leadingUnderscore :: Bool
, platformMisc_libFFI :: Bool
, platformMisc_ghcThreaded :: Bool
, platformMisc_ghcDebugged :: Bool
=====================================
libraries/ghc-boot/GHC/Settings/Platform.hs
=====================================
@@ -37,6 +37,7 @@ getTargetPlatform settingsFile mySettings = do
targetOS <- readSetting "target os"
targetWordSize <- readSetting "target word size"
targetWordBigEndian <- getBooleanSetting "target word big endian"
+ targetLeadingUnderscore <- getBooleanSetting "Leading underscore"
targetUnregisterised <- getBooleanSetting "Unregisterised"
targetHasGnuNonexecStack <- getBooleanSetting "target has GNU nonexec stack"
targetHasIdentDirective <- getBooleanSetting "target has .ident directive"
@@ -55,6 +56,7 @@ getTargetPlatform settingsFile mySettings = do
, platformHasIdentDirective = targetHasIdentDirective
, platformHasSubsectionsViaSymbols = targetHasSubsectionsViaSymbols
, platformIsCrossCompiling = crossCompiling
+ , platformLeadingUnderscore = targetLeadingUnderscore
}
-----------------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a95e7fe02efd2fdeec91ba46de64bc78c81381eb...94e7c563ab24fe452a16900a6777349970df1945
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a95e7fe02efd2fdeec91ba46de64bc78c81381eb...94e7c563ab24fe452a16900a6777349970df1945
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200506/ce190037/attachment-0001.html>
More information about the ghc-commits
mailing list