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