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 DynFlags
import Outputable
import Platform
import System.FilePath
data HscSource
= HsSrcFile | HsBootFile | ExtCoreFile
deriving( Eq, Ord, Show )
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
| Splitter
| SplitAs
| As
| LlvmOpt
| LlvmLlc
| LlvmMangle
| CmmCpp
| Cmm
| MergeStub
| StopLn
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
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 As = True
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
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
= 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
SplitAs -> MergeStub
As -> MergeStub
Ccpp -> As
Cc -> As
Cobjc -> As
Cobjcpp -> As
CmmCpp -> Cmm
Cmm -> maybeHCc
HCc -> As
MergeStub -> StopLn
StopLn -> panic "nextPhase: nothing after StopLn"
where maybeHCc = if platformUnregisterised (targetPlatform dflags)
then HCc
else As
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
startPhase "S" = As
startPhase "ll" = LlvmOpt
startPhase "bc" = LlvmLlc
startPhase "lm_s" = LlvmMangle
startPhase "o" = StopLn
startPhase "cmm" = CmmCpp
startPhase "cmmcpp" = Cmm
startPhase _ = StopLn
phaseInputExt :: Phase -> String
phaseInputExt (Unlit HsSrcFile) = "lhs"
phaseInputExt (Unlit HsBootFile) = "lhs-boot"
phaseInputExt (Unlit ExtCoreFile) = "lhcr"
phaseInputExt (Cpp _) = "lpp"
phaseInputExt (HsPp _) = "hscpp"
phaseInputExt (Hsc _) = "hspp"
phaseInputExt HCc = "hc"
phaseInputExt Ccpp = "cpp"
phaseInputExt Cobjc = "m"
phaseInputExt Cobjcpp = "mm"
phaseInputExt Cc = "c"
phaseInputExt Splitter = "split_s"
phaseInputExt As = "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" ]
haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ]
objish_suffixes :: Platform -> [String]
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"]
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
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)