Move GMP paths to Settings.Paths.
[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 hiding (stage)
10 import Expression
11 import GHC
12 import Rules.Generators.ConfigHs
13 import Rules.Generators.GhcAutoconfH
14 import Rules.Generators.GhcBootPlatformH
15 import Rules.Generators.GhcPlatformH
16 import Rules.Generators.GhcSplit
17 import Rules.Generators.GhcVersionH
18 import Rules.Generators.VersionHs
19 import Oracles.ModuleFiles
20 import Rules.Actions
21 import Rules.Libffi
22 import Settings
23 import Target hiding (builder, context)
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 maybeValue <- findGenerator context file
111 (src, builder) <- case maybeValue of
112 Nothing -> putError $ "No generator for " ++ file ++ "."
113 Just value -> return value
114 need [src]
115 build $ Target context builder [src] [file]
116 let srcBoot = src -<.> "hs-boot"
117 whenM (doesFileExist srcBoot) $
118 copyFile srcBoot $ file -<.> "hs-boot"
119
120 -- TODO: needing platformH is ugly and fragile
121 when (pkg == compiler) $ primopsTxt stage %> \file -> do
122 need $ [platformH stage, primopsSource] ++ includesDependencies
123 build $ Target context HsCpp [primopsSource] [file]
124
125 -- TODO: why different folders for generated files?
126 fmap (path -/-)
127 [ "autogen/GHC/Prim.hs"
128 , "GHC/PrimopWrappers.hs"
129 , "*.hs-incl" ] |%> \file -> do
130 need [primopsTxt stage]
131 build $ Target context GenPrimopCode [primopsTxt stage] [file]
132 -- TODO: this is temporary hack, get rid of this (#113)
133 let oldPath = pkgPath pkg -/- contextDirectory context -/- "build"
134 newFile = oldPath ++ (drop (length path) file)
135 createDirectory $ takeDirectory newFile
136 liftIO $ IO.copyFile file newFile
137 putSuccess $ "| Duplicate file " ++ file ++ " -> " ++ newFile
138
139 when (pkg == rts) $ path -/- "AutoApply.cmm" %> \file -> do
140 build $ Target context GenApply [] [file]
141
142 priority 2.0 $ do
143 -- TODO: this is temporary hack, get rid of this (#113)
144 let oldPath = pkgPath pkg -/- contextDirectory context -/- "build"
145 olden f = oldPath ++ (drop (length (buildPath context)) f)
146
147 when (pkg == compiler) $ path -/- "Config.hs" %> \file -> do
148 file <~ generateConfigHs
149 olden file <~ generateConfigHs -- TODO: get rid of this (#113)
150
151 when (pkg == compiler) $ platformH stage %> \file -> do
152 file <~ generateGhcBootPlatformH
153
154 when (pkg == ghcPkg) $ path -/- "Version.hs" %> \file -> do
155 file <~ generateVersionHs
156 olden file <~ generateVersionHs -- TODO: get rid of this (#113)
157
158 when (pkg == runGhc) $ path -/- "Main.hs" %> \file -> do
159 copyFileChanged (pkgPath pkg -/- "runghc.hs") file
160 putSuccess $ "| Successfully generated '" ++ file ++ "'."
161
162 copyRules :: Rules ()
163 copyRules = do
164 "inplace/lib/ghc-usage.txt" <~ "driver"
165 "inplace/lib/ghci-usage.txt" <~ "driver"
166 "inplace/lib/platformConstants" <~ derivedConstantsPath
167 "inplace/lib/settings" <~ "."
168 "inplace/lib/template-hsc.h" <~ pkgPath hsc2hs
169 rtsBuildPath -/- "sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
170 rtsBuildPath -/- "sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
171 where
172 file <~ dir = file %> copyFile (dir -/- takeFileName file)
173
174 generateRules :: Rules ()
175 generateRules = do
176 "includes/ghcautoconf.h" <~ generateGhcAutoconfH
177 "includes/ghcplatform.h" <~ generateGhcPlatformH
178 "includes/ghcversion.h" <~ generateGhcVersionH
179
180 ghcSplit %> \_ -> do
181 generate ghcSplit emptyTarget generateGhcSplit
182 makeExecutable ghcSplit
183
184 -- TODO: simplify, get rid of fake rts context
185 derivedConstantsPath ++ "//*" %> \file -> do
186 withTempDir $ \dir -> build $
187 Target rtsContext DeriveConstants [] [file, dir]
188
189 where
190 file <~ gen = file %> \out -> generate out emptyTarget gen
191
192 -- TODO: Use the Types, Luke! (drop partial function)
193 -- We sometimes need to evaluate expressions that do not require knowing all
194 -- information about the context. In this case, we don't want to know anything.
195 emptyTarget :: Context
196 emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage")
197 (error "Rules.Generate.emptyTarget: unknown package")