1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
|
{-# LANGUAGE FlexibleContexts #-}
module Expression (
-- * Expressions
Expr, Predicate, Args, Ways,
-- ** Construction and modification
expr, exprIO, arg, remove, cabalFlag,
-- ** Predicates
(?), stage, stage0, stage1, stage2, notStage0, buildingCompilerStage,
buildingCompilerStage', threadedBootstrapper,
package, notPackage, packageOneOf, cross, notCross,
libraryPackage, builder, way, input, inputs, output, outputs,
-- ** Evaluation
interpret, interpretInContext,
-- * Convenient accessors
getBuildRoot, getContext, getOutputs, getInputs,
getInput, getOutput, getContextData,
-- * Re-exports
module Base,
module Builder,
module Context,
) where
import Base
import Builder
import Context hiding (stage, package, way)
import Expression.Type
import Oracles.Flag
import Hadrian.Expression hiding (Expr, Predicate, Args)
import Hadrian.Haskell.Cabal.Type
import Hadrian.Oracles.Cabal
-- | Get values from a configured cabal stage.
getContextData :: (ContextData -> a) -> Expr a
getContextData key = do
contextData <- expr . readContextData =<< getContext
return $ key contextData
-- | Is the build currently in the provided stage?
stage :: Stage -> Predicate
stage s = (s ==) <$> getStage
-- | Is a particular package being built?
package :: Package -> Predicate
package p = (p ==) <$> getPackage
packageOneOf :: [Package] -> Predicate
packageOneOf ps = (`elem` ps) <$> getPackage
-- | This type class allows the user to construct both precise builder
-- predicates, such as @builder (Ghc CompileHs Stage1)@, as well as predicates
-- covering a set of similar builders. For example, @builder (Ghc CompileHs)@
-- matches any stage, and @builder Ghc@ matches any stage and any GHC mode.
class BuilderPredicate a where
-- | Is a particular builder being used?
builder :: a -> Predicate
instance BuilderPredicate Builder where
builder b = (b ==) <$> getBuilder
instance BuilderPredicate a => BuilderPredicate (Stage -> a) where
builder f = builder . f =<< getStage
instance BuilderPredicate a => BuilderPredicate (CcMode -> a) where
builder f = do
b <- getBuilder
case b of
Cc c _ -> builder (f c)
_ -> return False
instance BuilderPredicate a => BuilderPredicate (GhcMode -> a) where
builder f = do
b <- getBuilder
case b of
Ghc c _ -> builder (f c)
_ -> return False
instance BuilderPredicate a => BuilderPredicate (FilePath -> a) where
builder f = do
b <- getBuilder
case b of
Configure path -> builder (f path)
_ -> return False
instance BuilderPredicate a => BuilderPredicate (TestMode -> a) where
builder f = do
b <- getBuilder
case b of
Testsuite mode -> builder (f mode)
_ -> return False
-- | Is the current build 'Way' equal to a certain value?
way :: Way -> Predicate
way w = (w ==) <$> getWay
{-
Note [Stage Names]
~~~~~~~~~~~~~~~~~~
Code referring to specific stages can be a bit tricky. In Hadrian, the stages
have the same names they carried in the autoconf build system, but they are
often referred to by the stage used to construct them. For example, the stage 1
artifacts will be placed in _build/stage0, because they are constructed by the
stage 0 compiler. The stage predicates in this module behave the same way,
'stage0' will return 'True' while stage 0 is being used to build the stage 1
compiler.
-}
-- | Is the build currently in stage 0?
stage0 :: Predicate
stage0 = p <$> getStage
where
p (Stage0 {}) = True
p _ = False
-- | Is the build currently in stage 1?
stage1 :: Predicate
stage1 = stage Stage1
-- | Is the build currently in stage 2?
stage2 :: Predicate
stage2 = stage Stage2
-- | Is the build /not/ in stage 0 right now?
notStage0 :: Predicate
notStage0 = notM Expression.stage0
-- | Are we currently building a compiler for a particular stage?
buildingCompilerStage :: Stage -> Predicate
buildingCompilerStage s = buildingCompilerStage' (== s)
-- | Like 'buildingCompilerStage', but lifts an arbitrary predicate on 'Stage',
-- which is useful for checking flavour fields like 'ghcProfiled' and
-- 'ghcDebugged'.
buildingCompilerStage' :: (Stage -> Bool) -> Predicate
buildingCompilerStage' f = f . succStage <$> getStage
-- | Whether or not the bootstrapping compiler provides a threaded RTS. We need
-- to know this when building stage 1, since stage 1 links against the
-- compiler's RTS ways. See Note [Linking ghc-bin against threaded stage0 RTS]
-- in Settings.Packages for details.
threadedBootstrapper :: Predicate
threadedBootstrapper = expr (flag BootstrapThreadedRts)
-- | Is a certain package /not/ built right now?
notPackage :: Package -> Predicate
notPackage = notM . package
-- | Is a library package currently being built?
libraryPackage :: Predicate
libraryPackage = isLibrary <$> getPackage
-- | Either @-flagName@ or @flagName@, depending upon a predicate.
-- For use in @Cabal Flags@ argument lists.
cabalFlag :: ToPredicate p Context Builder => p -> String -> Args
cabalFlag pred flagName = do
ifM (toPredicate pred) (arg flagName) (arg $ "-"<>flagName)
infixr 3 `cabalFlag`
cross :: Predicate
cross = expr (flag CrossCompiling)
notCross :: Predicate
notCross = notM cross
|
