Remove all target-specific portions of Config.hs
authorJohn Ericson <git@JohnEricson.me>
Wed, 27 Mar 2019 04:27:01 +0000 (00:27 -0400)
committerBen Gamari <ben@smart-cactus.org>
Tue, 14 May 2019 20:41:19 +0000 (16:41 -0400)
1. If GHC is to be multi-target, these cannot be baked in at compile
   time.

2. Compile-time flags have a higher maintenance than run-time flags.

3. The old way makes build system implementation (various bootstrapping
   details) with the thing being built. E.g. GHC doesn't need to care
   about which integer library *will* be used---this is purely a crutch
   so the build system doesn't need to pass flags later when using that
   library.

4. Experience with cross compilation in Nixpkgs has shown things work
   nicer when compiler's can *optionally* delegate the bootstrapping the
   package manager. The package manager knows the entire end-goal build
   plan, and thus can make top-down decisions on bootstrapping. GHC can
   just worry about GHC, not even core library like base and ghc-prim!

14 files changed:
compiler/cmm/CLabel.hs
compiler/coreSyn/CorePrep.hs
compiler/deSugar/DsForeign.hs
compiler/ghc.mk
compiler/llvmGen/LlvmCodeGen/Base.hs
compiler/main/CodeOutput.hs
compiler/main/DriverPipeline.hs
compiler/main/DynFlags.hs
compiler/main/GhcMake.hs
compiler/main/SysTools.hs
compiler/nativeGen/AsmCodeGen.hs
compiler/nativeGen/PIC.hs
hadrian/src/Rules/Generate.hs
includes/ghc.mk

index 81a226d..fddb063 100644 (file)
@@ -120,7 +120,6 @@ import Module
 import Name
 import Unique
 import PrimOp
-import Config
 import CostCentre
 import Outputable
 import FastString
@@ -1151,35 +1150,35 @@ and are not externally visible.
 -}
 
 instance Outputable CLabel where
-  ppr c = sdocWithPlatform $ \platform -> pprCLabel platform c
+  ppr c = sdocWithDynFlags $ \dynFlags -> pprCLabel dynFlags c
 
-pprCLabel :: Platform -> CLabel -> SDoc
+pprCLabel :: DynFlags -> CLabel -> SDoc
 
 pprCLabel _ (LocalBlockLabel u)
   =  tempLabelPrefixOrUnderscore <> pprUniqueAlways u
 
-pprCLabel platform (AsmTempLabel u)
- | not (platformUnregisterised platform)
+pprCLabel dynFlags (AsmTempLabel u)
+ | not (platformUnregisterised $ targetPlatform dynFlags)
   =  tempLabelPrefixOrUnderscore <> pprUniqueAlways u
 
-pprCLabel platform (AsmTempDerivedLabel l suf)
- | cGhcWithNativeCodeGen == "YES"
-   = ptext (asmTempLabelPrefix platform)
+pprCLabel dynFlags (AsmTempDerivedLabel l suf)
+ | sGhcWithNativeCodeGen $ settings dynFlags
+   = ptext (asmTempLabelPrefix $ targetPlatform dynFlags)
      <> case l of AsmTempLabel u    -> pprUniqueAlways u
                   LocalBlockLabel u -> pprUniqueAlways u
-                  _other            -> pprCLabel platform l
+                  _other            -> pprCLabel dynFlags l
      <> ftext suf
 
-pprCLabel platform (DynamicLinkerLabel info lbl)
- | cGhcWithNativeCodeGen == "YES"
-   = pprDynamicLinkerAsmLabel platform info lbl
+pprCLabel dynFlags (DynamicLinkerLabel info lbl)
+ | sGhcWithNativeCodeGen $ settings dynFlags
+   = pprDynamicLinkerAsmLabel (targetPlatform dynFlags) info lbl
 
-pprCLabel _ PicBaseLabel
- | cGhcWithNativeCodeGen == "YES"
+pprCLabel dynFlags PicBaseLabel
+ | sGhcWithNativeCodeGen $ settings dynFlags
    = text "1b"
 
-pprCLabel platform (DeadStripPreventer lbl)
- | cGhcWithNativeCodeGen == "YES"
+pprCLabel dynFlags (DeadStripPreventer lbl)
+ | sGhcWithNativeCodeGen $ settings dynFlags
    =
    {-
       `lbl` can be temp one but we need to ensure that dsp label will stay
@@ -1187,23 +1186,24 @@ pprCLabel platform (DeadStripPreventer lbl)
       optional `_` (underscore) because this is how you mark non-temp symbols
       on some platforms (Darwin)
    -}
-   maybe_underscore $ text "dsp_"
-   <> pprCLabel platform lbl <> text "_dsp"
+   maybe_underscore dynFlags $ text "dsp_"
+   <> pprCLabel dynFlags lbl <> text "_dsp"
 
-pprCLabel _ (StringLitLabel u)
- | cGhcWithNativeCodeGen == "YES"
+pprCLabel dynFlags (StringLitLabel u)
+ | sGhcWithNativeCodeGen $ settings dynFlags
   = pprUniqueAlways u <> ptext (sLit "_str")
 
-pprCLabel platform lbl
+pprCLabel dynFlags lbl
    = getPprStyle $ \ sty ->
-     if cGhcWithNativeCodeGen == "YES" && asmStyle sty
-     then maybe_underscore (pprAsmCLbl platform lbl)
+     if sGhcWithNativeCodeGen (settings dynFlags) && asmStyle sty
+     then maybe_underscore dynFlags $ pprAsmCLbl (targetPlatform dynFlags) lbl
      else pprCLbl lbl
 
-maybe_underscore :: SDoc -> SDoc
-maybe_underscore doc
-  | underscorePrefix = pp_cSEP <> doc
-  | otherwise        = doc
+maybe_underscore :: DynFlags -> SDoc -> SDoc
+maybe_underscore dynFlags doc =
+  if sLeadingUnderscore $ settings dynFlags
+  then pp_cSEP <> doc
+  else doc
 
 pprAsmCLbl :: Platform -> CLabel -> SDoc
 pprAsmCLbl platform (ForeignLabel fs (Just sz) _ _)
@@ -1363,9 +1363,6 @@ tempLabelPrefixOrUnderscore = sdocWithPlatform $ \platform ->
 -- -----------------------------------------------------------------------------
 -- Machine-dependent knowledge about labels.
 
-underscorePrefix :: Bool   -- leading underscore on assembler labels?
-underscorePrefix = (cLeadingUnderscore == "YES")
-
 asmTempLabelPrefix :: Platform -> PtrString  -- for formatting labels
 asmTempLabelPrefix platform = case platformOS platform of
     OSDarwin -> sLit "L"
index bf6182b..e49ffb5 100644 (file)
@@ -55,7 +55,6 @@ import Pair
 import Outputable
 import Platform
 import FastString
-import Config
 import Name             ( NamedThing(..), nameSrcSpan )
 import SrcLoc           ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc )
 import Data.Bits
index 95a5e4a..4df053d 100644 (file)
@@ -50,7 +50,6 @@ import Outputable
 import FastString
 import DynFlags
 import Platform
-import Config
 import OrdList
 import Pair
 import Util
@@ -542,7 +541,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc
         | otherwise = text ('a':show n)
 
   -- generate a libffi-style stub if this is a "wrapper" and libffi is enabled
-  libffi = cLibFFI && isNothing maybe_target
+  libffi = sLibFFI (settings dflags) && isNothing maybe_target
 
   type_string
       -- libffi needs to know the result type too:
index 18c3425..b8c0a1a 100644 (file)
@@ -55,10 +55,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
        @echo                                                               >> $@
        @echo '#include "ghc_boot_platform.h"'                              >> $@
        @echo                                                               >> $@
-       @echo 'data IntegerLibrary = IntegerGMP'                            >> $@
-       @echo '                    | IntegerSimple'                         >> $@
-       @echo '                    deriving Eq'                             >> $@
-       @echo                                                               >> $@
        @echo 'cBuildPlatformString :: String'                              >> $@
        @echo 'cBuildPlatformString = BuildPlatform_NAME'                   >> $@
        @echo 'cHostPlatformString :: String'                               >> $@
@@ -82,52 +78,6 @@ compiler/stage%/build/Config.hs : mk/config.mk mk/project.mk | $$(dir $$@)/.
        @echo 'cBooterVersion        = "$(GhcVersion)"'                     >> $@
        @echo 'cStage                :: String'                             >> $@
        @echo 'cStage                = show (STAGE :: Int)'                 >> $@
-       @echo 'cIntegerLibraryType   :: IntegerLibrary'                     >> $@
-ifeq "$(INTEGER_LIBRARY)" "integer-gmp"
-       @echo 'cIntegerLibraryType   = IntegerGMP'                          >> $@
-else ifeq "$(INTEGER_LIBRARY)" "integer-simple"
-       @echo 'cIntegerLibraryType   = IntegerSimple'                       >> $@
-else ifneq "$(CLEANING)" "YES"
-$(error Unknown integer library)
-endif
-       @echo 'cGhcWithInterpreter   :: String'                             >> $@
-       @echo 'cGhcWithInterpreter   = "$(GhcWithInterpreter)"'             >> $@
-       @echo 'cGhcWithNativeCodeGen :: String'                             >> $@
-       @echo 'cGhcWithNativeCodeGen = "$(GhcWithNativeCodeGen)"'           >> $@
-       @echo 'cGhcWithSMP           :: String'                             >> $@
-       @echo 'cGhcWithSMP           = "$(GhcWithSMP)"'                     >> $@
-       @echo 'cGhcRTSWays           :: String'                             >> $@
-       @echo 'cGhcRTSWays           = "$(GhcRTSWays)"'                     >> $@
-       @echo 'cGhcRtsWithLibdw      :: Bool'                               >> $@
-ifeq "$(GhcRtsWithLibdw)" "YES"
-       @echo 'cGhcRtsWithLibdw      = True'                                >> $@
-else
-       @echo 'cGhcRtsWithLibdw      = False'                               >> $@
-endif
-       @echo 'cLeadingUnderscore    :: String'                             >> $@
-       @echo 'cLeadingUnderscore    = "$(LeadingUnderscore)"'              >> $@
-       @echo 'cLibFFI               :: Bool'                               >> $@
-ifeq "$(UseLibFFIForAdjustors)" "YES"
-       @echo 'cLibFFI               = True'                                >> $@
-else
-       @echo 'cLibFFI               = False'                               >> $@
-endif
-# Note that GhcThreaded just reflects the Makefile variable setting.
-# In particular, the stage1 compiler is never actually compiled with
-# -threaded, but it will nevertheless have cGhcThreaded = True.
-# The "+RTS --info" output will show what RTS GHC is really using.
-       @echo 'cGhcThreaded :: Bool'                                        >> $@
-ifeq "$(GhcThreaded)" "YES"
-       @echo 'cGhcThreaded = True'                                         >> $@
-else
-       @echo 'cGhcThreaded = False'                                        >> $@
-endif
-       @echo 'cGhcDebugged :: Bool'                                        >> $@
-ifeq "$(GhcDebugged)" "YES"
-       @echo 'cGhcDebugged = True'                                         >> $@
-else
-       @echo 'cGhcDebugged = False'                                        >> $@
-endif
        @echo done.
 
 # -----------------------------------------------------------------------------
index 15101c8..d55c339 100644 (file)
@@ -390,17 +390,15 @@ ghcInternalFunctions = do
 -- | Pretty print a 'CLabel'.
 strCLabel_llvm :: CLabel -> LlvmM LMString
 strCLabel_llvm lbl = do
-    platform <- getLlvmPlatform
     dflags <- getDynFlags
-    let sdoc = pprCLabel platform lbl
+    let sdoc = pprCLabel dflags lbl
         str = Outp.renderWithStyle dflags sdoc (Outp.mkCodeStyle Outp.CStyle)
     return (fsLit str)
 
 strDisplayName_llvm :: CLabel -> LlvmM LMString
 strDisplayName_llvm lbl = do
-    platform <- getLlvmPlatform
     dflags <- getDynFlags
-    let sdoc = pprCLabel platform lbl
+    let sdoc = pprCLabel dflags lbl
         depth = Outp.PartWay 1
         style = Outp.mkUserStyle dflags Outp.reallyAlwaysQualify depth
         str = Outp.renderWithStyle dflags sdoc style
@@ -416,9 +414,8 @@ dropInfoSuffix = go
 
 strProcedureName_llvm :: CLabel -> LlvmM LMString
 strProcedureName_llvm lbl = do
-    platform <- getLlvmPlatform
     dflags <- getDynFlags
-    let sdoc = pprCLabel platform lbl
+    let sdoc = pprCLabel dflags lbl
         depth = Outp.PartWay 1
         style = Outp.mkUserStyle dflags Outp.neverQualify depth
         str = Outp.renderWithStyle dflags sdoc style
index 478de59..1ded721 100644 (file)
@@ -24,7 +24,6 @@ import Packages
 import Cmm              ( RawCmmGroup )
 import HscTypes
 import DynFlags
-import Config
 import Stream           (Stream)
 import qualified Stream
 import FileCleanup
@@ -156,7 +155,7 @@ outputAsm :: DynFlags -> Module -> ModLocation -> FilePath
           -> Stream IO RawCmmGroup ()
           -> IO ()
 outputAsm dflags this_mod location filenm cmm_stream
- | cGhcWithNativeCodeGen == "YES"
+ | sGhcWithNativeCodeGen $ settings dflags
   = do ncg_uniqs <- mkSplitUniqSupply 'n'
 
        debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm)
@@ -226,8 +225,9 @@ outputForeignStubs dflags mod location stubs
             mk_include i = "#include \"" ++ i ++ "\"\n"
 
             -- wrapper code mentions the ffi_arg type, which comes from ffi.h
-            ffi_includes | cLibFFI   = "#include \"ffi.h\"\n"
-                         | otherwise = ""
+            ffi_includes
+              | sLibFFI $ settings dflags = "#include \"ffi.h\"\n"
+              | otherwise = ""
 
         stub_h_file_exists
            <- outputForeignStubs_help stub_h stub_h_output_w
index 82a6d60..d224623 100644 (file)
@@ -49,7 +49,6 @@ import Outputable
 import Module
 import ErrUtils
 import DynFlags
-import Config
 import Panic
 import Util
 import StringBuffer     ( hGetStringBuffer )
@@ -369,7 +368,7 @@ link ghcLink dflags
   = lookupHook linkHook l dflags ghcLink dflags
   where
     l LinkInMemory _ _ _
-      = if cGhcWithInterpreter == "YES"
+      = if sGhcWithInterpreter $ settings dflags
         then -- Not Linking...(demand linker will do the job)
              return Succeeded
         else panicBadLink LinkInMemory
index ece0c22..d40a9ab 100644 (file)
@@ -87,6 +87,7 @@ module DynFlags (
 
         -- ** System tool settings and locations
         Settings(..),
+        IntegerLibrary(..),
         targetPlatform, programName, projectVersion,
         ghcUsagePath, ghciUsagePath, topDir, tmpDir, rawSettings,
         versionedAppDir,
@@ -1302,6 +1303,11 @@ type LlvmTargets = [(String, LlvmTarget)]
 type LlvmPasses = [(Int, String)]
 type LlvmConfig = (LlvmTargets, LlvmPasses)
 
+data IntegerLibrary
+    = IntegerGMP
+    | IntegerSimple
+    deriving (Read, Show, Eq)
+
 data Settings = Settings {
   sTargetPlatform        :: Platform,       -- Filled in by SysTools
   sGhcUsagePath          :: FilePath,       -- ditto
@@ -1358,7 +1364,18 @@ data Settings = Settings {
 
   -- Formerly Config.hs, target specific
   sTargetPlatformString :: String, -- TODO Recalculate string from richer info?
-  sTablesNextToCode :: Bool
+  sIntegerLibrary        :: String,
+  sIntegerLibraryType    :: IntegerLibrary,
+  sGhcWithInterpreter    :: Bool,
+  sGhcWithNativeCodeGen  :: Bool,
+  sGhcWithSMP            :: Bool,
+  sGhcRTSWays            :: String,
+  sTablesNextToCode      :: Bool,
+  sLeadingUnderscore     :: Bool,
+  sLibFFI                :: Bool,
+  sGhcThreaded           :: Bool,
+  sGhcDebugged           :: Bool,
+  sGhcRtsWithLibdw       :: Bool
  }
 
 targetPlatform :: DynFlags -> Platform
@@ -1615,16 +1632,18 @@ instance Outputable PackageFlag where
     ppr (ExposePackage n arg rn) = text n <> braces (ppr arg <+> ppr rn)
     ppr (HidePackage str) = text "-hide-package" <+> text str
 
-defaultHscTarget :: Platform -> HscTarget
+defaultHscTarget :: Settings -> HscTarget
 defaultHscTarget = defaultObjectTarget
 
 -- | The 'HscTarget' value corresponding to the default way to create
 -- object files on the current platform.
-defaultObjectTarget :: Platform -> HscTarget
-defaultObjectTarget platform
+defaultObjectTarget :: Settings -> HscTarget
+defaultObjectTarget settings
   | platformUnregisterised platform     =  HscC
-  | cGhcWithNativeCodeGen == "YES"      =  HscAsm
+  | sGhcWithNativeCodeGen settings      =  HscAsm
   | otherwise                           =  HscLlvm
+  where
+    platform = sTargetPlatform settings
 
 -- Determines whether we will be compiling
 -- info tables that reside just before the entry code, or with an
@@ -1887,8 +1906,8 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
      DynFlags {
         ghcMode                 = CompManager,
         ghcLink                 = LinkBinary,
-        hscTarget               = defaultHscTarget (sTargetPlatform mySettings),
-        integerLibrary          = cIntegerLibraryType,
+        hscTarget               = defaultHscTarget mySettings,
+        integerLibrary          = sIntegerLibraryType mySettings,
         verbosity               = 0,
         optLevel                = 0,
         debugLevel              = 0,
@@ -3704,7 +3723,7 @@ dynamic_flags_deps = [
   , make_ord_flag defFlag "fno-code"         (NoArg ((upd $ \d ->
                   d { ghcLink=NoLink }) >> setTarget HscNothing))
   , make_ord_flag defFlag "fbyte-code"       (NoArg (setTarget HscInterpreted))
-  , make_ord_flag defFlag "fobject-code"     (NoArg (setTargetWithPlatform
+  , make_ord_flag defFlag "fobject-code"     (NoArg (setTargetWithSettings
                                                              defaultHscTarget))
   , make_dep_flag defFlag "fglasgow-exts"
       (NoArg enableGlasgowExts) "Use individual extensions instead"
@@ -5386,12 +5405,12 @@ interpretPackageEnv dflags = do
 -- If we're linking a binary, then only targets that produce object
 -- code are allowed (requests for other target types are ignored).
 setTarget :: HscTarget -> DynP ()
-setTarget l = setTargetWithPlatform (const l)
+setTarget l = setTargetWithSettings (const l)
 
-setTargetWithPlatform :: (Platform -> HscTarget) -> DynP ()
-setTargetWithPlatform f = upd set
+setTargetWithSettings :: (Settings -> HscTarget) -> DynP ()
+setTargetWithSettings f = upd set
   where
-   set dfs = let l = f (targetPlatform dfs)
+   set dfs = let l = f (settings dfs)
              in if ghcLink dfs /= LinkBinary || isObjectTarget l
                 then dfs{ hscTarget = l }
                 else dfs
@@ -5623,13 +5642,13 @@ compilerInfo dflags
        ("Build platform",              cBuildPlatformString),
        ("Host platform",               cHostPlatformString),
        ("Target platform",             sTargetPlatformString $ settings dflags),
-       ("Have interpreter",            cGhcWithInterpreter),
+       ("Have interpreter",            showBool $ sGhcWithInterpreter $ settings dflags),
        ("Object splitting supported",  showBool False),
-       ("Have native code generator",  cGhcWithNativeCodeGen),
-       ("Support SMP",                 cGhcWithSMP),
+       ("Have native code generator",  showBool $ sGhcWithNativeCodeGen $ settings dflags),
+       ("Support SMP",                 showBool $ sGhcWithSMP $ settings dflags),
        ("Tables next to code",         showBool $ sTablesNextToCode $ settings dflags),
-       ("RTS ways",                    cGhcRTSWays),
-       ("RTS expects libdw",           showBool cGhcRtsWithLibdw),
+       ("RTS ways",                    sGhcRTSWays $ settings dflags),
+       ("RTS expects libdw",           showBool $ sGhcRtsWithLibdw $ settings dflags),
        -- Whether or not we support @-dynamic-too@
        ("Support dynamic-too",         showBool $ not isWindows),
        -- Whether or not we support the @-j@ flag with @--make@.
@@ -5656,7 +5675,7 @@ compilerInfo dflags
        ("GHC Dynamic",                 showBool dynamicGhc),
        -- Whether or not GHC was compiled using -prof
        ("GHC Profiled",                showBool rtsIsProfiled),
-       ("Leading underscore",          cLeadingUnderscore),
+       ("Leading underscore",          showBool $ sLeadingUnderscore $ settings dflags),
        ("Debug on",                    show debugIsOn),
        ("LibDir",                      topDir dflags),
        -- The path of the global package database used by GHC
@@ -5747,7 +5766,7 @@ makeDynFlagsConsistent dflags
       in loop dflags' warn
  | hscTarget dflags == HscC &&
    not (platformUnregisterised (targetPlatform dflags))
-    = if cGhcWithNativeCodeGen == "YES"
+    = if sGhcWithNativeCodeGen $ settings dflags
       then let dflags' = dflags { hscTarget = HscAsm }
                warn = "Compiler not unregisterised, so using native code generator rather than compiling via C"
            in loop dflags' warn
@@ -5763,7 +5782,7 @@ makeDynFlagsConsistent dflags
     = loop (dflags { hscTarget = HscC })
            "Compiler unregisterised, so compiling via C"
  | hscTarget dflags == HscAsm &&
-   cGhcWithNativeCodeGen /= "YES"
+   not (sGhcWithNativeCodeGen $ settings dflags)
       = let dflags' = dflags { hscTarget = HscLlvm }
             warn = "No native code generator, so using LLVM"
         in loop dflags' warn
index d730fe7..fe4c978 100644 (file)
@@ -1953,7 +1953,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
        -- See Note [-fno-code mode] #8025
        map1 <- if hscTarget dflags == HscNothing
          then enableCodeGenForTH
-           (defaultObjectTarget (targetPlatform dflags))
+           (defaultObjectTarget (settings dflags))
            map0
          else return map0
        return $ concat $ nodeMapElts map1
index 50cc6d5..b3dc606 100644 (file)
@@ -259,6 +259,29 @@ initSysTools top_dir
                           platformIsCrossCompiling = crossCompiling
                       }
 
+       integerLibrary <- getSetting "integer library"
+       integerLibraryType <- case integerLibrary of
+         "integer-gmp" -> pure IntegerGMP
+         "integer-simple" -> pure IntegerSimple
+         _ -> pgmError $ unwords
+           [ "Entry for"
+           , show "integer library"
+           , "must be one of"
+           , show "integer-gmp"
+           , "or"
+           , show "integer-simple"
+           ]
+
+       ghcWithInterpreter <- getBooleanSetting "Use interpreter"
+       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"
+       ghcRtsWithLibdw <- getBooleanSetting "RTS expects libdw"
+
        return $ Settings {
                     sTargetPlatform = platform,
                     sTmpDir         = normalise tmpdir,
@@ -306,8 +329,20 @@ initSysTools top_dir
                     sOpt_lc      = [],
                     sOpt_i       = [],
                     sPlatformConstants = platformConstants,
+
                     sTargetPlatformString = targetPlatformString,
-                    sTablesNextToCode = tablesNextToCode
+                    sIntegerLibrary = integerLibrary,
+                    sIntegerLibraryType = integerLibraryType,
+                    sGhcWithInterpreter = ghcWithInterpreter,
+                    sGhcWithNativeCodeGen = ghcWithNativeCodeGen,
+                    sGhcWithSMP = ghcWithSMP,
+                    sGhcRTSWays = ghcRTSWays,
+                    sTablesNextToCode = tablesNextToCode,
+                    sLeadingUnderscore = leadingUnderscore,
+                    sLibFFI = useLibFFI,
+                    sGhcThreaded = ghcThreaded,
+                    sGhcDebugged = ghcDebugged,
+                    sGhcRtsWithLibdw = ghcRtsWithLibdw
              }
 
 
@@ -383,10 +418,12 @@ linkDynLib dflags0 o_files dep_packages
         -- against libHSrts, then both end up getting loaded,
         -- and things go wrong. We therefore link the libraries
         -- with the same RTS flags that we link GHC with.
-        dflags1 = if cGhcThreaded then addWay' WayThreaded dflags0
-                                  else                     dflags0
-        dflags2 = if cGhcDebugged then addWay' WayDebug dflags1
-                                  else                  dflags1
+        dflags1 = if sGhcThreaded $ settings dflags0
+          then addWay' WayThreaded dflags0
+          else                     dflags0
+        dflags2 = if sGhcDebugged $ settings dflags1
+          then addWay' WayDebug dflags1
+          else                  dflags1
         dflags = updateWays dflags2
 
         verbFlags = getVerbFlags dflags
index c78ea5f..2d0bf30 100644 (file)
@@ -852,7 +852,7 @@ makeImportsDoc dflags imports
                 | otherwise
                 = Outputable.empty
 
-        doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel platform lbl) astyle)
+        doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel dflags lbl) astyle)
         astyle = mkCodeStyle AsmStyle
 
 -- -----------------------------------------------------------------------------
index b4bf899..69113e8 100644 (file)
@@ -565,19 +565,19 @@ pprGotDeclaration _ _ _
 --
 
 pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc
-pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
+pprImportedSymbol dflags (Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
         | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
         = case positionIndependent dflags of
            False ->
             vcat [
                 text ".symbol_stub",
-                text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
-                    text "\t.indirect_symbol" <+> pprCLabel platform lbl,
-                    text "\tjmp *L" <> pprCLabel platform lbl
+                text "L" <> pprCLabel dflags lbl <> ptext (sLit "$stub:"),
+                    text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
+                    text "\tjmp *L" <> pprCLabel dflags lbl
                         <> text "$lazy_ptr",
-                text "L" <> pprCLabel platform lbl
+                text "L" <> pprCLabel dflags lbl
                     <> text "$stub_binder:",
-                    text "\tpushl $L" <> pprCLabel platform lbl
+                    text "\tpushl $L" <> pprCLabel dflags lbl
                         <> text "$lazy_ptr",
                     text "\tjmp dyld_stub_binding_helper"
             ]
@@ -585,16 +585,16 @@ pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS
             vcat [
                 text ".section __TEXT,__picsymbolstub2,"
                     <> text "symbol_stubs,pure_instructions,25",
-                text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
-                    text "\t.indirect_symbol" <+> pprCLabel platform lbl,
+                text "L" <> pprCLabel dflags lbl <> ptext (sLit "$stub:"),
+                    text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
                     text "\tcall ___i686.get_pc_thunk.ax",
                 text "1:",
-                    text "\tmovl L" <> pprCLabel platform lbl
+                    text "\tmovl L" <> pprCLabel dflags lbl
                         <> text "$lazy_ptr-1b(%eax),%edx",
                     text "\tjmp *%edx",
-                text "L" <> pprCLabel platform lbl
+                text "L" <> pprCLabel dflags lbl
                     <> text "$stub_binder:",
-                    text "\tlea L" <> pprCLabel platform lbl
+                    text "\tlea L" <> pprCLabel dflags lbl
                         <> text "$lazy_ptr-1b(%eax),%eax",
                     text "\tpushl %eax",
                     text "\tjmp dyld_stub_binding_helper"
@@ -602,16 +602,16 @@ pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS
           $+$ vcat [        text ".section __DATA, __la_sym_ptr"
                     <> (if positionIndependent dflags then int 2 else int 3)
                     <> text ",lazy_symbol_pointers",
-                text "L" <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
-                    text "\t.indirect_symbol" <+> pprCLabel platform lbl,
-                    text "\t.long L" <> pprCLabel platform lbl
+                text "L" <> pprCLabel dflags lbl <> ptext (sLit "$lazy_ptr:"),
+                    text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
+                    text "\t.long L" <> pprCLabel dflags lbl
                     <> text "$stub_binder"]
 
         | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
         = vcat [
                 text ".non_lazy_symbol_pointer",
-                char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr:",
-                text "\t.indirect_symbol" <+> pprCLabel platform lbl,
+                char 'L' <> pprCLabel dflags lbl <> text "$non_lazy_ptr:",
+                text "\t.indirect_symbol" <+> pprCLabel dflags lbl,
                 text "\t.long\t0"]
 
         | otherwise
@@ -632,12 +632,12 @@ pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
 --
 -- NB: No DSO-support yet
 
-pprImportedSymbol _ platform@(Platform { platformOS = OSAIX }) importedLbl
+pprImportedSymbol dflags (Platform { platformOS = OSAIX }) importedLbl
         = case dynamicLinkerLabelInfo importedLbl of
             Just (SymbolPtr, lbl)
               -> vcat [
-                   text "LC.." <> pprCLabel platform lbl <> char ':',
-                   text "\t.long" <+> pprCLabel platform lbl ]
+                   text "LC.." <> pprCLabel dflags lbl <> char ':',
+                   text "\t.long" <+> pprCLabel dflags lbl ]
             _ -> empty
 
 -- ELF / Linux
@@ -669,15 +669,15 @@ pprImportedSymbol _ platform@(Platform { platformOS = OSAIX }) importedLbl
 -- the NCG will keep track of all DynamicLinkerLabels it uses
 -- and output each of them using pprImportedSymbol.
 
-pprImportedSymbol _ platform@(Platform { platformArch = ArchPPC_64 _ })
+pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC_64 _ })
                   importedLbl
         | osElfTarget (platformOS platform)
         = case dynamicLinkerLabelInfo importedLbl of
             Just (SymbolPtr, lbl)
               -> vcat [
                    text ".section \".toc\", \"aw\"",
-                   text ".LC_" <> pprCLabel platform lbl <> char ':',
-                   text "\t.quad" <+> pprCLabel platform lbl ]
+                   text ".LC_" <> pprCLabel dflags lbl <> char ':',
+                   text "\t.quad" <+> pprCLabel dflags lbl ]
             _ -> empty
 
 pprImportedSymbol dflags platform importedLbl
@@ -691,8 +691,8 @@ pprImportedSymbol dflags platform importedLbl
 
                  in vcat [
                       text ".section \".got2\", \"aw\"",
-                      text ".LC_" <> pprCLabel platform lbl <> char ':',
-                      ptext symbolSize <+> pprCLabel platform lbl ]
+                      text ".LC_" <> pprCLabel dflags lbl <> char ':',
+                      ptext symbolSize <+> pprCLabel dflags lbl ]
 
             -- PLT code stubs are generated automatically by the dynamic linker.
             _ -> empty
index 0787978..2538e76 100644 (file)
@@ -271,47 +271,54 @@ generateGhcPlatformH = do
 
 generateSettings :: Expr String
 generateSettings = do
-    let flag' = flag >=> \case
-            True  -> pure "YES"
-            False -> pure "NO"
-    settings <- (traverse . traverse) expr $
-        [ ("GCC extra via C opts", lookupValueOrError configFile "gcc-extra-via-c-opts")
-        , ("C compiler command", settingsFileSetting SettingsFileSetting_CCompilerCommand)
-        , ("C compiler flags", settingsFileSetting SettingsFileSetting_CCompilerFlags)
-        , ("C compiler link flags", settingsFileSetting SettingsFileSetting_CCompilerLinkFlags)
-        , ("C compiler supports -no-pie", settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie)
-        , ("Haskell CPP command", settingsFileSetting SettingsFileSetting_HaskellCPPCommand)
-        , ("Haskell CPP flags", settingsFileSetting SettingsFileSetting_HaskellCPPFlags)
-        , ("ld command", settingsFileSetting SettingsFileSetting_LdCommand)
-        , ("ld flags", settingsFileSetting SettingsFileSetting_LdFlags)
-        , ("ld supports compact unwind", lookupValueOrError configFile "ld-has-no-compact-unwind")
-        , ("ld supports build-id", lookupValueOrError configFile "ld-has-build-id")
-        , ("ld supports filelist", lookupValueOrError configFile "ld-has-filelist")
-        , ("ld is GNU ld", lookupValueOrError configFile "ld-is-gnu-ld")
-        , ("ar command", settingsFileSetting SettingsFileSetting_ArCommand)
-        , ("ar flags", lookupValueOrError configFile "ar-args")
-        , ("ar supports at file", flag' ArSupportsAtFile)
-        , ("ranlib command", settingsFileSetting SettingsFileSetting_RanlibCommand)
-        , ("touch command", settingsFileSetting SettingsFileSetting_TouchCommand)
-        , ("dllwrap command", settingsFileSetting SettingsFileSetting_DllWrapCommand)
-        , ("windres command", settingsFileSetting SettingsFileSetting_WindresCommand)
-        , ("libtool command", settingsFileSetting SettingsFileSetting_LibtoolCommand)
-        , ("unlit command", ("$topdir/bin/" <>) . takeFileName <$> builderPath Unlit)
-        , ("cross compiling", flag' CrossCompiling)
-        , ("target platform string", setting TargetPlatform)
-        , ("target os", lookupValueOrError configFile "haskell-target-os")
-        , ("target arch", lookupValueOrError configFile "haskell-target-arch")
-        , ("target word size", lookupValueOrError configFile "target-word-size")
-        , ("target has GNU nonexec stack", lookupValueOrError configFile "haskell-have-gnu-nonexec-stack")
-        , ("target has .ident directive", lookupValueOrError configFile "haskell-have-ident-directive")
-        , ("target has subsections via symbols", lookupValueOrError configFile "haskell-have-subsections-via-symbols")
-        , ("target has RTS linker", lookupValueOrError configFile "haskell-have-rts-linker")
-        , ("Unregisterised", flag' GhcUnregisterised)
-        , ("LLVM llc command", settingsFileSetting SettingsFileSetting_LlcCommand)
-        , ("LLVM opt command", settingsFileSetting SettingsFileSetting_OptCommand)
-        , ("LLVM clang command", settingsFileSetting SettingsFileSetting_ClangCommand)
-
-        , ("Tables next to code", yesNo <$> ghcEnableTablesNextToCode)
+    settings <- traverse sequence $
+        [ ("GCC extra via C opts", expr $ lookupValueOrError configFile "gcc-extra-via-c-opts")
+        , ("C compiler command", expr $ settingsFileSetting SettingsFileSetting_CCompilerCommand)
+        , ("C compiler flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerFlags)
+        , ("C compiler link flags", expr $ settingsFileSetting SettingsFileSetting_CCompilerLinkFlags)
+        , ("C compiler supports -no-pie", expr $ settingsFileSetting SettingsFileSetting_CCompilerSupportsNoPie)
+        , ("Haskell CPP command", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPCommand)
+        , ("Haskell CPP flags", expr $ settingsFileSetting SettingsFileSetting_HaskellCPPFlags)
+        , ("ld command", expr $ settingsFileSetting SettingsFileSetting_LdCommand)
+        , ("ld flags", expr $ settingsFileSetting SettingsFileSetting_LdFlags)
+        , ("ld supports compact unwind", expr $ lookupValueOrError configFile "ld-has-no-compact-unwind")
+        , ("ld supports build-id", expr $ lookupValueOrError configFile "ld-has-build-id")
+        , ("ld supports filelist", expr $ lookupValueOrError configFile "ld-has-filelist")
+        , ("ld is GNU ld", expr $ lookupValueOrError configFile "ld-is-gnu-ld")
+        , ("ar command", expr $ settingsFileSetting SettingsFileSetting_ArCommand)
+        , ("ar flags", expr $ lookupValueOrError configFile "ar-args")
+        , ("ar supports at file", expr $ yesNo <$> flag ArSupportsAtFile)
+        , ("ranlib command", expr $ settingsFileSetting SettingsFileSetting_RanlibCommand)
+        , ("touch command", expr $ settingsFileSetting SettingsFileSetting_TouchCommand)
+        , ("dllwrap command", expr $ settingsFileSetting SettingsFileSetting_DllWrapCommand)
+        , ("windres command", expr $ settingsFileSetting SettingsFileSetting_WindresCommand)
+        , ("libtool command", expr $ settingsFileSetting SettingsFileSetting_LibtoolCommand)
+        , ("unlit command", ("$topdir/bin/" <>) <$> getBuilderPath Unlit)
+        , ("cross compiling", expr $ yesNo <$> flag CrossCompiling)
+        , ("target platform string", getSetting TargetPlatform)
+        , ("target os", expr $ lookupValueOrError configFile "haskell-target-os")
+        , ("target arch", expr $ lookupValueOrError configFile "haskell-target-arch")
+        , ("target word size", expr $ lookupValueOrError configFile "target-word-size")
+        , ("target has GNU nonexec stack", expr $ lookupValueOrError configFile "haskell-have-gnu-nonexec-stack")
+        , ("target has .ident directive", expr $ lookupValueOrError configFile "haskell-have-ident-directive")
+        , ("target has subsections via symbols", expr $ lookupValueOrError configFile "haskell-have-subsections-via-symbols")
+        , ("target has RTS linker", expr $ lookupValueOrError configFile "haskell-have-rts-linker")
+        , ("Unregisterised", expr $ yesNo <$> flag GhcUnregisterised)
+        , ("LLVM llc command", expr $ settingsFileSetting SettingsFileSetting_LlcCommand)
+        , ("LLVM opt command", expr $ settingsFileSetting SettingsFileSetting_OptCommand)
+        , ("LLVM clang command", expr $ settingsFileSetting SettingsFileSetting_ClangCommand)
+
+        , ("integer library", pkgName <$> getIntegerPackage)
+        , ("Use interpreter", expr $ yesNo <$> ghcWithInterpreter)
+        , ("Use native code generator", expr $ yesNo <$> ghcWithNativeCodeGen)
+        , ("Support SMP", expr $ yesNo <$> ghcWithSMP)
+        , ("RTS ways", expr $ yesNo <$> flag LeadingUnderscore)
+        , ("Tables next to code", expr $ yesNo <$> ghcEnableTablesNextToCode)
+        , ("Leading underscore", expr $ yesNo <$> useLibFFIForAdjustors)
+        , ("Use LibFFI", expr $ yesNo <$> useLibFFIForAdjustors)
+        , ("Use Threads", yesNo . any (wayUnit Threaded) <$> getRtsWays)
+        , ("Use Debugging", expr $ yesNo . ghcDebugged <$> flavour)
+        , ("RTS expects libdw", yesNo <$> getFlag WithLibdw)
         ]
     let showTuple (k, v) = "(" ++ show k ++ ", " ++ show v ++ ")"
     pure $ case settings of
@@ -334,20 +341,6 @@ generateConfigHs = do
     cProjectPatchLevel1 <- getSetting ProjectPatchLevel1
     cProjectPatchLevel2 <- getSetting ProjectPatchLevel2
     cBooterVersion      <- getSetting GhcVersion
-    intLib              <- getIntegerPackage
-    debugged            <- ghcDebugged    <$> expr flavour
-    let cIntegerLibraryType
-            | intLib == integerGmp    = "IntegerGMP"
-            | intLib == integerSimple = "IntegerSimple"
-            | otherwise = error $ "Unknown integer library: " ++ pkgName intLib
-    cGhcWithInterpreter        <- expr $ yesNo <$> ghcWithInterpreter
-    cGhcWithNativeCodeGen      <- expr $ yesNo <$> ghcWithNativeCodeGen
-    cGhcWithSMP                <- expr $ yesNo <$> ghcWithSMP
-    cLeadingUnderscore         <- expr $ yesNo <$> flag LeadingUnderscore
-    cLibFFI                    <- expr useLibFFIForAdjustors
-    rtsWays                    <- getRtsWays
-    cGhcRtsWithLibdw           <- getFlag WithLibdw
-    let cGhcRTSWays = unwords $ map show rtsWays
     return $ unlines
         [ "{-# LANGUAGE CPP #-}"
         , "module Config where"
@@ -356,10 +349,6 @@ generateConfigHs = do
         , ""
         , "#include \"ghc_boot_platform.h\""
         , ""
-        , "data IntegerLibrary = IntegerGMP"
-        , "                    | IntegerSimple"
-        , "                    deriving Eq"
-        , ""
         , "cBuildPlatformString :: String"
         , "cBuildPlatformString = BuildPlatform_NAME"
         , "cHostPlatformString :: String"
@@ -383,28 +372,7 @@ generateConfigHs = do
         , "cBooterVersion        = " ++ show cBooterVersion
         , "cStage                :: String"
         , "cStage                = show (STAGE :: Int)"
-        , "cIntegerLibrary       :: String"
-        , "cIntegerLibrary       = " ++ show (pkgName intLib)
-        , "cIntegerLibraryType   :: IntegerLibrary"
-        , "cIntegerLibraryType   = " ++ cIntegerLibraryType
-        , "cGhcWithInterpreter   :: String"
-        , "cGhcWithInterpreter   = " ++ show cGhcWithInterpreter
-        , "cGhcWithNativeCodeGen :: String"
-        , "cGhcWithNativeCodeGen = " ++ show cGhcWithNativeCodeGen
-        , "cGhcWithSMP           :: String"
-        , "cGhcWithSMP           = " ++ show cGhcWithSMP
-        , "cGhcRTSWays           :: String"
-        , "cGhcRTSWays           = " ++ show cGhcRTSWays
-        , "cLeadingUnderscore    :: String"
-        , "cLeadingUnderscore    = " ++ show cLeadingUnderscore
-        , "cLibFFI               :: Bool"
-        , "cLibFFI               = " ++ show cLibFFI
-        , "cGhcThreaded :: Bool"
-        , "cGhcThreaded = " ++ show (any (wayUnit Threaded) rtsWays)
-        , "cGhcDebugged :: Bool"
-        , "cGhcDebugged = " ++ show debugged
-        , "cGhcRtsWithLibdw :: Bool"
-        , "cGhcRtsWithLibdw = " ++ show cGhcRtsWithLibdw ]
+        ]
 
 -- | Generate @ghcautoconf.h@ header.
 generateGhcAutoconfH :: Expr String
index 71941c9..2421d9c 100644 (file)
@@ -211,8 +211,23 @@ $(includes_SETTINGS) : includes/Makefile | $$(dir $$@)/.
        @echo ',("LLVM llc command", "$(SettingsLlcCommand)")' >> $@
        @echo ',("LLVM opt command", "$(SettingsOptCommand)")' >> $@
        @echo ',("LLVM clang command", "$(SettingsClangCommand)")' >> $@
+       @echo
+       @echo ',("integer library", "$(INTEGER_LIBRARY)")' >> $@
+       @echo ',("Use interpreter", "$(GhcWithInterpreter)")' >> $@
+       @echo ',("Use native code generator", "$(GhcWithNativeCodeGen)")' >> $@
+       @echo ',("Support SMP", "$(GhcWithSMP)")' >> $@
+       @echo ',("RTS ways", "$(GhcRTSWays)")' >> $@
        @echo ',("Tables next to code", "$(GhcEnableTablesNextToCode)")' >> $@
-       @echo ']' >> $@
+       @echo ',("Leading underscore", "$(LeadingUnderscore)")' >> $@
+       @echo ',("Use LibFFI", "$(UseLibFFIForAdjustors)")' >> $@
+# Note that GhcThreaded just reflects the Makefile variable setting. In
+# particular, the stage1 compiler is never actually compiled with -threaded, but
+# it will nevertheless have cGhcThreaded = True. The "+RTS --info" output will
+# show what RTS GHC is really using.
+       @echo ",(\"Use Threads\", \"$(GhcThreaded)\")" >> $@
+       @echo ",(\"Use Debugging\", \"$(GhcDebugged)\")" >> $@
+       @echo ",(\"RTS expects libdw\", \"$(GhcRtsWithLibdw)\")" >> $@
+       @echo "]" >> $@
 
 
 # ---------------------------------------------------------------------------