Build mkUserGuidePart with stage-0
[hadrian.git] / src / Builder.hs
index 007dae3..09b87cb 100644 (file)
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, LambdaCase #-}
 module Builder (
-    Builder (..), builderPath, getBuilderPath, specified, needBuilder
+    CcMode (..), GhcMode (..), Builder (..), builderPath, getBuilderPath,
+    builderEnvironment, specified, trackedArgument, needBuilder
     ) where
 
-import Base
+import Control.Monad.Trans.Reader
+import Data.Char
 import GHC.Generics (Generic)
-import Oracles
+
+import Base
+import Context
+import GHC
+import Oracles.Config
+import Oracles.LookupInPath
+import Oracles.WindowsPath
 import Stage
 
--- A Builder is an external command invoked in separate process using Shake.cmd
+-- | 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: add Cpp builders
--- TODO: rename Gcc to Cc?
--- TODO: do we really need staged builders?
+-- @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?)
 data Builder = Alex
              | Ar
-             | Gcc Stage
-             | GccM Stage
+             | DeriveConstants
+             | Cc CcMode Stage
+             | Configure FilePath
+             | GenApply
              | GenPrimopCode
-             | Ghc Stage
+             | Ghc GhcMode Stage
              | GhcCabal
-             | GhcCabalHsColour
-             | GhcLink Stage
-             | GhcM Stage
+             | GhcCabalHsColour   -- synonym for 'GhcCabal hscolour'
              | GhcPkg Stage
-             | GhcSplit
              | Haddock
              | Happy
+             | Hpc
              | HsColour
              | HsCpp
              | Hsc2Hs
              | Ld
+             | Make FilePath
+             | Nm
+             | Objdump
+             | Patch
+             | Perl
+             | Ranlib
+             | Tar
              | Unlit
-             deriving (Show, Eq, Generic)
-
--- Configuration files refer to Builders as follows:
-builderKey :: Builder -> String
-builderKey builder = case builder of
-    Alex             -> "alex"
-    Ar               -> "ar"
-    Gcc Stage0       -> "system-gcc"
-    Gcc _            -> "gcc"
-    GccM stage       -> builderKey $ Gcc stage -- synonym for 'Gcc -MM'
-    GenPrimopCode    -> "genprimopcode"
-    Ghc Stage0       -> "system-ghc"
-    Ghc Stage1       -> "ghc-stage1"
-    Ghc Stage2       -> "ghc-stage2"
-    Ghc Stage3       -> "ghc-stage3"
-    GhcLink stage    -> builderKey $ Ghc stage -- using Ghc as linker
-    GhcM stage       -> builderKey $ Ghc stage -- synonym for 'Ghc -M'
-    GhcCabal         -> "ghc-cabal"
-    GhcCabalHsColour -> builderKey $ GhcCabal -- synonym for 'GhcCabal hscolour'
-    GhcPkg Stage0    -> "system-ghc-pkg"
-    GhcPkg _         -> "ghc-pkg"
-    GhcSplit         -> "ghc-split"
-    Happy            -> "happy"
-    Haddock          -> "haddock"
-    HsColour         -> "hscolour"
-    Hsc2Hs           -> "hsc2hs"
-    HsCpp            -> "hs-cpp"
-    Ld               -> "ld"
-    Unlit            -> "unlit"
+             deriving (Eq, Generic, Show)
+
+-- | Some builders are built by this very build system, in which case
+-- 'builderProvenance' returns the corresponding build 'Context' (which includes
+-- 'Stage' and GHC 'Package').
+builderProvenance :: Builder -> Maybe Context
+builderProvenance = \case
+    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 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
+
+-- 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 = do
-    path <- askConfigWithDefault (builderKey builder) $
-            putError $ "\nCannot find path to '" ++ (builderKey builder)
-                     ++ "' in configuration files."
-    fixAbsolutePathOnWindows $ if null path then "" else path -<.> exe
+builderPath builder = case builderProvenance builder of
+    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 = do
-    path <- builderPath builder
-    if laxDependencies && allowOrderOnlyDependency builder
-    then orderOnly [path]
-    else need      [path]
-  where
-    allowOrderOnlyDependency :: Builder -> Bool
-    allowOrderOnlyDependency b = case b of
-        Ghc  _ -> True
-        GhcM _ -> True
-        _      -> False
-
--- On Windows: if the path starts with "/", prepend it with the correct path to
--- the root, e.g: "/usr/local/bin/ghc.exe" => "C:/msys/usr/local/bin/ghc.exe".
-fixAbsolutePathOnWindows :: FilePath -> Action FilePath
-fixAbsolutePathOnWindows path = do
-    windows <- windowsHost
-    -- Note, below is different from FilePath.isAbsolute:
-    if (windows && "/" `isPrefixOf` path)
-    then do
-        root <- windowsRoot
-        return . unifyPath $ root ++ drop 1 path
-    else
-        return path
-
--- Instances for storing in the Shake database
+-- | 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
 instance NFData Builder