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