050f83c3005dcf0c1c4fbf7cc93dbbd0862a80f4
[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.Gmp
22 import Rules.Libffi
23 import Settings
24 import Target hiding (builder, context)
25
26 installTargets :: [FilePath]
27 installTargets = [ "inplace/lib/ghc-usage.txt"
28 , "inplace/lib/ghci-usage.txt"
29 , "inplace/lib/platformConstants"
30 , "inplace/lib/settings"
31 , "inplace/lib/template-hsc.h" ]
32
33 primopsSource :: FilePath
34 primopsSource = "compiler/prelude/primops.txt.pp"
35
36 primopsTxt :: Stage -> FilePath
37 primopsTxt stage = targetPath stage compiler -/- "build/primops.txt"
38
39 platformH :: Stage -> FilePath
40 platformH stage = targetPath stage compiler -/- "ghc_boot_platform.h"
41
42 -- TODO: move generated files to buildRootPath, see #113
43 includesDependencies :: [FilePath]
44 includesDependencies = ("includes" -/-) <$>
45 [ "ghcautoconf.h"
46 , "ghcplatform.h"
47 , "ghcversion.h" ]
48
49 ghcPrimDependencies :: Stage -> [FilePath]
50 ghcPrimDependencies stage = ((targetPath stage ghcPrim -/- "build") -/-) <$>
51 [ "autogen/GHC/Prim.hs"
52 , "GHC/PrimopWrappers.hs" ]
53
54 derivedConstantsPath :: FilePath
55 derivedConstantsPath = "includes/dist-derivedconstants/header"
56
57 derivedConstantsDependencies :: [FilePath]
58 derivedConstantsDependencies = installTargets ++ fmap (derivedConstantsPath -/-)
59 [ "DerivedConstants.h"
60 , "GHCConstantsHaskellExports.hs"
61 , "GHCConstantsHaskellType.hs"
62 , "GHCConstantsHaskellWrappers.hs" ]
63
64 compilerDependencies :: Stage -> [FilePath]
65 compilerDependencies stage =
66 [ platformH stage ]
67 ++ includesDependencies
68 ++ [ gmpLibraryH | stage > Stage0 ]
69 ++ filter (const $ stage > Stage0) libffiDependencies
70 ++ derivedConstantsDependencies
71 ++ fmap ((targetPath stage compiler -/- "build") -/-)
72 [ "primop-can-fail.hs-incl"
73 , "primop-code-size.hs-incl"
74 , "primop-commutable.hs-incl"
75 , "primop-data-decl.hs-incl"
76 , "primop-fixity.hs-incl"
77 , "primop-has-side-effects.hs-incl"
78 , "primop-list.hs-incl"
79 , "primop-out-of-line.hs-incl"
80 , "primop-primop-info.hs-incl"
81 , "primop-strictness.hs-incl"
82 , "primop-tag.hs-incl"
83 , "primop-vector-tycons.hs-incl"
84 , "primop-vector-tys-exports.hs-incl"
85 , "primop-vector-tys.hs-incl"
86 , "primop-vector-uniques.hs-incl" ]
87
88 -- TODO: Turn this into a FilePaths expression
89 generatedDependencies :: Stage -> Package -> [FilePath]
90 generatedDependencies stage pkg
91 | pkg == compiler = compilerDependencies stage
92 | pkg == ghcPrim = ghcPrimDependencies stage
93 | pkg == rts = libffiDependencies ++ includesDependencies
94 ++ derivedConstantsDependencies
95 | stage == Stage0 = includesDependencies
96 | otherwise = []
97
98 -- The following generators and corresponding source extensions are supported:
99 knownGenerators :: [ (Builder, String) ]
100 knownGenerators = [ (Alex , ".x" )
101 , (Happy , ".y" )
102 , (Happy , ".ly" )
103 , (Hsc2Hs, ".hsc") ]
104
105 determineBuilder :: FilePath -> Maybe Builder
106 determineBuilder file = fmap fst $ find (\(_, e) -> e == ext) knownGenerators
107 where
108 ext = takeExtension file
109
110 generate :: FilePath -> Context -> Expr String -> Action ()
111 generate file context expr = do
112 contents <- interpretInContext context expr
113 writeFileChanged file contents
114 putSuccess $ "| Successfully generated '" ++ file ++ "'."
115
116 generatePackageCode :: Context -> Rules ()
117 generatePackageCode context @ (Context stage pkg _) =
118 let buildPath = targetPath stage pkg -/- "build"
119 dropBuild = drop (length buildPath + 1)
120 generated f = (buildPath ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
121 file <~ gen = generate file context gen
122 in do
123 generated ?> \file -> do
124 let srcFile = dropBuild file
125 pattern = "//" ++ srcFile -<.> "*"
126 files <- fmap (filter (pattern ?==)) $ moduleFiles stage pkg
127 let gens = [ (f, b) | f <- files, Just b <- [determineBuilder f] ]
128 when (length gens /= 1) . putError $
129 "Exactly one generator expected for " ++ file
130 ++ " (found: " ++ show gens ++ ")."
131 let (src, builder) = head gens
132 need [src]
133 build $ Target context builder [src] [file]
134 let srcBoot = src -<.> "hs-boot"
135 whenM (doesFileExist srcBoot) $
136 copyFile srcBoot $ file -<.> "hs-boot"
137
138 -- TODO: needing platformH is ugly and fragile
139 when (pkg == compiler) $ primopsTxt stage %> \file -> do
140 need $ [platformH stage, primopsSource] ++ includesDependencies
141 build $ Target context HsCpp [primopsSource] [file]
142
143 -- TODO: why different folders for generated files?
144 fmap (buildPath -/-)
145 [ "autogen/GHC/Prim.hs"
146 , "GHC/PrimopWrappers.hs"
147 , "*.hs-incl" ] |%> \file -> do
148 need [primopsTxt stage]
149 build $ Target context GenPrimopCode [primopsTxt stage] [file]
150 -- TODO: this is temporary hack, get rid of this (#113)
151 let oldPath = pkgPath pkg -/- targetDirectory stage pkg -/- "build"
152 newFile = oldPath ++ (drop (length buildPath) file)
153 createDirectory $ takeDirectory newFile
154 liftIO $ IO.copyFile file newFile
155 putSuccess $ "| Duplicate file " ++ file ++ " -> " ++ newFile
156
157 when (pkg == rts) $ buildPath -/- "AutoApply.cmm" %> \file -> do
158 build $ Target context GenApply [] [file]
159
160 priority 2.0 $ do
161 -- TODO: this is temporary hack, get rid of this (#113)
162 let oldPath = pkgPath pkg -/- targetDirectory stage pkg
163 olden f = oldPath ++ (drop (length (targetPath stage pkg)) f)
164
165 when (pkg == compiler) $ buildPath -/- "Config.hs" %> \file -> do
166 file <~ generateConfigHs
167 olden file <~ generateConfigHs -- TODO: get rid of this (#113)
168
169 when (pkg == compiler) $ platformH stage %> \file -> do
170 file <~ generateGhcBootPlatformH
171
172 when (pkg == ghcPkg) $ buildPath -/- "Version.hs" %> \file -> do
173 file <~ generateVersionHs
174 olden file <~ generateVersionHs -- TODO: get rid of this (#113)
175
176 when (pkg == runGhc) $ buildPath -/- "Main.hs" %> \file -> do
177 copyFileChanged (pkgPath pkg -/- "runghc.hs") file
178 putSuccess $ "| Successfully generated '" ++ file ++ "'."
179
180 copyRules :: Rules ()
181 copyRules = do
182 "inplace/lib/ghc-usage.txt" <~ "driver"
183 "inplace/lib/ghci-usage.txt" <~ "driver"
184 "inplace/lib/platformConstants" <~ derivedConstantsPath
185 "inplace/lib/settings" <~ "."
186 "inplace/lib/template-hsc.h" <~ pkgPath hsc2hs
187 where
188 file <~ dir = file %> \_ -> copyFile (dir -/- takeFileName file) file
189
190 generateRules :: Rules ()
191 generateRules = do
192 "includes/ghcautoconf.h" <~ generateGhcAutoconfH
193 "includes/ghcplatform.h" <~ generateGhcPlatformH
194 "includes/ghcversion.h" <~ generateGhcVersionH
195
196 ghcSplit %> \_ -> do
197 generate ghcSplit emptyTarget generateGhcSplit
198 makeExecutable ghcSplit
199
200 -- TODO: simplify, get rid of fake rts context
201 derivedConstantsPath ++ "//*" %> \file -> do
202 withTempDir $ \dir -> build $
203 Target (vanillaContext Stage1 rts) DeriveConstants [] [file, dir]
204
205 where
206 file <~ gen = file %> \out -> generate out emptyTarget gen
207
208 -- TODO: Use the Types, Luke! (drop partial function)
209 -- We sometimes need to evaluate expressions that do not require knowing all
210 -- information about the context. In this case, we don't want to know anything.
211 emptyTarget :: Context
212 emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage")
213 (error "Rules.Generate.emptyTarget: unknown package")