Build mkUserGuidePart with stage-0
[hadrian.git] / src / Builder.hs
index fa76097..09b87cb 100644 (file)
@@ -1,15 +1,16 @@
 {-# LANGUAGE DeriveGeneric, LambdaCase #-}
 module Builder (
-    CompilerMode (..), Builder (..),
-    builderPath, getBuilderPath, specified, needBuilder
+    CcMode (..), GhcMode (..), Builder (..), builderPath, getBuilderPath,
+    builderEnvironment, specified, trackedArgument, needBuilder
     ) where
 
 import Control.Monad.Trans.Reader
+import Data.Char
+import GHC.Generics (Generic)
 
 import Base
 import Context
 import GHC
-import GHC.Generics (Generic)
 import Oracles.Config
 import Oracles.LookupInPath
 import Oracles.WindowsPath
@@ -19,10 +20,14 @@ 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 (Show, Eq, Generic)
+-- We have CcMode for CC and GhcMode for GHC.
+
+-- TODO: Consider merging FindCDependencies and FindMissingInclude
+data CcMode = CompileC | FindCDependencies | FindMissingInclude
+    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 +39,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
@@ -49,7 +54,7 @@ data Builder = Alex
              | HsCpp
              | Hsc2Hs
              | Ld
-             | Make
+             | Make FilePath
              | Nm
              | Objdump
              | Patch
@@ -57,7 +62,7 @@ data Builder = Alex
              | Ranlib
              | Tar
              | Unlit
-             deriving (Show, Eq, Generic)
+             deriving (Eq, Generic, Show)
 
 -- | Some builders are built by this very build system, in which case
 -- 'builderProvenance' returns the corresponding build 'Context' (which includes
@@ -93,11 +98,15 @@ isOptional = \case
     Objdump  -> True
     _        -> False
 
--- TODO: get rid of fromJust
 -- | Determine the location of a 'Builder'.
 builderPath :: Builder -> Action FilePath
 builderPath builder = case builderProvenance builder of
-    Just context -> return . fromJust $ programPath context
+    Just context
+      | Just path <- programPath context -> return path
+      | otherwise                        ->
+        -- TODO: Make builderPath total.
+        error $ "Cannot determine builderPath for " ++ show builder
+             ++ " in context " ++ show context
     Nothing -> case builder of
         Alex          -> fromKey "alex"
         Ar            -> fromKey "ar"
@@ -111,7 +120,7 @@ builderPath builder = case builderProvenance builder of
         HsColour      -> fromKey "hscolour"
         HsCpp         -> fromKey "hs-cpp"
         Ld            -> fromKey "ld"
-        Make          -> fromKey "make"
+        Make _        -> fromKey "make"
         Nm            -> fromKey "nm"
         Objdump       -> fromKey "objdump"
         Patch         -> fromKey "patch"
@@ -121,22 +130,41 @@ builderPath builder = case builderProvenance builder of
         _ -> error $ "Cannot determine builderPath for " ++ show builder
   where
     fromKey key = do
-        path <- askConfigWithDefault key . putError $ "\nCannot find path to '"
-            ++ key ++ "' in system.config file. Did you forget to run configure?"
+        let unpack = fromMaybe . error $ "Cannot find path to builder "
+                ++ quote key ++ " in system.config file. Did you skip configure?"
+        path <- unpack <$> askConfig key
         if null path
         then do
-            if isOptional builder
-            then return ""
-            else putError $ "Builder '" ++ key ++ "' is not specified in"
-                ++ " system.config file. Cannot proceed without it."
+            unless (isOptional builder) . error $ "Non optional builder "
+                ++ quote key ++ " is not specified in system.config file."
+            return "" -- TODO: Use a safe interface.
         else fixAbsolutePathOnWindows =<< lookupInPath path
 
 getBuilderPath :: Builder -> ReaderT a Action FilePath
 getBuilderPath = lift . builderPath
 
+-- | Write a Builder's path into a given environment variable.
+builderEnvironment :: String -> Builder -> Action CmdOption
+builderEnvironment variable builder = do
+    needBuilder builder
+    path <- builderPath builder
+    return $ AddEnv variable path
+
+-- | Was the path to a given 'Builder' specified in configuration files?
 specified :: Builder -> Action Bool
 specified = fmap (not . null) . builderPath
 
+-- | Some arguments do not affect build results and therefore do not need to be
+-- tracked by the build system. A notable example is "-jN" that controls Make's
+-- parallelism. Given a 'Builder' and an argument, this function should return
+-- 'True' only if the argument needs to be tracked.
+trackedArgument :: Builder -> String -> Bool
+trackedArgument (Make _) = not . threadArg
+trackedArgument _        = const True
+
+threadArg :: String -> Bool
+threadArg s = dropWhileEnd isDigit s `elem` ["-j", "MAKEFLAGS=-j", "THREADS="]
+
 -- | Make sure a Builder exists on the given path and rebuild it if out of date.
 needBuilder :: Builder -> Action ()
 needBuilder = \case
@@ -145,10 +173,14 @@ needBuilder = \case
         path <- builderPath builder
         need [path]
 
--- Instances for storing in the Shake database
-instance Binary CompilerMode
-instance Hashable CompilerMode
-instance NFData CompilerMode
+-- | Instances for storing in the Shake database.
+instance Binary CcMode
+instance Hashable CcMode
+instance NFData CcMode
+
+instance Binary GhcMode
+instance Hashable GhcMode
+instance NFData GhcMode
 
 instance Binary Builder
 instance Hashable Builder