d97c0ad2dcb381f9d6083291a8e38464f50d613e
[hadrian.git] / src / Builder.hs
1 {-# LANGUAGE DeriveGeneric, LambdaCase #-}
2 module Builder (
3 Builder (..), isStaged, builderPath, getBuilderPath, specified, needBuilder
4 ) where
5
6 import Control.Monad.Trans.Reader
7
8 import Base
9 import GHC
10 import GHC.Generics (Generic)
11 import Oracles.Config
12 import Oracles.LookupInPath
13 import Oracles.WindowsPath
14 import Package
15 import Stage
16
17 -- | A 'Builder' is an external command invoked in separate process using 'Shake.cmd'
18 --
19 -- @Ghc Stage0@ is the bootstrapping compiler
20 -- @Ghc StageN@, N > 0, is the one built on stage (N - 1)
21 -- @GhcPkg Stage0@ is the bootstrapping @GhcPkg@
22 -- @GhcPkg StageN@, N > 0, is the one built in Stage0 (TODO: need only Stage1?)
23 -- TODO: Do we really need HsCpp builder? Can't we use a generic Cpp
24 -- builder instead? It would also be used instead of GccM.
25 -- TODO: rename Gcc to CCompiler? We sometimes use gcc and sometimes clang.
26 -- TODO: why are Gcc/GccM staged?
27 data Builder = Alex
28 | Ar
29 | DeriveConstants
30 | Gcc Stage
31 | GccM Stage -- synonym for 'Gcc -MM'
32 | GenApply
33 | GenPrimopCode
34 | Ghc Stage
35 | GhcCabal
36 | GhcCabalHsColour -- synonym for 'GhcCabal hscolour'
37 | GhcM Stage -- synonym for 'Ghc -M'
38 | GhcPkg Stage
39 | Haddock
40 | Happy
41 | Hpc
42 | HsColour
43 | HsCpp
44 | Hsc2Hs
45 | Ld
46 | Make
47 | Nm
48 | Objdump
49 | Patch
50 | Perl
51 | Ranlib
52 | Tar
53 | Unlit
54 deriving (Show, Eq, Generic)
55
56 -- | Some builders are built by this very build system, in which case
57 -- 'builderProvenance' returns the corresponding 'Stage' and GHC 'Package'.
58 builderProvenance :: Builder -> Maybe (Stage, Package)
59 builderProvenance = \case
60 DeriveConstants -> Just (Stage0, deriveConstants)
61 GenApply -> Just (Stage0, genapply)
62 GenPrimopCode -> Just (Stage0, genprimopcode)
63 Ghc stage -> if stage == Stage0 then Nothing else Just (pred stage, ghc)
64 GhcM stage -> builderProvenance $ Ghc stage
65 GhcCabal -> Just (Stage0, ghcCabal)
66 GhcCabalHsColour -> builderProvenance $ GhcCabal
67 GhcPkg stage -> if stage > Stage0 then Just (Stage0, ghcPkg) else Nothing
68 Haddock -> Just (Stage2, haddock)
69 Hpc -> Just (Stage1, hpcBin)
70 Hsc2Hs -> Just (Stage0, hsc2hs)
71 Unlit -> Just (Stage0, unlit)
72 _ -> Nothing
73
74 isInternal :: Builder -> Bool
75 isInternal = isJust . builderProvenance
76
77 isStaged :: Builder -> Bool
78 isStaged = \case
79 (Gcc _) -> True
80 (GccM _) -> True
81 (Ghc _) -> True
82 (GhcM _) -> True
83 (GhcPkg _) -> True
84 _ -> False
85
86 -- TODO: get rid of fromJust
87 -- | Determine the location of a 'Builder'
88 builderPath :: Builder -> Action FilePath
89 builderPath builder = case builderProvenance builder of
90 Just (stage, pkg) -> return . fromJust $ programPath stage pkg
91 Nothing -> do
92 let builderKey = case builder of
93 Alex -> "alex"
94 Ar -> "ar"
95 Gcc Stage0 -> "system-gcc"
96 Gcc _ -> "gcc"
97 GccM Stage0 -> "system-gcc"
98 GccM _ -> "gcc"
99 Ghc Stage0 -> "system-ghc"
100 GhcM Stage0 -> "system-ghc"
101 GhcPkg Stage0 -> "system-ghc-pkg"
102 Happy -> "happy"
103 HsColour -> "hscolour"
104 HsCpp -> "hs-cpp"
105 Ld -> "ld"
106 Make -> "make"
107 Nm -> "nm"
108 Objdump -> "objdump"
109 Patch -> "patch"
110 Perl -> "perl"
111 Ranlib -> "ranlib"
112 Tar -> "tar"
113 _ -> error $ "Cannot determine builderKey for " ++ show builder
114 path <- askConfigWithDefault builderKey . putError $
115 "\nCannot find path to '" ++ builderKey
116 ++ "' in configuration files. Have you forgot to run configure?"
117 if path == "" -- TODO: get rid of "" paths
118 then return ""
119 else do
120 path' <- lookupInPath path
121 fixAbsolutePathOnWindows $ path' -<.> exe
122
123 getBuilderPath :: Builder -> ReaderT a Action FilePath
124 getBuilderPath = lift . builderPath
125
126 specified :: Builder -> Action Bool
127 specified = fmap (not . null) . builderPath
128
129 -- TODO: split into two functions: needBuilder (without laxDependencies) and
130 -- unsafeNeedBuilder (with the laxDependencies parameter)
131 -- | Make sure a builder exists on the given path and rebuild it if out of date.
132 -- If 'laxDependencies' is True then we do not rebuild GHC even if it is out of
133 -- date (can save a lot of build time when changing GHC).
134 needBuilder :: Bool -> Builder -> Action ()
135 needBuilder laxDependencies builder = when (isInternal builder) $ do
136 path <- builderPath builder
137 if laxDependencies && allowOrderOnlyDependency builder
138 then orderOnly [path]
139 else need [path]
140 where
141 allowOrderOnlyDependency :: Builder -> Bool
142 allowOrderOnlyDependency = \case
143 Ghc _ -> True
144 GhcM _ -> True
145 _ -> False
146
147 -- Instances for storing in the Shake database
148 instance Binary Builder
149 instance Hashable Builder
150 instance NFData Builder