5bc0aed47b5be941d83cff5c6357007c7286b091
[hadrian.git] / src / Predicates.hs
1 module Predicates (
2 stage, package, builder, stagedBuilder, file, way,
3 stage0, stage1, stage2, notStage, notStage0,
4 registerPackage, splitObjects
5 ) where
6
7 import Expression
8 import GHC
9 import Oracles
10
11 -- Basic predicates (see Switches.hs for derived predicates)
12 stage :: Stage -> Predicate
13 stage s = liftM (s ==) getStage
14
15 package :: Package -> Predicate
16 package p = liftM (p ==) getPackage
17
18 -- For unstaged builders, e.g. GhcCabal
19 builder :: Builder -> Predicate
20 builder b = liftM (b ==) getBuilder
21
22 -- For staged builders, e.g. Ghc Stage
23 stagedBuilder :: (Stage -> Builder) -> Predicate
24 stagedBuilder sb = (builder . sb) =<< getStage
25
26 file :: FilePattern -> Predicate
27 file f = liftM (any (f ?==)) getFiles
28
29 way :: Way -> Predicate
30 way w = liftM (w ==) getWay
31
32 -- Derived predicates
33 stage0 :: Predicate
34 stage0 = stage Stage0
35
36 stage1 :: Predicate
37 stage1 = stage Stage1
38
39 stage2 :: Predicate
40 stage2 = stage Stage2
41
42 notStage :: Stage -> Predicate
43 notStage = liftM not . stage
44
45 notStage0 :: Predicate
46 notStage0 = liftM not stage0
47
48 -- TODO: Actually, we don't register compiler in some circumstances -- fix.
49 registerPackage :: Predicate
50 registerPackage = return True
51
52 splitObjects :: Predicate
53 splitObjects = do
54 goodStage <- notStage0 -- We don't split bootstrap (stage 0) packages
55 goodPkg <- liftM not $ package compiler -- We don't split compiler
56 broken <- lift $ flag SplitObjectsBroken
57 ghcUnreg <- lift $ flag GhcUnregisterised
58 goodArch <- lift $ targetArchs [ "i386", "x86_64", "powerpc", "sparc" ]
59 goodOs <- lift $ targetOss [ "mingw32", "cygwin32", "linux", "darwin"
60 , "solaris2", "freebsd", "dragonfly"
61 , "netbsd", "openbsd" ]
62 return $ goodStage && goodPkg && not broken && not ghcUnreg && goodArch && goodOs