Add CompilerMode to Cc and Ghc builders.

See #223.

src/Builder.hs

 {-# LANGUAGE DeriveGeneric, LambdaCase #-}
 module Builder (
-    Builder (..), isStaged, builderPath, getBuilderPath, specified, needBuilder
+    CompilerMode (..), Builder (..),
+    isStaged, builderPath, getBuilderPath, specified, needBuilder
     ) where
 
 import Control.Monad.Trans.Reader
@@ -14,27 +15,28 @@ import Oracles.LookupInPath
 import Oracles.WindowsPath
 import Stage
 
+-- TODO: Add Link mode?
+-- | A C or Haskell compiler can be used in two modes: for compiling sources
+-- into object files, or for extracting source dependencies, e.g. by passing -M
+-- command line option.
+data CompilerMode = Compile | FindDependencies deriving (Show, Eq, Generic)
+
+-- 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'
 --
 -- @Ghc Stage0@ is the bootstrapping compiler
 -- @Ghc StageN@, N > 0, is the one built on stage (N - 1)
 -- @GhcPkg Stage0@ is the bootstrapping @GhcPkg@
 -- @GhcPkg StageN@, N > 0, is the one built in Stage0 (TODO: need only Stage1?)
--- TODO: Do we really need HsCpp builder? Can't we use a generic Cpp
---       builder instead? It would also be used instead of CcM.
--- TODO: why are Cc/CcM staged?
--- TODO: use Cc CcMode, where CcMode = Compile | FindDeps instead of Cc & CcM.
 data Builder = Alex
              | Ar
              | DeriveConstants
-             | Cc Stage
-             | CcM Stage          -- synonym for 'Cc -MM'
+             | Cc CompilerMode Stage
              | GenApply
              | GenPrimopCode
-             | Ghc Stage
+             | Ghc CompilerMode Stage
              | GhcCabal
              | GhcCabalHsColour   -- synonym for 'GhcCabal hscolour'
-             | GhcM Stage         -- synonym for 'Ghc -M'
              | GhcPkg Stage
              | Haddock
              | Happy
@@ -61,8 +63,8 @@ builderProvenance = \case
     DeriveConstants  -> context Stage0 deriveConstants
     GenApply         -> context Stage0 genapply
     GenPrimopCode    -> context Stage0 genprimopcode
-    Ghc stage        -> if stage == Stage0 then Nothing else context (pred stage) ghc
-    GhcM stage       -> builderProvenance $ Ghc stage
+    Ghc _ Stage0     -> Nothing
+    Ghc _ stage      -> context (pred stage) ghc
     GhcCabal         -> context Stage0 ghcCabal
     GhcCabalHsColour -> builderProvenance $ GhcCabal
     GhcPkg stage     -> if stage > Stage0 then context Stage0 ghcPkg else Nothing
@@ -79,12 +81,10 @@ isInternal = isJust . builderProvenance
 
 isStaged :: Builder -> Bool
 isStaged = \case
-    (Cc  _) -> True
-    (CcM _) -> True
-    (Ghc        _) -> True
-    (GhcM       _) -> True
-    (GhcPkg     _) -> True
-    _              -> False
+    (Cc   _ _) -> True
+    (Ghc  _ _) -> True
+    (GhcPkg _) -> True
+    _          -> False
 
 -- TODO: Some builders are required only on certain platforms. For example,
 -- Objdump is only required on OpenBSD and AIX, as mentioned in #211. Add
@@ -103,26 +103,23 @@ builderPath builder = case builderProvenance builder of
     Just context -> return . fromJust $ programPath context
     Nothing -> do
         let builderKey = case builder of
-                Alex              -> "alex"
-                Ar                -> "ar"
-                Cc Stage0  -> "system-cc"
-                Cc _       -> "cc"
-                CcM Stage0 -> "system-cc"
-                CcM _      -> "cc"
-                Ghc Stage0        -> "system-ghc"
-                GhcM Stage0       -> "system-ghc"
-                GhcPkg Stage0     -> "system-ghc-pkg"
-                Happy             -> "happy"
-                HsColour          -> "hscolour"
-                HsCpp             -> "hs-cpp"
-                Ld                -> "ld"
-                Make              -> "make"
-                Nm                -> "nm"
-                Objdump           -> "objdump"
-                Patch             -> "patch"
-                Perl              -> "perl"
-                Ranlib            -> "ranlib"
-                Tar               -> "tar"
+                Alex          -> "alex"
+                Ar            -> "ar"
+                Cc  _  Stage0 -> "system-cc"
+                Cc  _  _      -> "cc"
+                Ghc _  Stage0 -> "system-ghc"
+                GhcPkg Stage0 -> "system-ghc-pkg"
+                Happy         -> "happy"
+                HsColour      -> "hscolour"
+                HsCpp         -> "hs-cpp"
+                Ld            -> "ld"
+                Make          -> "make"
+                Nm            -> "nm"
+                Objdump       -> "objdump"
+                Patch         -> "patch"
+                Perl          -> "perl"
+                Ranlib        -> "ranlib"
+                Tar           -> "tar"
                 _ -> error $ "Cannot determine builderKey for " ++ show builder
         path <- askConfigWithDefault builderKey . putError $
             "\nCannot find path to '" ++ builderKey
@@ -155,11 +152,14 @@ needBuilder laxDependencies builder = when (isInternal builder) $ do
   where
     allowOrderOnlyDependency :: Builder -> Bool
     allowOrderOnlyDependency = \case
-        Ghc  _ -> True
-        GhcM _ -> True
-        _      -> False
+        Ghc _ _ -> True
+        _       -> False
 
 -- Instances for storing in the Shake database
+instance Binary CompilerMode
+instance Hashable CompilerMode
+instance NFData CompilerMode
+
 instance Binary Builder
 instance Hashable Builder
 instance NFData Builder

src/Predicates.hs

+{-# LANGUAGE LambdaCase #-}
 -- | Convenient predicates
 module Predicates (
     stage, package, builder, stagedBuilder, builderCc, builderGhc, file, way,
@@ -19,17 +20,23 @@ package p = (p ==) <$> getPackage
 builder :: Builder -> Predicate
 builder b = (b ==) <$> getBuilder
 
+-- TODO: Use type classes to unify various builder predicates (also needBuilder,
+-- builderPath, etc).
 -- | Is a certain builder used in the current stage?
 stagedBuilder :: (Stage -> Builder) -> Predicate
 stagedBuilder stageBuilder = builder . stageBuilder =<< getStage
 
--- | Are we building with GCC?
+-- | Are we building with a C compiler?
 builderCc :: Predicate
-builderCc = stagedBuilder Cc ||^ stagedBuilder CcM
+builderCc = getBuilder >>= \case
+    Cc _ _ -> return True
+    _      -> return False
 
 -- | Are we building with GHC?
 builderGhc :: Predicate
-builderGhc = stagedBuilder Ghc ||^ stagedBuilder GhcM
+builderGhc = getBuilder >>= \case
+    Ghc _ _ -> return True
+    _       -> return False
 
 -- | Does any of the output files match a given pattern?
 file :: FilePattern -> Predicate

src/Rules/Compile.hs

@@ -17,7 +17,7 @@ compilePackage rs context@Context {..} = do
         then do
             (src, deps) <- dependencies path $ hi -<.> osuf way
             need $ src : deps
-            buildWithResources rs $ Target context (Ghc stage) [src] [hi]
+            buildWithResources rs $ Target context (Ghc Compile stage) [src] [hi]
         else need [ hi -<.> osuf way ]
 
     path <//> "*" <.> hibootsuf way %> \hiboot ->
@@ -25,7 +25,7 @@ compilePackage rs context@Context {..} = do
         then do
             (src, deps) <- dependencies path $ hiboot -<.> obootsuf way
             need $ src : deps
-            buildWithResources rs $ Target context (Ghc stage) [src] [hiboot]
+            buildWithResources rs $ Target context (Ghc Compile stage) [src] [hiboot]
         else need [ hiboot -<.> obootsuf way ]
 
     -- TODO: add dependencies for #include of .h and .hs-incl files (gcc -MM?)
@@ -34,12 +34,12 @@ compilePackage rs context@Context {..} = do
         if ("//*.c" ?== src)
         then do
             need $ src : deps
-            build $ Target context (Cc stage) [src] [obj]
+            build $ Target context (Cc Compile stage) [src] [obj]
         else do
             if compileInterfaceFilesSeparately && "//*.hs" ?== src
             then need $ (obj -<.> hisuf way) : src : deps
             else need $ src : deps
-            buildWithResources rs $ Target context (Ghc stage) [src] [obj]
+            buildWithResources rs $ Target context (Ghc Compile stage) [src] [obj]
 
     -- TODO: get rid of these special cases
     path <//> "*" <.> obootsuf way %> \obj -> do
@@ -47,4 +47,4 @@ compilePackage rs context@Context {..} = do
         if compileInterfaceFilesSeparately
         then need $ (obj -<.> hibootsuf way) : src : deps
         else need $ src : deps
-        buildWithResources rs $ Target context (Ghc stage) [src] [obj]
+        buildWithResources rs $ Target context (Ghc Compile stage) [src] [obj]

src/Rules/Dependencies.hs

@@ -20,14 +20,15 @@ buildPackageDependencies rs context@Context {..} =
             [ "//*.c.deps", "//*.cmm.deps", "//*.S.deps" ] |%> \out -> do
                 let src = dep2src context out
                 need [src]
-                build $ Target context (CcM stage) [src] [out]
+                build $ Target context (Cc FindDependencies stage) [src] [out]
 
         hDepFile %> \out -> do
             srcs <- haskellSources context
             need srcs
             if srcs == []
             then writeFileChanged out ""
-            else buildWithResources rs $ Target context (GhcM stage) srcs [out]
+            else buildWithResources rs $
+                Target context (Ghc FindDependencies stage) srcs [out]
             removeFileIfExists $ out <.> "bak"
 
         -- TODO: don't accumulate *.deps into .dependencies

src/Rules/Gmp.hs

@@ -37,7 +37,7 @@ gmpPatches = (gmpBase -/-) <$> ["gmpsrc.patch", "tarball/gmp-5.0.4.patch"]
 -- TODO: See Libffi.hs about removing code duplication.
 configureEnvironment :: Action [CmdOption]
 configureEnvironment = do
-    sequence [ builderEnv "CC" $ Cc Stage1
+    sequence [ builderEnv "CC" $ Cc Compile Stage1
              , builderEnv "AR" Ar
              , builderEnv "NM" Nm ]
   where

src/Rules/Libffi.hs

@@ -43,8 +43,8 @@ configureEnvironment = do
                [ cArgs
                , argStagedSettingList ConfCcArgs ]
     ldFlags <- interpretInContext libffiContext $ fromDiffExpr ldArgs
-    sequence [ builderEnv "CC" $ Cc Stage0
-             , builderEnv "CXX" $ Cc Stage0
+    sequence [ builderEnv "CC" $ Cc Compile Stage0
+             , builderEnv "CXX" $ Cc Compile Stage0
              , builderEnv "LD" Ld
              , builderEnv "AR" Ar
              , builderEnv "NM" Nm

src/Rules/Program.hs

@@ -99,7 +99,8 @@ buildBinary rs context@(Context stage package _) bin = do
                   then [ pkgPath package -/- src <.> "hs" | src <- hSrcs ]
                   else objs
     need $ binDeps ++ libs
-    buildWithResources rs $ Target context (Ghc stage) binDeps [bin]
+    -- TODO: Use Link mode instead of Compile.
+    buildWithResources rs $ Target context (Ghc Compile stage) binDeps [bin]
     synopsis <- interpretInContext context $ getPkgData Synopsis
     putSuccess $ renderProgram
         ("'" ++ pkgNameString package ++ "' (" ++ show stage ++ ").")

src/Rules/Test.hs

@@ -15,7 +15,7 @@ import Settings.User
 testRules :: Rules ()
 testRules = do
     "validate" ~> do
-        needBuilder False $ Ghc Stage2 -- TODO: get rid of False parameters
+        needBuilder False $ Ghc Compile Stage2 -- TODO: get rid of False
         needBuilder False $ GhcPkg Stage1
         needBuilder False $ Hpc
         runMakeVerbose "testsuite/tests" ["fast"]
@@ -28,7 +28,7 @@ testRules = do
                     | pkg <- pkgs, isLibrary pkg, pkg /= rts, pkg /= libffi ]
         windows  <- windowsHost
         top      <- topDirectory
-        compiler <- builderPath $ Ghc Stage2
+        compiler <- builderPath $ Ghc Compile Stage2
         ghcPkg   <- builderPath $ GhcPkg Stage1
         haddock  <- builderPath Haddock
         threads  <- shakeThreads <$> getShakeOptions

src/Settings/Args.hs

@@ -51,7 +51,6 @@ defaultBuilderArgs = mconcat
     [ alexBuilderArgs
     , arBuilderArgs
     , ccBuilderArgs
-    , ccMBuilderArgs
     , deriveConstantsBuilderArgs
     , genApplyBuilderArgs
     , genPrimopCodeBuilderArgs

src/Settings/Builders/Cc.hs

-module Settings.Builders.Cc (ccBuilderArgs, ccMBuilderArgs) where
+module Settings.Builders.Cc (ccBuilderArgs) where
 
 import Development.Shake.FilePath
 import Expression
@@ -8,26 +8,26 @@ import Predicates (stagedBuilder)
 import Settings
 import Settings.Builders.Common (cIncludeArgs)
 
+-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
 ccBuilderArgs :: Args
-ccBuilderArgs = stagedBuilder Cc ?
-    mconcat [ commonCcArgs
-            , arg "-c", arg =<< getInput
-            , arg "-o", arg =<< getOutput ]
+ccBuilderArgs = mconcat
+    [ stagedBuilder (Cc Compile) ?
+        mconcat [ commonCcArgs
+                , arg "-c", arg =<< getInput
+                , arg "-o", arg =<< getOutput ]
 
--- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
-ccMBuilderArgs :: Args
-ccMBuilderArgs = stagedBuilder CcM ? do
-    output <- getOutput
-    mconcat [ arg "-E"
-            , arg "-MM"
-            , commonCcArgs
-            , arg "-MF"
-            , arg output
-            , arg "-MT"
-            , arg $ dropExtension output -<.> "o"
-            , arg "-x"
-            , arg "c"
-            , arg =<< getInput ]
+    , stagedBuilder (Cc FindDependencies) ? do
+        output <- getOutput
+        mconcat [ arg "-E"
+                , arg "-MM"
+                , commonCcArgs
+                , arg "-MF"
+                , arg output
+                , arg "-MT"
+                , arg $ dropExtension output -<.> "o"
+                , arg "-x"
+                , arg "c"
+                , arg =<< getInput ] ]
 
 commonCcArgs :: Args
 commonCcArgs = mconcat [ append =<< getPkgDataList CcArgs

src/Settings/Builders/DeriveConstants.hs

@@ -20,7 +20,7 @@ deriveConstantsBuilderArgs = builder DeriveConstants ? do
         , file "//GHCConstantsHaskellExports.hs"  ? arg "--gen-haskell-exports"
         , arg "-o", arg output
         , arg "--tmpdir", arg tempDir
-        , arg "--gcc-program", arg =<< getBuilderPath (Cc Stage1)
+        , arg "--gcc-program", arg =<< getBuilderPath (Cc Compile Stage1)
         , append . concat $ map (\a -> ["--gcc-flag", a]) cFlags
         , arg "--nm-program", arg =<< getBuilderPath Nm
         , specified Objdump ? mconcat [ arg "--objdump-program"

src/Settings/Builders/Ghc.hs

@@ -18,7 +18,7 @@ import Settings.Builders.Common (cIncludeArgs)
 --     $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno
 --     $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@)))
 ghcBuilderArgs :: Args
-ghcBuilderArgs = stagedBuilder Ghc ? do
+ghcBuilderArgs = stagedBuilder (Ghc Compile) ? do
     output <- getOutput
     stage  <- getStage
     way    <- getWay
@@ -61,7 +61,7 @@ splitObjectsArgs = splitObjects ? do
     arg "-split-objs"
 
 ghcMBuilderArgs :: Args
-ghcMBuilderArgs = stagedBuilder GhcM ? do
+ghcMBuilderArgs = stagedBuilder (Ghc FindDependencies) ? do
     ways <- getLibraryWays
     mconcat [ arg "-M"
             , commonGhcArgs

src/Settings/Builders/GhcCabal.hs

@@ -25,14 +25,14 @@ ghcCabalBuilderArgs = builder GhcCabal ? do
             , arg path
             , arg dir
             , dll0Args
-            , withStaged Ghc
+            , withStaged $ Ghc Compile
             , withStaged GhcPkg
             , bootPackageDbArgs
             , libraryArgs
             , with HsColour
             , configureArgs
             , packageConstraints
-            , withStaged Cc
+            , withStaged $ Cc Compile
             , notStage0 ? with Ld
             , with Ar
             , with Alex
@@ -85,7 +85,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 ]
+        , conf "--with-cc" $ argStagedBuilderPath (Cc Compile) ]
 
 newtype PackageDbKey = PackageDbKey Stage
     deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
@@ -114,8 +114,8 @@ withBuilderKey :: Builder -> String
 withBuilderKey b = case b of
     Ar       -> "--with-ar="
     Ld       -> "--with-ld="
-    Cc _     -> "--with-gcc="
-    Ghc _    -> "--with-ghc="
+    Cc  _ _  -> "--with-gcc="
+    Ghc _ _  -> "--with-ghc="
     Alex     -> "--with-alex="
     Happy    -> "--with-happy="
     GhcPkg _ -> "--with-ghc-pkg="

src/Settings/Builders/Hsc2Hs.hs

@@ -18,7 +18,7 @@ templateHsc = "inplace/lib/template-hsc.h"
 hsc2hsBuilderArgs :: Args
 hsc2hsBuilderArgs = builder Hsc2Hs ? do
     stage   <- getStage
-    ccPath  <- getBuilderPath $ Cc stage
+    ccPath  <- getBuilderPath $ Cc Compile stage
     gmpDir  <- getSetting GmpIncludeDir
     cFlags  <- getCFlags
     lFlags  <- getLFlags

src/Settings/Packages/Directory.hs

@@ -2,7 +2,7 @@ module Settings.Packages.Directory (directoryPackageArgs) where
 
 import Expression
 import GHC (directory)
-import Predicates (stagedBuilder, package)
+import Predicates (builderCc, package)
 
 -- TODO: I had to define symbol __GLASGOW_HASKELL__ as otherwise directory.c is
 -- effectively empty. I presume it was expected that GHC will be used for
@@ -10,4 +10,4 @@ import Predicates (stagedBuilder, package)
 -- only file which requires special treatment when using GCC.
 directoryPackageArgs :: Args
 directoryPackageArgs = package directory ?
-    stagedBuilder Cc ? arg "-D__GLASGOW_HASKELL__"
+    builderCc ? arg "-D__GLASGOW_HASKELL__"