Build mkUserGuidePart with stage-0
[hadrian.git] / src / Builder.hs
index 348e7e9..09b87cb 100644 (file)
@@ -1,25 +1,33 @@
 {-# LANGUAGE DeriveGeneric, LambdaCase #-}
 module Builder (
-    CompilerMode (..), Builder (..),
-    isStaged, 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
 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)
+-- | A compiler can typically be used in one of three modes:
+-- 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.
+-- 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'
@@ -31,10 +39,11 @@ data CompilerMode = Compile | FindDependencies deriving (Show, Eq, Generic)
 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
@@ -45,7 +54,7 @@ data Builder = Alex
              | HsCpp
              | Hsc2Hs
              | Ld
-             | Make
+             | Make FilePath
              | Nm
              | Objdump
              | Patch
@@ -53,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
@@ -79,13 +88,6 @@ builderProvenance = \case
 isInternal :: Builder -> Bool
 isInternal = isJust . builderProvenance
 
-isStaged :: Builder -> Bool
-isStaged = \case
-    (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
 -- support for platform-specific optional builders as soon as we can reliably
@@ -96,69 +98,89 @@ isOptional = \case
     Objdump  -> True
     _        -> False
 
--- TODO: get rid of fromJust
--- | Determine the location of a 'Builder'
+-- | Determine the location of a 'Builder'.
 builderPath :: Builder -> Action FilePath
 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"
-                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
-            ++ "' in system.config file. Have you forgot to run configure?"
+    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"
+        Cc  _  Stage0 -> fromKey "system-cc"
+        Cc  _  _      -> fromKey "cc"
+        -- We can't ask configure for the path to configure!
+        Configure _   -> return "bash configure"
+        Ghc _  Stage0 -> fromKey "system-ghc"
+        GhcPkg Stage0 -> fromKey "system-ghc-pkg"
+        Happy         -> fromKey "happy"
+        HsColour      -> fromKey "hscolour"
+        HsCpp         -> fromKey "hs-cpp"
+        Ld            -> fromKey "ld"
+        Make _        -> fromKey "make"
+        Nm            -> fromKey "nm"
+        Objdump       -> fromKey "objdump"
+        Patch         -> fromKey "patch"
+        Perl          -> fromKey "perl"
+        Ranlib        -> fromKey "ranlib"
+        Tar           -> fromKey "tar"
+        _ -> error $ "Cannot determine builderPath for " ++ show builder
+  where
+    fromKey key = do
+        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 '" ++ builderKey ++ "' 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
 
--- TODO: split into two functions: needBuilder (without laxDependencies) and
--- unsafeNeedBuilder (with the laxDependencies parameter)
--- | Make sure a builder exists on the given path and rebuild it if out of date.
--- If 'laxDependencies' is True then we do not rebuild GHC even if it is out of
--- date (can save a lot of build time when changing GHC).
-needBuilder :: Bool -> Builder -> Action ()
-needBuilder laxDependencies builder = when (isInternal builder) $ do
-    path <- builderPath builder
-    if laxDependencies && allowOrderOnlyDependency builder
-    then orderOnly [path]
-    else need      [path]
-  where
-    allowOrderOnlyDependency :: Builder -> Bool
-    allowOrderOnlyDependency = \case
-        Ghc _ _ -> True
-        _       -> False
-
--- Instances for storing in the Shake database
-instance Binary CompilerMode
-instance Hashable CompilerMode
-instance NFData CompilerMode
+-- | 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
+    Configure dir -> need [dir -/- "configure"]
+    builder       -> when (isInternal builder) $ do
+        path <- builderPath builder
+        need [path]
+
+-- | 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