Add custom settings for compiler and other packages.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 26 Jul 2015 00:31:40 +0000 (01:31 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 26 Jul 2015 00:31:40 +0000 (01:31 +0100)
src/Oracles/Flag.hs
src/Oracles/Setting.hs
src/Package/Base.hs
src/Settings/Args.hs
src/Settings/GhcCabal.hs
src/Settings/GhcM.hs
src/Settings/User.hs
src/Settings/Ways.hs
src/Switches.hs
src/Util.hs

index 0b00f84..4152a97 100644 (file)
@@ -1,7 +1,7 @@
 module Oracles.Flag (
     Flag (..), flag,
     supportsPackageKey, crossCompiling, gccIsClang, gccLt46,
-    platformSupportsSharedLibs
+    platformSupportsSharedLibs, ghcWithSMP, ghcWithNativeCodeGen
     ) where
 
 import Util
@@ -54,3 +54,16 @@ platformSupportsSharedLibs = do
     solaris       <- targetPlatform    "i386-unknown-solaris2"
     solarisBroken <- flag SolarisBrokenShld
     return $ not (badPlatform || solaris && solarisBroken)
+
+ghcWithSMP :: Action Bool
+ghcWithSMP = do
+    goodArch <- targetArchs ["i386", "x86_64", "sparc", "powerpc", "arm"]
+    ghcUnreg <- flag GhcUnregisterised
+    return $ goodArch && not ghcUnreg
+
+ghcWithNativeCodeGen :: Action Bool
+ghcWithNativeCodeGen = do
+    goodArch <- targetArchs ["i386", "x86_64", "sparc", "powerpc"]
+    badOs    <- targetOss ["ios", "aix"]
+    ghcUnreg <- flag GhcUnregisterised
+    return $ goodArch && not badOs && not ghcUnreg
index 9694c00..5ae4497 100644 (file)
@@ -2,7 +2,8 @@ module Oracles.Setting (
     Setting (..), SettingList (..),
     setting, settingList,
     targetPlatform, targetPlatforms, targetOs, targetOss, notTargetOs,
-    targetArchs, windowsHost, notWindowsHost, ghcWithInterpreter
+    targetArchs, windowsHost, notWindowsHost, ghcWithInterpreter,
+    ghcEnableTablesNextToCode
     ) where
 
 import Stage
@@ -91,3 +92,6 @@ ghcWithInterpreter = do
     goodArch <- targetArchs [ "i386", "x86_64", "powerpc", "sparc"
                             , "sparc64", "arm" ]
     return $ goodOs && goodArch
+
+ghcEnableTablesNextToCode :: Action Bool
+ghcEnableTablesNextToCode = targetArchs ["ia64", "powerpc64"]
index e140891..3e2eb37 100644 (file)
@@ -126,31 +126,3 @@ argSizeLimit = do
              then 31000
              else 4194304 -- Cabal needs a bit more than 2MB!
 
--- List of source files, which need to be tracked by the build system
--- to make sure the argument lists have not changed.
--- sourceDependecies :: [FilePath]
--- sourceDependecies = [ "shake/src/Package/Base.hs"
---                     , "shake/src/Oracles/Base.hs"
---                     , "shake/src/Oracles/Flag.hs"
---                     , "shake/src/Oracles/Option.hs"
---                     , "shake/src/Oracles/Builder.hs"
---                     , "shake/src/Oracles/PackageData.hs"
---                     , "shake/src/Ways.hs"
---                     , "shake/src/Util.hs"
---                     , "shake/src/Oracles.hs" ]
-
--- -- Convert Builder's argument list to a printable String
--- argListWithComment :: String -> Builder -> Args -> Action String
--- argListWithComment comment builder args = do
---     args' <- args
---     return $ show builder ++ " arguments"
---            ++ (if null comment then "" else " (" ++ comment ++ ")")
---            ++ ":\n" ++ concatMap (\s -> "    " ++ s ++ "\n") args'
-
--- argList :: Builder -> Args -> Action String
--- argList = argListWithComment ""
-
--- -- Path to argument list for a given Package/Stage combination
--- argListPath :: FilePath -> Package -> Stage -> FilePath
--- argListPath dir (Package name _ _ _) stage =
---     dir </> takeBaseName name ++ " (stage " ++ show stage ++ ")" <.> "txt"
index 78e18a7..be6ac42 100644 (file)
@@ -14,6 +14,13 @@ args = defaultArgs <> userArgs
 
 -- TODO: add all other settings
 -- TODO: add src-hc-args = -H32m -O
+-- TODO: GhcStage2HcOpts=-O2 unless GhcUnregisterised
+-- TODO: libraries/ghc-prim_dist-install_MODULES := $$(filter-out GHC.Prim, ...
+-- TODO: compiler/stage1/build/Parser_HC_OPTS += -O0 -fno-ignore-interface-pragmas
+-- TODO: compiler/main/GhcMake_HC_OPTS        += -auto-all
+-- TODO: compiler_stage2_HADDOCK_OPTS += --optghc=-DSTAGE=2
+-- TODO: compiler/prelude/PrimOp_HC_OPTS  += -fforce-recomp
+-- TODO: is GhcHcOpts=-Rghc-timing needed?
 defaultArgs :: Args
 defaultArgs = mconcat
     [ cabalArgs
index 91ee6b8..cba05cc 100644 (file)
@@ -122,21 +122,53 @@ ccArgs = validating ? do
 ldArgs :: Args
 ldArgs = mempty
 
+ghcIncludeDirs :: [FilePath]
+ghcIncludeDirs = [ "includes", "includes/dist"
+                 , "includes/dist-derivedconstants/header"
+                 , "includes/dist-ghcconstants/header" ]
+
 cppArgs :: Args
-cppArgs = mempty
+cppArgs = append . map ("-I" ++ ) $ ghcIncludeDirs
 
 customPackageArgs :: Args
-customPackageArgs = mconcat
-    [ package integerGmp2 ?
-      mconcat [ windowsHost ? builder GhcCabal ?
-                arg "--configure-option=--with-intree-gmp"
-              , appendCcArgs ["-Ilibraries/integer-gmp2/gmp"] ]
-
-    , package base ?
-      builder GhcCabal ? arg ("--flags=" ++ pkgName integerLibrary)
-
-    , package ghcPrim ?
-      builder GhcCabal ? arg "--flag=include-ghc-prim" ]
+customPackageArgs = do
+    stage   <- getStage
+    rtsWays <- getRtsWays
+    mconcat
+        [ package integerGmp2 ?
+          mconcat [ windowsHost ? builder GhcCabal ?
+                    arg "--configure-option=--with-intree-gmp"
+                  , appendCcArgs ["-Ilibraries/integer-gmp2/gmp"] ]
+
+        , package base ?
+          builder GhcCabal ? arg ("--flags=" ++ pkgName integerLibrary)
+
+        , package ghcPrim ?
+          builder GhcCabal ? arg "--flag=include-ghc-prim"
+
+        , package compiler ?
+          builder GhcCabal ?
+          mconcat [ arg $ "--ghc-option=-DSTAGE=" ++ show (succ stage)
+                  , arg "--disable-library-for-ghci"
+                  , targetOs "openbsd" ? arg "--ld-options=-E"
+                  , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
+                  , notP ghcWithSMP ? arg "--ghc-option=-DNOSMP"
+                  , notP ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
+                  , (threaded `elem` rtsWays) ?
+                    notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
+                  , ghcWithNativeCodeGen ? arg "--flags=ncg"
+                  , ghcWithInterpreter ? arg "--flags=ghci"
+                  , ghcWithInterpreter ?
+                    ghcEnableTablesNextToCode ?
+                    notP (flag GhcUnregisterised) ?
+                    notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE"
+                  , ghcWithInterpreter ?
+                    ghciWithDebugger ?
+                    notStage0 ? arg "--ghc-option=-DDEBUGGER"
+                  , ghcProfiled ?
+                    notStage0 ? arg "--ghc-pkg-option=--force"
+                  ]
+        ]
 
 withBuilderKey :: Builder -> String
 withBuilderKey builder = case builder of
index 7349a86..7a9f466 100644 (file)
@@ -30,8 +30,11 @@ ghcMArgs = stagedBuilder GhcM ? do
         , arg "-dep-makefile", arg $ buildPath -/- "haskell.deps"
         , append . concatMap (\way -> ["-dep-suffix", wayPrefix way]) $ ways
         , append hsArgs
+        , arg "-no-user-package-db" -- TODO: is this needed?
+        , arg "-rtsopts"            -- TODO: is this needed?
         , append hsSrcs ]
 
+
 packageGhcArgs :: Args
 packageGhcArgs = do
     stage              <- getStage
@@ -56,6 +59,7 @@ includeGhcArgs = do
     pkgPath <- getPackagePath
     srcDirs <- getPkgDataList SrcDirs
     incDirs <- getPkgDataList IncludeDirs
+    cppArgs <- getPkgDataList CppArgs
     let buildPath   = path -/- "build"
         autogenPath = buildPath -/- "autogen"
     mconcat
@@ -66,5 +70,5 @@ includeGhcArgs = do
         , arg $ "-I" ++ buildPath
         , arg $ "-I" ++ autogenPath
         , append . map (\dir -> "-I" ++ pkgPath -/- dir) $ incDirs
-        , arg "-optP-include" -- TODO: Shall we also add -cpp?
-        , arg $ "-optP" ++ autogenPath -/- "cabal_macros.h" ]
+        , arg "-optP-include", arg $ "-optP" ++ autogenPath -/- "cabal_macros.h"
+        , append . map ("-optP" ++) $ cppArgs ]
index 7e65b14..6426e82 100644 (file)
@@ -1,8 +1,9 @@
 module Settings.User (
     module Settings.Default,
-    userArgs, userPackages, userWays, userTargetDirectory,
+    userArgs, userPackages, userWays, userRtsWays, userTargetDirectory,
     userKnownPackages, integerLibrary,
-    buildHaddock, validating, dynamicGhcPrograms, laxDependencies
+    buildHaddock, validating, ghciWithDebugger, ghcProfiled,
+    dynamicGhcPrograms, laxDependencies
     ) where
 
 import Stage
@@ -17,7 +18,7 @@ userArgs = mempty
 
 -- Control which packages get to be built
 userPackages :: Packages
-userPackages = remove [compiler] -- TODO: fix compiler
+userPackages = mempty
 
 -- Add new user-defined packages
 userKnownPackages :: [Package]
@@ -27,6 +28,9 @@ userKnownPackages = []
 userWays :: Ways
 userWays = mempty
 
+userRtsWays :: Ways
+userRtsWays = mempty
+
 -- Control where build results go (see Settings.Default for an example)
 userTargetDirectory :: Stage -> Package -> FilePath
 userTargetDirectory = defaultTargetDirectory
@@ -45,8 +49,15 @@ validating = False
 dynamicGhcPrograms :: Bool
 dynamicGhcPrograms = False
 
+ghciWithDebugger :: Bool
+ghciWithDebugger = False
+
+ghcProfiled :: Bool
+ghcProfiled = False
+
 laxDependencies :: Bool
 laxDependencies = False
 
 buildHaddock :: Predicate
 buildHaddock = return True
+
index a5f7314..c8377eb 100644 (file)
@@ -1,5 +1,6 @@
 module Settings.Ways (
-    ways, getWays
+    ways, getWays,
+    rtsWays, getRtsWays
     ) where
 
 import Way
@@ -13,12 +14,28 @@ import Settings.User
 ways :: Ways
 ways = defaultWays <> userWays
 
+rtsWays :: Ways
+rtsWays = defaultRtsWays <> userRtsWays
+
 getWays :: Expr [Way]
 getWays = fromDiffExpr ways
 
+getRtsWays :: Expr [Way]
+getRtsWays = fromDiffExpr rtsWays
+
 -- These are default ways
 defaultWays :: Ways
 defaultWays = mconcat
     [                              append [vanilla] -- always build vanilla
     , notStage Stage0            ? append [profiling]
     , platformSupportsSharedLibs ? append [dynamic] ]
+
+defaultRtsWays :: Ways
+defaultRtsWays = do
+    ways <- getWays
+    mconcat
+        [ append [ logging, debug, threaded, threadedDebug, threadedLogging ]
+        , (profiling `elem` ways) ? append [threadedProfiling]
+        , (dynamic `elem` ways) ?
+          append [ dynamic, debugDynamic, threadedDynamic, threadedDebugDynamic
+                 , loggingDynamic, threadedLoggingDynamic ] ]
index a707ace..244c87f 100644 (file)
@@ -6,6 +6,7 @@ module Switches (
 import Stage
 import Expression
 import Settings.Util
+import Settings.Default
 import Oracles.Flag
 import Oracles.Setting
 
@@ -32,10 +33,12 @@ registerPackage = return True
 splitObjects :: Predicate
 splitObjects = do
     stage    <- getStage -- We don't split bootstrap (stage 0) packages
+    package  <- getPackage -- We don't split compiler
     broken   <- getFlag SplitObjectsBroken
     ghcUnreg <- getFlag GhcUnregisterised
     goodArch <- lift $ targetArchs [ "i386", "x86_64", "powerpc", "sparc" ]
     goodOs   <- lift $ targetOss   [ "mingw32", "cygwin32", "linux"
                                    , "darwin", "solaris2", "freebsd"
                                    , "dragonfly", "netbsd", "openbsd"]
-    return $ not broken && not ghcUnreg && stage == Stage1 && goodArch && goodOs
+    return $ stage == Stage1 && package /= compiler && not broken
+           && not ghcUnreg && goodArch && goodOs
index fa20665..7c5f786 100644 (file)
@@ -32,7 +32,7 @@ unifyPath = toStandard . normaliseEx
 (-/-) :: FilePath -> FilePath -> FilePath
 a -/- b = unifyPath $ a </> b
 
-infixr 5 -/-
+infixr 6 -/-
 
 -- (chunksOfSize size ss) splits a list of strings 'ss' into chunks not
 -- exceeding the given 'size'.