Add Install Rules (#312)
[hadrian.git] / src / Rules / Generate.hs
1 module Rules.Generate (
2 isGeneratedCFile, isGeneratedCmmFile, generatePackageCode, generateRules,
3 copyRules, includesDependencies, generatedDependencies, inplaceLibCopyTargets
4 ) where
5
6 import Base
7 import Context hiding (package)
8 import Expression
9 import Flavour
10 import GHC
11 import Oracles.ModuleFiles
12 import Predicate
13 import Rules.Generators.ConfigHs
14 import Rules.Generators.GhcAutoconfH
15 import Rules.Generators.GhcBootPlatformH
16 import Rules.Generators.GhcPlatformH
17 import Rules.Generators.GhcSplit
18 import Rules.Generators.GhcVersionH
19 import Rules.Generators.VersionHs
20 import Rules.Libffi
21 import Settings
22 import Settings.Path
23 import Target
24 import UserSettings
25 import Util
26
27 -- | Files that need to be copied over to inplace/lib
28 -- ref: ghc/ghc.mk:142
29 -- ref: driver/ghc.mk
30 -- ref: utils/hsc2hs/ghc.mk:35
31 inplaceLibCopyTargets :: [FilePath]
32 inplaceLibCopyTargets = map (inplaceLibPath -/-)
33 [ "ghc-usage.txt"
34 , "ghci-usage.txt"
35 , "platformConstants"
36 , "settings"
37 , "template-hsc.h" ]
38
39 primopsSource :: FilePath
40 primopsSource = "compiler/prelude/primops.txt.pp"
41
42 primopsTxt :: Stage -> FilePath
43 primopsTxt stage = buildPath (vanillaContext stage compiler) -/- "primops.txt"
44
45 platformH :: Stage -> FilePath
46 platformH stage = buildPath (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
47
48 isGeneratedCFile :: FilePath -> Bool
49 isGeneratedCFile file = takeBaseName file `elem` ["Evac_thr", "Scav_thr"]
50
51 isGeneratedCmmFile :: FilePath -> Bool
52 isGeneratedCmmFile file = takeBaseName file == "AutoApply"
53
54 includesDependencies :: [FilePath]
55 includesDependencies = fmap (generatedPath -/-)
56 [ "ghcautoconf.h"
57 , "ghcplatform.h"
58 , "ghcversion.h" ]
59
60 ghcPrimDependencies :: Expr [FilePath]
61 ghcPrimDependencies = do
62 stage <- getStage
63 let path = buildPath $ vanillaContext stage ghcPrim
64 return [path -/- "GHC/Prim.hs", path -/- "GHC/PrimopWrappers.hs"]
65
66 derivedConstantsDependencies :: [FilePath]
67 derivedConstantsDependencies = fmap (generatedPath -/-)
68 [ "DerivedConstants.h"
69 , "GHCConstantsHaskellExports.hs"
70 , "GHCConstantsHaskellType.hs"
71 , "GHCConstantsHaskellWrappers.hs" ]
72
73 compilerDependencies :: Expr [FilePath]
74 compilerDependencies = do
75 stage <- getStage
76 let path = buildPath $ vanillaContext stage compiler
77 mconcat [ return [platformH stage]
78 , return includesDependencies
79 , return derivedConstantsDependencies
80 , notStage0 ? integerLibrary flavour == integerGmp ? return [gmpLibraryH]
81 , notStage0 ? return libffiDependencies
82 , return $ fmap (path -/-)
83 [ "primop-can-fail.hs-incl"
84 , "primop-code-size.hs-incl"
85 , "primop-commutable.hs-incl"
86 , "primop-data-decl.hs-incl"
87 , "primop-fixity.hs-incl"
88 , "primop-has-side-effects.hs-incl"
89 , "primop-list.hs-incl"
90 , "primop-out-of-line.hs-incl"
91 , "primop-primop-info.hs-incl"
92 , "primop-strictness.hs-incl"
93 , "primop-tag.hs-incl"
94 , "primop-vector-tycons.hs-incl"
95 , "primop-vector-tys-exports.hs-incl"
96 , "primop-vector-tys.hs-incl"
97 , "primop-vector-uniques.hs-incl" ] ]
98
99 generatedDependencies :: Expr [FilePath]
100 generatedDependencies = mconcat
101 [ package compiler ? compilerDependencies
102 , package ghcPrim ? ghcPrimDependencies
103 , package rts ? return (libffiDependencies
104 ++ includesDependencies
105 ++ derivedConstantsDependencies)
106 , stage0 ? return includesDependencies ]
107
108 generate :: FilePath -> Context -> Expr String -> Action ()
109 generate file context expr = do
110 contents <- interpretInContext context expr
111 writeFileChanged file contents
112 putSuccess $ "| Successfully generated " ++ file ++ "."
113
114 generatePackageCode :: Context -> Rules ()
115 generatePackageCode context@(Context stage pkg _) =
116 let path = buildPath context
117 generated f = (path ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
118 go gen file = generate file context gen
119 in do
120 generated ?> \file -> do
121 let unpack = fromMaybe . error $ "No generator for " ++ file ++ "."
122 (src, builder) <- unpack <$> findGenerator context file
123 need [src]
124 build $ Target context builder [src] [file]
125 let boot = src -<.> "hs-boot"
126 whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot"
127
128 priority 2.0 $ do
129 when (pkg == compiler) $ path -/- "Config.hs" %> go generateConfigHs
130 when (pkg == ghcPkg) $ path -/- "Version.hs" %> go generateVersionHs
131
132 -- TODO: needing platformH is ugly and fragile
133 when (pkg == compiler) $ do
134 primopsTxt stage %> \file -> do
135 need $ [platformH stage, primopsSource] ++ includesDependencies
136 build $ Target context HsCpp [primopsSource] [file]
137
138 platformH stage %> go generateGhcBootPlatformH
139
140 -- TODO: why different folders for generated files?
141 fmap (path -/-)
142 [ "GHC/Prim.hs"
143 , "GHC/PrimopWrappers.hs"
144 , "*.hs-incl" ] |%> \file -> do
145 need [primopsTxt stage]
146 build $ Target context GenPrimopCode [primopsTxt stage] [file]
147
148 when (pkg == rts) $ path -/- "cmm/AutoApply.cmm" %> \file ->
149 build $ Target context GenApply [] [file]
150
151 copyRules :: Rules ()
152 copyRules = do
153 (inplaceLibPath -/- "ghc-usage.txt") <~ "driver"
154 (inplaceLibPath -/- "ghci-usage.txt" ) <~ "driver"
155 (inplaceLibPath -/- "platformConstants") <~ generatedPath
156 (inplaceLibPath -/- "settings") <~ "."
157 (inplaceLibPath -/- "template-hsc.h") <~ pkgPath hsc2hs
158 rtsBuildPath -/- "c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
159 rtsBuildPath -/- "c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
160 where
161 file <~ dir = file %> copyFile (dir -/- takeFileName file)
162
163 generateRules :: Rules ()
164 generateRules = do
165 (generatedPath -/- "ghcautoconf.h") <~ generateGhcAutoconfH
166 (generatedPath -/- "ghcplatform.h") <~ generateGhcPlatformH
167 (generatedPath -/- "ghcversion.h") <~ generateGhcVersionH
168
169 ghcSplitPath %> \_ -> do
170 generate ghcSplitPath emptyTarget generateGhcSplit
171 makeExecutable ghcSplitPath
172
173 -- TODO: simplify, get rid of fake rts context
174 generatedPath ++ "//*" %> \file -> do
175 withTempDir $ \dir -> build $
176 Target rtsContext DeriveConstants [] [file, dir]
177 where
178 file <~ gen = file %> \out -> generate out emptyTarget gen
179
180 -- TODO: Use the Types, Luke! (drop partial function)
181 -- We sometimes need to evaluate expressions that do not require knowing all
182 -- information about the context. In this case, we don't want to know anything.
183 emptyTarget :: Context
184 emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage")
185 (error "Rules.Generate.emptyTarget: unknown package")