1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
|
-----------------------------------------------------------------------------
-- $Id: DriverPhases.hs,v 1.38 2005/05/17 11:01:59 simonmar Exp $
--
-- GHC Driver
--
-- (c) The University of Glasgow 2002
--
-----------------------------------------------------------------------------
module DriverPhases (
HscSource(..), isHsBoot, hscSourceString,
Phase(..),
happensBefore, eqPhase, anyHsc, isStopLn,
startPhase,
phaseInputExt,
isHaskellishSuffix,
isHaskellSrcSuffix,
isObjectSuffix,
isCishSuffix,
isExtCoreSuffix,
isDynLibSuffix,
isHaskellUserSrcSuffix,
isSourceSuffix,
isHaskellishFilename,
isHaskellSrcFilename,
isObjectFilename,
isCishFilename,
isExtCoreFilename,
isDynLibFilename,
isHaskellUserSrcFilename,
isSourceFilename
) where
#include "HsVersions.h"
import {-# SOURCE #-} DynFlags
import Outputable
import Platform
import System.FilePath
-----------------------------------------------------------------------------
-- Phases
{-
Phase of the | Suffix saying | Flag saying | (suffix of)
compilation system | ``start here''| ``stop after''| output file
literate pre-processor | .lhs | - | -
C pre-processor (opt.) | - | -E | -
Haskell compiler | .hs | -C, -S | .hc, .s
C compiler (opt.) | .hc or .c | -S | .s
assembler | .s or .S | -c | .o
linker | other | - | a.out
-}
data HscSource
= HsSrcFile | HsBootFile | ExtCoreFile
deriving( Eq, Ord, Show )
-- Ord needed for the finite maps we build in CompManager
hscSourceString :: HscSource -> String
hscSourceString HsSrcFile = ""
hscSourceString HsBootFile = "[boot]"
hscSourceString ExtCoreFile = "[ext core]"
isHsBoot :: HscSource -> Bool
isHsBoot HsBootFile = True
isHsBoot _ = False
data Phase
= Unlit HscSource
| Cpp HscSource
| HsPp HscSource
| Hsc HscSource
| Ccpp
| Cc
| Cobjc
| Cobjcpp
| HCc -- Haskellised C (as opposed to vanilla C) compilation
| Splitter -- Assembly file splitter (part of '-split-objs')
| SplitAs -- Assembler for split assembly files (part of '-split-objs')
| As Bool -- Assembler for regular assembly files (Bool: with-cpp)
| LlvmOpt -- Run LLVM opt tool over llvm assembly
| LlvmLlc -- LLVM bitcode to native assembly
| LlvmMangle -- Fix up TNTC by processing assembly produced by LLVM
| CmmCpp -- pre-process Cmm source
| Cmm -- parse & compile Cmm code
| MergeStub -- merge in the stub object file
-- The final phase is a pseudo-phase that tells the pipeline to stop.
-- There is no runPhase case for it.
| StopLn -- Stop, but linking will follow, so generate .o file
deriving (Eq, Show)
instance Outputable Phase where
ppr p = text (show p)
anyHsc :: Phase
anyHsc = Hsc (panic "anyHsc")
isStopLn :: Phase -> Bool
isStopLn StopLn = True
isStopLn _ = False
eqPhase :: Phase -> Phase -> Bool
-- Equality of constructors, ignoring the HscSource field
-- NB: the HscSource field can be 'bot'; see anyHsc above
eqPhase (Unlit _) (Unlit _) = True
eqPhase (Cpp _) (Cpp _) = True
eqPhase (HsPp _) (HsPp _) = True
eqPhase (Hsc _) (Hsc _) = True
eqPhase Ccpp Ccpp = True
eqPhase Cc Cc = True
eqPhase Cobjc Cobjc = True
eqPhase Cobjcpp Cobjcpp = True
eqPhase HCc HCc = True
eqPhase Splitter Splitter = True
eqPhase SplitAs SplitAs = True
eqPhase (As x) (As y) = x == y
eqPhase LlvmOpt LlvmOpt = True
eqPhase LlvmLlc LlvmLlc = True
eqPhase LlvmMangle LlvmMangle = True
eqPhase CmmCpp CmmCpp = True
eqPhase Cmm Cmm = True
eqPhase MergeStub MergeStub = True
eqPhase StopLn StopLn = True
eqPhase _ _ = False
-- Partial ordering on phases: we want to know which phases will occur before
-- which others. This is used for sanity checking, to ensure that the
-- pipeline will stop at some point (see DriverPipeline.runPipeline).
happensBefore :: DynFlags -> Phase -> Phase -> Bool
happensBefore dflags p1 p2 = p1 `happensBefore'` p2
where StopLn `happensBefore'` _ = False
x `happensBefore'` y = after_x `eqPhase` y
|| after_x `happensBefore'` y
where after_x = nextPhase dflags x
nextPhase :: DynFlags -> Phase -> Phase
nextPhase dflags p
-- A conservative approximation to the next phase, used in happensBefore
= case p of
Unlit sf -> Cpp sf
Cpp sf -> HsPp sf
HsPp sf -> Hsc sf
Hsc _ -> maybeHCc
Splitter -> SplitAs
LlvmOpt -> LlvmLlc
LlvmLlc -> LlvmMangle
LlvmMangle -> As False
SplitAs -> MergeStub
As _ -> MergeStub
Ccpp -> As False
Cc -> As False
Cobjc -> As False
Cobjcpp -> As False
CmmCpp -> Cmm
Cmm -> maybeHCc
HCc -> As False
MergeStub -> StopLn
StopLn -> panic "nextPhase: nothing after StopLn"
where maybeHCc = if platformUnregisterised (targetPlatform dflags)
then HCc
else As False
-- the first compilation phase for a given file is determined
-- by its suffix.
startPhase :: String -> Phase
startPhase "lhs" = Unlit HsSrcFile
startPhase "lhs-boot" = Unlit HsBootFile
startPhase "hs" = Cpp HsSrcFile
startPhase "hs-boot" = Cpp HsBootFile
startPhase "hscpp" = HsPp HsSrcFile
startPhase "hspp" = Hsc HsSrcFile
startPhase "hcr" = Hsc ExtCoreFile
startPhase "hc" = HCc
startPhase "c" = Cc
startPhase "cpp" = Ccpp
startPhase "C" = Cc
startPhase "m" = Cobjc
startPhase "M" = Cobjcpp
startPhase "mm" = Cobjcpp
startPhase "cc" = Ccpp
startPhase "cxx" = Ccpp
startPhase "split_s" = Splitter
startPhase "s" = As False
startPhase "S" = As True
startPhase "ll" = LlvmOpt
startPhase "bc" = LlvmLlc
startPhase "lm_s" = LlvmMangle
startPhase "o" = StopLn
startPhase "cmm" = CmmCpp
startPhase "cmmcpp" = Cmm
startPhase _ = StopLn -- all unknown file types
-- This is used to determine the extension for the output from the
-- current phase (if it generates a new file). The extension depends
-- on the next phase in the pipeline.
phaseInputExt :: Phase -> String
phaseInputExt (Unlit HsSrcFile) = "lhs"
phaseInputExt (Unlit HsBootFile) = "lhs-boot"
phaseInputExt (Unlit ExtCoreFile) = "lhcr"
phaseInputExt (Cpp _) = "lpp" -- intermediate only
phaseInputExt (HsPp _) = "hscpp" -- intermediate only
phaseInputExt (Hsc _) = "hspp" -- intermediate only
-- NB: as things stand, phaseInputExt (Hsc x) must not evaluate x
-- because runPipeline uses the StopBefore phase to pick the
-- output filename. That could be fixed, but watch out.
phaseInputExt HCc = "hc"
phaseInputExt Ccpp = "cpp"
phaseInputExt Cobjc = "m"
phaseInputExt Cobjcpp = "mm"
phaseInputExt Cc = "c"
phaseInputExt Splitter = "split_s"
phaseInputExt (As True) = "S"
phaseInputExt (As False) = "s"
phaseInputExt LlvmOpt = "ll"
phaseInputExt LlvmLlc = "bc"
phaseInputExt LlvmMangle = "lm_s"
phaseInputExt SplitAs = "split_s"
phaseInputExt CmmCpp = "cmm"
phaseInputExt Cmm = "cmmcpp"
phaseInputExt MergeStub = "o"
phaseInputExt StopLn = "o"
haskellish_src_suffixes, haskellish_suffixes, cish_suffixes,
extcoreish_suffixes, haskellish_user_src_suffixes
:: [String]
haskellish_src_suffixes = haskellish_user_src_suffixes ++
[ "hspp", "hscpp", "hcr", "cmm", "cmmcpp" ]
haskellish_suffixes = haskellish_src_suffixes ++ ["hc", "raw_s"]
cish_suffixes = [ "c", "cpp", "C", "cc", "cxx", "s", "S", "ll", "bc", "lm_s", "m", "M", "mm" ]
extcoreish_suffixes = [ "hcr" ]
-- Will not be deleted as temp files:
haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ]
objish_suffixes :: Platform -> [String]
-- Use the appropriate suffix for the system on which
-- the GHC-compiled code will run
objish_suffixes platform = case platformOS platform of
OSMinGW32 -> [ "o", "O", "obj", "OBJ" ]
_ -> [ "o" ]
dynlib_suffixes :: Platform -> [String]
dynlib_suffixes platform = case platformOS platform of
OSMinGW32 -> ["dll", "DLL"]
OSDarwin -> ["dylib", "so"]
_ -> ["so"]
isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix, isExtCoreSuffix,
isHaskellUserSrcSuffix
:: String -> Bool
isHaskellishSuffix s = s `elem` haskellish_suffixes
isHaskellSrcSuffix s = s `elem` haskellish_src_suffixes
isCishSuffix s = s `elem` cish_suffixes
isExtCoreSuffix s = s `elem` extcoreish_suffixes
isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes
isObjectSuffix, isDynLibSuffix :: Platform -> String -> Bool
isObjectSuffix platform s = s `elem` objish_suffixes platform
isDynLibSuffix platform s = s `elem` dynlib_suffixes platform
isSourceSuffix :: String -> Bool
isSourceSuffix suff = isHaskellishSuffix suff || isCishSuffix suff
isHaskellishFilename, isHaskellSrcFilename, isCishFilename,
isExtCoreFilename, isHaskellUserSrcFilename, isSourceFilename
:: FilePath -> Bool
-- takeExtension return .foo, so we drop 1 to get rid of the .
isHaskellishFilename f = isHaskellishSuffix (drop 1 $ takeExtension f)
isHaskellSrcFilename f = isHaskellSrcSuffix (drop 1 $ takeExtension f)
isCishFilename f = isCishSuffix (drop 1 $ takeExtension f)
isExtCoreFilename f = isExtCoreSuffix (drop 1 $ takeExtension f)
isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f)
isSourceFilename f = isSourceSuffix (drop 1 $ takeExtension f)
isObjectFilename, isDynLibFilename :: Platform -> FilePath -> Bool
isObjectFilename platform f = isObjectSuffix platform (drop 1 $ takeExtension f)
isDynLibFilename platform f = isDynLibSuffix platform (drop 1 $ takeExtension f)
|
