never executed always true always false
1 -----------------------------------------------------------------------------
2 --
3 -- GHC Driver
4 --
5 -- (c) The University of Glasgow 2002
6 --
7 -----------------------------------------------------------------------------
8
9 module GHC.Driver.Phases (
10 Phase(..),
11 happensBefore, eqPhase, isStopLn,
12 startPhase,
13 phaseInputExt,
14
15 StopPhase(..),
16 stopPhaseToPhase,
17
18 isHaskellishSuffix,
19 isHaskellSrcSuffix,
20 isBackpackishSuffix,
21 isObjectSuffix,
22 isCishSuffix,
23 isDynLibSuffix,
24 isHaskellUserSrcSuffix,
25 isHaskellSigSuffix,
26 isSourceSuffix,
27
28 isHaskellishTarget,
29
30 isHaskellishFilename,
31 isHaskellSrcFilename,
32 isHaskellSigFilename,
33 isObjectFilename,
34 isCishFilename,
35 isDynLibFilename,
36 isHaskellUserSrcFilename,
37 isSourceFilename,
38
39 phaseForeignLanguage
40 ) where
41
42 import GHC.Prelude
43
44 import GHC.Platform
45
46 import GHC.ForeignSrcLang
47
48 import GHC.Types.SourceFile
49
50 import GHC.Utils.Outputable
51 import GHC.Utils.Panic
52 import GHC.Utils.Misc
53
54 import System.FilePath
55
56 -----------------------------------------------------------------------------
57 -- Phases
58
59 {-
60 Phase of the | Suffix saying | Flag saying | (suffix of)
61 compilation system | ``start here''| ``stop after''| output file
62
63 literate pre-processor | .lhs | - | -
64 C pre-processor (opt.) | - | -E | -
65 Haskell compiler | .hs | -C, -S | .hc, .s
66 C compiler (opt.) | .hc or .c | -S | .s
67 assembler | .s or .S | -c | .o
68 linker | other | - | a.out
69 -}
70
71 -- Phases we can actually stop after
72 data StopPhase = StopPreprocess -- -E
73 | StopC -- -C
74 | StopAs -- -S
75 | NoStop -- -c
76
77 stopPhaseToPhase :: StopPhase -> Phase
78 stopPhaseToPhase StopPreprocess = anyHsc
79 stopPhaseToPhase StopC = HCc
80 stopPhaseToPhase StopAs = As False
81 stopPhaseToPhase NoStop = StopLn
82
83 -- | Untyped Phase description
84 data Phase
85 = Unlit HscSource
86 | Cpp HscSource
87 | HsPp HscSource
88 | Hsc HscSource
89 | Ccxx -- Compile C++
90 | Cc -- Compile C
91 | Cobjc -- Compile Objective-C
92 | Cobjcxx -- Compile Objective-C++
93 | HCc -- Haskellised C (as opposed to vanilla C) compilation
94 | As Bool -- Assembler for regular assembly files (Bool: with-cpp)
95 | LlvmOpt -- Run LLVM opt tool over llvm assembly
96 | LlvmLlc -- LLVM bitcode to native assembly
97 | LlvmMangle -- Fix up TNTC by processing assembly produced by LLVM
98 | CmmCpp -- pre-process Cmm source
99 | Cmm -- parse & compile Cmm code
100 | MergeForeign -- merge in the foreign object files
101
102 -- The final phase is a pseudo-phase that tells the pipeline to stop.
103 | StopLn -- Stop, but linking will follow, so generate .o file
104 deriving (Eq, Show)
105
106 instance Outputable Phase where
107 ppr p = text (show p)
108
109 anyHsc :: Phase
110 anyHsc = Hsc (panic "anyHsc")
111
112 isStopLn :: Phase -> Bool
113 isStopLn StopLn = True
114 isStopLn _ = False
115
116 eqPhase :: Phase -> Phase -> Bool
117 -- Equality of constructors, ignoring the HscSource field
118 -- NB: the HscSource field can be 'bot'; see anyHsc above
119 eqPhase (Unlit _) (Unlit _) = True
120 eqPhase (Cpp _) (Cpp _) = True
121 eqPhase (HsPp _) (HsPp _) = True
122 eqPhase (Hsc _) (Hsc _) = True
123 eqPhase Cc Cc = True
124 eqPhase Cobjc Cobjc = True
125 eqPhase HCc HCc = True
126 eqPhase (As x) (As y) = x == y
127 eqPhase LlvmOpt LlvmOpt = True
128 eqPhase LlvmLlc LlvmLlc = True
129 eqPhase LlvmMangle LlvmMangle = True
130 eqPhase CmmCpp CmmCpp = True
131 eqPhase Cmm Cmm = True
132 eqPhase MergeForeign MergeForeign = True
133 eqPhase StopLn StopLn = True
134 eqPhase Ccxx Ccxx = True
135 eqPhase Cobjcxx Cobjcxx = True
136 eqPhase _ _ = False
137
138 -- MP: happensBefore is only used in preprocessPipeline, that usage should
139 -- be refactored and this usage removed.
140 happensBefore :: Platform -> Phase -> Phase -> Bool
141 happensBefore platform p1 p2 = p1 `happensBefore'` p2
142 where StopLn `happensBefore'` _ = False
143 x `happensBefore'` y = after_x `eqPhase` y
144 || after_x `happensBefore'` y
145 where after_x = nextPhase platform x
146
147 nextPhase :: Platform -> Phase -> Phase
148 nextPhase platform p
149 -- A conservative approximation to the next phase, used in happensBefore
150 = case p of
151 Unlit sf -> Cpp sf
152 Cpp sf -> HsPp sf
153 HsPp sf -> Hsc sf
154 Hsc _ -> maybeHCc
155 LlvmOpt -> LlvmLlc
156 LlvmLlc -> LlvmMangle
157 LlvmMangle -> As False
158 As _ -> MergeForeign
159 Ccxx -> As False
160 Cc -> As False
161 Cobjc -> As False
162 Cobjcxx -> As False
163 CmmCpp -> Cmm
164 Cmm -> maybeHCc
165 HCc -> As False
166 MergeForeign -> StopLn
167 StopLn -> panic "nextPhase: nothing after StopLn"
168 where maybeHCc = if platformUnregisterised platform
169 then HCc
170 else As False
171
172 -- the first compilation phase for a given file is determined
173 -- by its suffix.
174 startPhase :: String -> Phase
175 startPhase "lhs" = Unlit HsSrcFile
176 startPhase "lhs-boot" = Unlit HsBootFile
177 startPhase "lhsig" = Unlit HsigFile
178 startPhase "hs" = Cpp HsSrcFile
179 startPhase "hs-boot" = Cpp HsBootFile
180 startPhase "hsig" = Cpp HsigFile
181 startPhase "hscpp" = HsPp HsSrcFile
182 startPhase "hspp" = Hsc HsSrcFile
183 startPhase "hc" = HCc
184 startPhase "c" = Cc
185 startPhase "cpp" = Ccxx
186 startPhase "C" = Cc
187 startPhase "m" = Cobjc
188 startPhase "M" = Cobjcxx
189 startPhase "mm" = Cobjcxx
190 startPhase "cc" = Ccxx
191 startPhase "cxx" = Ccxx
192 startPhase "s" = As False
193 startPhase "S" = As True
194 startPhase "ll" = LlvmOpt
195 startPhase "bc" = LlvmLlc
196 startPhase "lm_s" = LlvmMangle
197 startPhase "o" = StopLn
198 startPhase "cmm" = CmmCpp
199 startPhase "cmmcpp" = Cmm
200 startPhase _ = StopLn -- all unknown file types
201
202 -- This is used to determine the extension for the output from the
203 -- current phase (if it generates a new file). The extension depends
204 -- on the next phase in the pipeline.
205 phaseInputExt :: Phase -> String
206 phaseInputExt (Unlit HsSrcFile) = "lhs"
207 phaseInputExt (Unlit HsBootFile) = "lhs-boot"
208 phaseInputExt (Unlit HsigFile) = "lhsig"
209 phaseInputExt (Cpp _) = "lpp" -- intermediate only
210 phaseInputExt (HsPp _) = "hscpp" -- intermediate only
211 phaseInputExt (Hsc _) = "hspp" -- intermediate only
212 -- NB: as things stand, phaseInputExt (Hsc x) must not evaluate x
213 -- because runPhase uses the StopBefore phase to pick the
214 -- output filename. That could be fixed, but watch out.
215 phaseInputExt HCc = "hc"
216 phaseInputExt Ccxx = "cpp"
217 phaseInputExt Cobjc = "m"
218 phaseInputExt Cobjcxx = "mm"
219 phaseInputExt Cc = "c"
220 phaseInputExt (As True) = "S"
221 phaseInputExt (As False) = "s"
222 phaseInputExt LlvmOpt = "ll"
223 phaseInputExt LlvmLlc = "bc"
224 phaseInputExt LlvmMangle = "lm_s"
225 phaseInputExt CmmCpp = "cmmcpp"
226 phaseInputExt Cmm = "cmm"
227 phaseInputExt MergeForeign = "o"
228 phaseInputExt StopLn = "o"
229
230 haskellish_src_suffixes, backpackish_suffixes, haskellish_suffixes, cish_suffixes,
231 haskellish_user_src_suffixes, haskellish_sig_suffixes
232 :: [String]
233 -- When a file with an extension in the haskellish_src_suffixes group is
234 -- loaded in --make mode, its imports will be loaded too.
235 haskellish_src_suffixes = haskellish_user_src_suffixes ++
236 [ "hspp", "hscpp" ]
237 haskellish_suffixes = haskellish_src_suffixes ++
238 [ "hc", "cmm", "cmmcpp" ]
239 cish_suffixes = [ "c", "cpp", "C", "cc", "cxx", "s", "S", "ll", "bc", "lm_s", "m", "M", "mm" ]
240
241 -- Will not be deleted as temp files:
242 haskellish_user_src_suffixes =
243 haskellish_sig_suffixes ++ [ "hs", "lhs", "hs-boot", "lhs-boot" ]
244 haskellish_sig_suffixes = [ "hsig", "lhsig" ]
245 backpackish_suffixes = [ "bkp" ]
246
247 objish_suffixes :: Platform -> [String]
248 -- Use the appropriate suffix for the system on which
249 -- the GHC-compiled code will run
250 objish_suffixes platform = case platformOS platform of
251 OSMinGW32 -> [ "o", "O", "obj", "OBJ" ]
252 _ -> [ "o" ]
253
254 dynlib_suffixes :: Platform -> [String]
255 dynlib_suffixes platform = case platformOS platform of
256 OSMinGW32 -> ["dll", "DLL"]
257 OSDarwin -> ["dylib", "so"]
258 _ -> ["so"]
259
260 isHaskellishSuffix, isBackpackishSuffix, isHaskellSrcSuffix, isCishSuffix,
261 isHaskellUserSrcSuffix, isHaskellSigSuffix
262 :: String -> Bool
263 isHaskellishSuffix s = s `elem` haskellish_suffixes
264 isBackpackishSuffix s = s `elem` backpackish_suffixes
265 isHaskellSigSuffix s = s `elem` haskellish_sig_suffixes
266 isHaskellSrcSuffix s = s `elem` haskellish_src_suffixes
267 isCishSuffix s = s `elem` cish_suffixes
268 isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes
269
270 isObjectSuffix, isDynLibSuffix :: Platform -> String -> Bool
271 isObjectSuffix platform s = s `elem` objish_suffixes platform
272 isDynLibSuffix platform s = s `elem` dynlib_suffixes platform
273
274 isSourceSuffix :: String -> Bool
275 isSourceSuffix suff = isHaskellishSuffix suff
276 || isCishSuffix suff
277 || isBackpackishSuffix suff
278
279 -- | When we are given files (modified by -x arguments) we need
280 -- to determine if they are Haskellish or not to figure out
281 -- how we should try to compile it. The rules are:
282 --
283 -- 1. If no -x flag was specified, we check to see if
284 -- the file looks like a module name, has no extension,
285 -- or has a Haskell source extension.
286 --
287 -- 2. If an -x flag was specified, we just make sure the
288 -- specified suffix is a Haskell one.
289 isHaskellishTarget :: (String, Maybe Phase) -> Bool
290 isHaskellishTarget (f,Nothing) =
291 looksLikeModuleName f || isHaskellSrcFilename f || not (hasExtension f)
292 isHaskellishTarget (_,Just phase) =
293 phase `notElem` [ As True, As False, Cc, Cobjc, Cobjcxx, CmmCpp, Cmm
294 , StopLn]
295
296 isHaskellishFilename, isHaskellSrcFilename, isCishFilename,
297 isHaskellUserSrcFilename, isSourceFilename, isHaskellSigFilename
298 :: FilePath -> Bool
299 -- takeExtension return .foo, so we drop 1 to get rid of the .
300 isHaskellishFilename f = isHaskellishSuffix (drop 1 $ takeExtension f)
301 isHaskellSrcFilename f = isHaskellSrcSuffix (drop 1 $ takeExtension f)
302 isCishFilename f = isCishSuffix (drop 1 $ takeExtension f)
303 isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f)
304 isSourceFilename f = isSourceSuffix (drop 1 $ takeExtension f)
305 isHaskellSigFilename f = isHaskellSigSuffix (drop 1 $ takeExtension f)
306
307 isObjectFilename, isDynLibFilename :: Platform -> FilePath -> Bool
308 isObjectFilename platform f = isObjectSuffix platform (drop 1 $ takeExtension f)
309 isDynLibFilename platform f = isDynLibSuffix platform (drop 1 $ takeExtension f)
310
311 -- | Foreign language of the phase if the phase deals with a foreign code
312 phaseForeignLanguage :: Phase -> Maybe ForeignSrcLang
313 phaseForeignLanguage phase = case phase of
314 Cc -> Just LangC
315 Ccxx -> Just LangCxx
316 Cobjc -> Just LangObjc
317 Cobjcxx -> Just LangObjcxx
318 HCc -> Just LangC
319 As _ -> Just LangAsm
320 MergeForeign -> Just RawObject
321 _ -> Nothing
322