Build mkUserGuidePart with stage-0
[hadrian.git] / src / Builder.hs
index 22723a5..09b87cb 100644 (file)
@@ -1,46 +1,60 @@
 {-# LANGUAGE DeriveGeneric, LambdaCase #-}
 module Builder (
-    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
-import Package
+import Oracles.Config
+import Oracles.LookupInPath
+import Oracles.WindowsPath
 import Stage
 
+-- | 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'
 --
 -- @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 GccM.
--- TODO: rename Gcc to CCompiler? We sometimes use gcc and sometimes clang.
--- TODO: why are Gcc/GccM staged?
 data Builder = Alex
              | Ar
              | DeriveConstants
-             | Gcc Stage
-             | GccM Stage         -- synonym for 'Gcc -MM'
+             | Cc CcMode Stage
+             | Configure FilePath
              | GenApply
              | GenPrimopCode
-             | Ghc Stage
+             | Ghc GhcMode Stage
              | GhcCabal
              | GhcCabalHsColour   -- synonym for 'GhcCabal hscolour'
-             | GhcM Stage         -- synonym for 'Ghc -M'
              | GhcPkg Stage
              | Haddock
              | Happy
+             | Hpc
              | HsColour
              | HsCpp
              | Hsc2Hs
              | Ld
-             | Make
+             | Make FilePath
              | Nm
              | Objdump
              | Patch
@@ -48,97 +62,126 @@ 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 'Stage' and GHC 'Package'.
-builderProvenance :: Builder -> Maybe (Stage, Package)
+-- 'builderProvenance' returns the corresponding build 'Context' (which includes
+-- 'Stage' and GHC 'Package').
+builderProvenance :: Builder -> Maybe Context
 builderProvenance = \case
-    DeriveConstants  -> Just (Stage0, deriveConstants)
-    GenApply         -> Just (Stage0, genapply)
-    GenPrimopCode    -> Just (Stage0, genprimopcode)
-    Ghc stage        -> if stage > Stage0 then Just (pred stage, ghc) else Nothing
-    GhcM stage       -> builderProvenance $ Ghc stage
-    GhcCabal         -> Just (Stage0, ghcCabal)
+    DeriveConstants  -> context Stage0 deriveConstants
+    GenApply         -> context Stage0 genapply
+    GenPrimopCode    -> context Stage0 genprimopcode
+    Ghc _ Stage0     -> Nothing
+    Ghc _ stage      -> context (pred stage) ghc
+    GhcCabal         -> context Stage0 ghcCabal
     GhcCabalHsColour -> builderProvenance $ GhcCabal
-    GhcPkg stage     -> if stage > Stage0 then Just (Stage0, ghcPkg) else Nothing
-    Haddock          -> Just (Stage2, haddock)
-    Hsc2Hs           -> Just (Stage0, hsc2hs)
-    Unlit            -> Just (Stage0, unlit)
+    GhcPkg stage     -> if stage > Stage0 then context Stage0 ghcPkg else Nothing
+    Haddock          -> context Stage2 haddock
+    Hpc              -> context Stage1 hpcBin
+    Hsc2Hs           -> context Stage0 hsc2hs
+    Unlit            -> context Stage0 unlit
     _                -> Nothing
+  where
+    context s p = Just $ vanillaContext s p
 
 isInternal :: Builder -> Bool
 isInternal = isJust . builderProvenance
 
-isStaged :: Builder -> Bool
-isStaged = \case
-    (Gcc    _) -> True
-    (GccM   _) -> True
-    (Ghc    _) -> True
-    (GhcM   _) -> True
-    (GhcPkg _) -> True
-    _          -> False
-
--- TODO: get rid of fromJust
--- | Determine the location of a 'Builder'
+-- 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
+-- test this feature.
+isOptional :: Builder -> Bool
+isOptional = \case
+    HsColour -> True
+    Objdump  -> True
+    _        -> False
+
+-- | Determine the location of a 'Builder'.
 builderPath :: Builder -> Action FilePath
 builderPath builder = case builderProvenance builder of
-    Just (stage, pkg) -> return . fromJust $ programPath stage pkg
-    Nothing -> do
-        let builderKey = case builder of
-                Alex          -> "alex"
-                Ar            -> "ar"
-                Gcc Stage0    -> "system-gcc"
-                Gcc _         -> "gcc"
-                GccM Stage0   -> "system-gcc"
-                GccM _        -> "gcc"
-                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"
-                _ -> error $ "Cannot determine builderKey for " ++ show builder
-        path <- askConfigWithDefault builderKey . putError $
-            "\nCannot find path to '" ++ builderKey
-            ++ "' in configuration files. Have you forgot to run configure?"
-        windows <- windowsHost
-        case (path, windows) of
-            ("", _)    -> return path
-            (p, True)  -> fixAbsolutePathOnWindows (p -<.> exe)
-            (p, False) -> lookupInPath (p -<.> exe)
+    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
+            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
 
--- | 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
-        GhcM _ -> True
-        _      -> False
+-- | 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
 
--- Instances for storing in the Shake database
 instance Binary Builder
 instance Hashable Builder
 instance NFData Builder