Commit a8abbc96 authored by Michal Terepeta's avatar Michal Terepeta
Browse files

Split CompilerMode for GHC and CC


Signed-off-by: Michal Terepeta's avatarMichal Terepeta <michal.terepeta@gmail.com>
parent b2fc1542
{-# LANGUAGE DeriveGeneric, LambdaCase #-}
module Builder (
CompilerMode (..), Builder (..),
CcMode (..), GhcMode (..), Builder (..),
builderPath, getBuilderPath, builderEnvironment, specified, needBuilder
) where
......@@ -19,10 +19,13 @@ import Stage
-- 1) Compiling sources into object files.
-- 2) Extracting source dependencies, e.g. by passing -M command line argument.
-- 3) Linking object files & static libraries into an executable.
data CompilerMode = Compile
| FindDependencies
| Link
deriving (Eq, Generic, Show)
-- We have CcMode for CC and GhcMode for GHC.
data CcMode = CompileC | FindCDependencies
deriving (Eq, Generic, Show)
data GhcMode = CompileHs | FindHsDependencies | LinkHs
deriving (Eq, Generic, Show)
-- TODO: Do we really need HsCpp builder? Can't we use Cc instead?
-- | A 'Builder' is an external command invoked in separate process using 'Shake.cmd'
......@@ -34,11 +37,11 @@ data CompilerMode = Compile
data Builder = Alex
| Ar
| DeriveConstants
| Cc CompilerMode Stage
| Cc CcMode Stage
| Configure FilePath
| GenApply
| GenPrimopCode
| Ghc CompilerMode Stage
| Ghc GhcMode Stage
| GhcCabal
| GhcCabalHsColour -- synonym for 'GhcCabal hscolour'
| GhcPkg Stage
......@@ -154,9 +157,13 @@ needBuilder = \case
need [path]
-- | Instances for storing in the Shake database.
instance Binary CompilerMode
instance Hashable CompilerMode
instance NFData CompilerMode
instance Binary CcMode
instance Hashable CcMode
instance NFData CcMode
instance Binary GhcMode
instance Hashable GhcMode
instance NFData GhcMode
instance Binary Builder
instance Hashable Builder
......
......@@ -27,11 +27,17 @@ instance BuilderLike Builder where
instance BuilderLike a => BuilderLike (Stage -> a) where
builder s2b = builder . s2b =<< getStage
instance BuilderLike a => BuilderLike (CompilerMode -> a) where
instance BuilderLike a => BuilderLike (CcMode -> a) where
builder c2b = do
b <- getBuilder
case b of
Cc c _ -> builder $ c2b c
_ -> return False
instance BuilderLike a => BuilderLike (GhcMode -> a) where
builder c2b = do
b <- getBuilder
case b of
Ghc c _ -> builder $ c2b c
_ -> return False
......
......@@ -22,18 +22,18 @@ compilePackage rs context@Context {..} = do
if ("//*.c" ?== src)
then do
need $ src : deps
build $ Target context (Cc Compile stage) [src] [obj]
build $ Target context (Cc CompileC stage) [src] [obj]
else do
need $ src : deps
needCompileDependencies context
buildWithResources rs $ Target context (Ghc Compile stage) [src] [obj]
buildWithResources rs $ Target context (Ghc CompileHs stage) [src] [obj]
-- TODO: Get rid of these special cases.
path <//> "*" <.> obootsuf way %> \obj -> do
(src, deps) <- fileDependencies context obj
need $ src : deps
needCompileDependencies context
buildWithResources rs $ Target context (Ghc Compile stage) [src] [obj]
buildWithResources rs $ Target context (Ghc CompileHs stage) [src] [obj]
needCompileDependencies :: Context -> Action ()
needCompileDependencies context@Context {..} = do
......
......@@ -21,7 +21,7 @@ buildPackageDependencies rs context@Context {..} =
[ "//*.c.deps", "//*.cmm.deps", "//*.S.deps" ] |%> \out -> do
let src = dep2src context out
need [src]
build $ Target context (Cc FindDependencies stage) [src] [out]
build $ Target context (Cc FindCDependencies stage) [src] [out]
hDepFile %> \out -> do
srcs <- haskellSources context
......@@ -29,7 +29,7 @@ buildPackageDependencies rs context@Context {..} =
if srcs == []
then writeFileChanged out ""
else buildWithResources rs $
Target context (Ghc FindDependencies stage) srcs [out]
Target context (Ghc FindHsDependencies stage) srcs [out]
removeFile $ out <.> "bak"
-- TODO: don't accumulate *.deps into .dependencies
......
......@@ -25,7 +25,7 @@ gmpPatches :: [FilePath]
gmpPatches = (gmpBase -/-) <$> ["gmpsrc.patch", "tarball/gmp-5.0.4.patch"]
configureEnvironment :: Action [CmdOption]
configureEnvironment = sequence [ builderEnvironment "CC" $ Cc Compile Stage1
configureEnvironment = sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
, builderEnvironment "AR" Ar
, builderEnvironment "NM" Nm ]
......
......@@ -44,8 +44,8 @@ configureEnvironment = do
[ cArgs
, argStagedSettingList ConfCcArgs ]
ldFlags <- interpretInContext libffiContext $ fromDiffExpr ldArgs
sequence [ builderEnvironment "CC" $ Cc Compile Stage1
, builderEnvironment "CXX" $ Cc Compile Stage1
sequence [ builderEnvironment "CC" $ Cc CompileC Stage1
, builderEnvironment "CXX" $ Cc CompileC Stage1
, builderEnvironment "LD" Ld
, builderEnvironment "AR" Ar
, builderEnvironment "NM" Nm
......
......@@ -87,7 +87,7 @@ buildBinary rs context@Context {..} bin = do
++ [ path -/- "Paths_hsc2hs.o" | package == hsc2hs ]
++ [ path -/- "Paths_haddock.o" | package == haddock ]
need binDeps
buildWithResources rs $ Target context (Ghc Link stage) binDeps [bin]
buildWithResources rs $ Target context (Ghc LinkHs stage) binDeps [bin]
synopsis <- interpretInContext context $ getPkgData Synopsis
putSuccess $ renderProgram
(quote (pkgNameString package) ++ " (" ++ show stage ++ ").")
......
......@@ -16,7 +16,7 @@ import Target
testRules :: Rules ()
testRules = do
"validate" ~> do
needBuilder $ Ghc Compile Stage2
needBuilder $ Ghc CompileHs Stage2
needBuilder $ GhcPkg Stage1
needBuilder Hpc
build $ Target (vanillaContext Stage2 compiler) (Make "testsuite/tests") [] []
......@@ -29,7 +29,7 @@ testRules = do
| pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
windows <- windowsHost
top <- topDirectory
compiler <- builderPath $ Ghc Compile Stage2
compiler <- builderPath $ Ghc CompileHs Stage2
ghcPkg <- builderPath $ GhcPkg Stage1
haddock <- builderPath Haddock
threads <- shakeThreads <$> getShakeOptions
......
......@@ -10,12 +10,12 @@ import Settings
-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
ccBuilderArgs :: Args
ccBuilderArgs = mconcat
[ builder (Cc Compile) ?
[ builder (Cc CompileC) ?
mconcat [ commonCcArgs
, arg "-c", arg =<< getInput
, arg "-o", arg =<< getOutput ]
, builder (Cc FindDependencies) ? do
, builder (Cc FindCDependencies) ? do
output <- getOutput
mconcat [ arg "-E"
, arg "-MM"
......
......@@ -19,7 +19,7 @@ deriveConstantsBuilderArgs = builder DeriveConstants ? do
, output "//GHCConstantsHaskellExports.hs" ? arg "--gen-haskell-exports"
, arg "-o", arg outputFile
, arg "--tmpdir", arg tempDir
, arg "--gcc-program", arg =<< getBuilderPath (Cc Compile Stage1)
, arg "--gcc-program", arg =<< getBuilderPath (Cc CompileC Stage1)
, append . concat $ map (\a -> ["--gcc-flag", a]) cFlags
, arg "--nm-program", arg =<< getBuilderPath Nm
, specified Objdump ? mconcat [ arg "--objdump-program"
......
......@@ -18,7 +18,7 @@ import Settings.Paths
-- $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno
-- $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@)))
ghcBuilderArgs :: Args
ghcBuilderArgs = (builder (Ghc Compile) ||^ builder (Ghc Link)) ? do
ghcBuilderArgs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
needTouchy
mconcat [ commonGhcArgs
, arg "-H32m"
......@@ -28,12 +28,12 @@ ghcBuilderArgs = (builder (Ghc Compile) ||^ builder (Ghc Link)) ? do
, arg "-fwarn-tabs"
, splitObjectsArgs
, ghcLinkArgs
, builder (Ghc Compile) ? arg "-c"
, builder (Ghc CompileHs) ? arg "-c"
, append =<< getInputs
, arg "-o", arg =<< getOutput ]
ghcLinkArgs :: Args
ghcLinkArgs = builder (Ghc Link) ? do
ghcLinkArgs = builder (Ghc LinkHs) ? do
stage <- getStage
libs <- getPkgDataList DepExtraLibs
gmpLibs <- if stage > Stage0
......@@ -64,7 +64,7 @@ splitObjectsArgs = splitObjects flavour ? do
arg "-split-objs"
ghcMBuilderArgs :: Args
ghcMBuilderArgs = builder (Ghc FindDependencies) ? do
ghcMBuilderArgs = builder (Ghc FindHsDependencies) ? do
ways <- getLibraryWays
mconcat [ arg "-M"
, commonGhcArgs
......
......@@ -24,14 +24,14 @@ ghcCabalBuilderArgs = builder GhcCabal ? do
, arg path
, arg dir
, dll0Args
, withStaged $ Ghc Compile
, withStaged $ Ghc CompileHs
, withStaged GhcPkg
, bootPackageDatabaseArgs
, libraryArgs
, with HsColour
, configureArgs
, packageConstraints
, withStaged $ Cc Compile
, withStaged $ Cc CompileC
, notStage0 ? with Ld
, with Ar
, with Alex
......@@ -82,7 +82,7 @@ configureArgs = do
, conf "--with-gmp-includes" $ argSetting GmpIncludeDir
, conf "--with-gmp-libraries" $ argSetting GmpLibDir
, crossCompiling ? (conf "--host" $ argSetting TargetPlatformFull)
, conf "--with-cc" $ argStagedBuilderPath (Cc Compile) ]
, conf "--with-cc" $ argStagedBuilderPath (Cc CompileC) ]
newtype PackageDatabaseKey = PackageDatabaseKey Stage
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
......
......@@ -15,7 +15,7 @@ templateHsc = "inplace/lib/template-hsc.h"
hsc2hsBuilderArgs :: Args
hsc2hsBuilderArgs = builder Hsc2Hs ? do
stage <- getStage
ccPath <- getBuilderPath $ Cc Compile stage
ccPath <- getBuilderPath $ Cc CompileC stage
gmpDir <- getSetting GmpIncludeDir
cFlags <- getCFlags
lFlags <- getLFlags
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment