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