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