module GHC.Driver.Phases (
Phase(..),
happensBefore, eqPhase, isStopLn,
startPhase,
phaseInputExt,
StopPhase(..),
stopPhaseToPhase,
isHaskellishSuffix,
isHaskellSrcSuffix,
isBackpackishSuffix,
isObjectSuffix,
isCishSuffix,
isDynLibSuffix,
isHaskellUserSrcSuffix,
isHaskellSigSuffix,
isSourceSuffix,
isHaskellishTarget,
isHaskellishFilename,
isHaskellSrcFilename,
isHaskellSigFilename,
isObjectFilename,
isCishFilename,
isDynLibFilename,
isHaskellUserSrcFilename,
isSourceFilename,
phaseForeignLanguage
) where
import GHC.Prelude
import GHC.Platform
import GHC.ForeignSrcLang
import GHC.Types.SourceFile
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Misc
import System.FilePath
data StopPhase = StopPreprocess
| StopC
| StopAs
| NoStop
stopPhaseToPhase :: StopPhase -> Phase
stopPhaseToPhase :: StopPhase -> Phase
stopPhaseToPhase StopPhase
StopPreprocess = Phase
anyHsc
stopPhaseToPhase StopPhase
StopC = Phase
HCc
stopPhaseToPhase StopPhase
StopAs = Bool -> Phase
As Bool
False
stopPhaseToPhase StopPhase
NoStop = Phase
StopLn
data Phase
= Unlit HscSource
| Cpp HscSource
| HsPp HscSource
| Hsc HscSource
| Ccxx
| Cc
| Cobjc
| Cobjcxx
| HCc
| As Bool
| LlvmOpt
| LlvmLlc
| LlvmMangle
| CmmCpp
| Cmm
| MergeForeign
| Js
| StopLn
deriving (Phase -> Phase -> Bool
(Phase -> Phase -> Bool) -> (Phase -> Phase -> Bool) -> Eq Phase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Phase -> Phase -> Bool
== :: Phase -> Phase -> Bool
$c/= :: Phase -> Phase -> Bool
/= :: Phase -> Phase -> Bool
Eq, Int -> Phase -> ShowS
[Phase] -> ShowS
Phase -> String
(Int -> Phase -> ShowS)
-> (Phase -> String) -> ([Phase] -> ShowS) -> Show Phase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Phase -> ShowS
showsPrec :: Int -> Phase -> ShowS
$cshow :: Phase -> String
show :: Phase -> String
$cshowList :: [Phase] -> ShowS
showList :: [Phase] -> ShowS
Show)
instance Outputable Phase where
ppr :: Phase -> SDoc
ppr Phase
p = String -> SDoc
forall doc. IsLine doc => String -> doc
text (Phase -> String
forall a. Show a => a -> String
show Phase
p)
anyHsc :: Phase
anyHsc :: Phase
anyHsc = HscSource -> Phase
Hsc (String -> HscSource
forall a. HasCallStack => String -> a
panic String
"anyHsc")
isStopLn :: Phase -> Bool
isStopLn :: Phase -> Bool
isStopLn Phase
StopLn = Bool
True
isStopLn Phase
_ = Bool
False
eqPhase :: Phase -> Phase -> Bool
eqPhase :: Phase -> Phase -> Bool
eqPhase (Unlit HscSource
_) (Unlit HscSource
_) = Bool
True
eqPhase (Cpp HscSource
_) (Cpp HscSource
_) = Bool
True
eqPhase (HsPp HscSource
_) (HsPp HscSource
_) = Bool
True
eqPhase (Hsc HscSource
_) (Hsc HscSource
_) = Bool
True
eqPhase Phase
Cc Phase
Cc = Bool
True
eqPhase Phase
Cobjc Phase
Cobjc = Bool
True
eqPhase Phase
HCc Phase
HCc = Bool
True
eqPhase (As Bool
x) (As Bool
y) = Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y
eqPhase Phase
LlvmOpt Phase
LlvmOpt = Bool
True
eqPhase Phase
LlvmLlc Phase
LlvmLlc = Bool
True
eqPhase Phase
LlvmMangle Phase
LlvmMangle = Bool
True
eqPhase Phase
CmmCpp Phase
CmmCpp = Bool
True
eqPhase Phase
Cmm Phase
Cmm = Bool
True
eqPhase Phase
MergeForeign Phase
MergeForeign = Bool
True
eqPhase Phase
StopLn Phase
StopLn = Bool
True
eqPhase Phase
Ccxx Phase
Ccxx = Bool
True
eqPhase Phase
Cobjcxx Phase
Cobjcxx = Bool
True
eqPhase Phase
Js Phase
Js = Bool
True
eqPhase Phase
_ Phase
_ = Bool
False
happensBefore :: Platform -> Phase -> Phase -> Bool
happensBefore :: Platform -> Phase -> Phase -> Bool
happensBefore Platform
platform Phase
p1 Phase
p2 = Phase
p1 Phase -> Phase -> Bool
`happensBefore'` Phase
p2
where Phase
StopLn happensBefore' :: Phase -> Phase -> Bool
`happensBefore'` Phase
_ = Bool
False
Phase
x `happensBefore'` Phase
y = Phase
after_x Phase -> Phase -> Bool
`eqPhase` Phase
y
Bool -> Bool -> Bool
|| Phase
after_x Phase -> Phase -> Bool
`happensBefore'` Phase
y
where after_x :: Phase
after_x = Platform -> Phase -> Phase
nextPhase Platform
platform Phase
x
nextPhase :: Platform -> Phase -> Phase
nextPhase :: Platform -> Phase -> Phase
nextPhase Platform
platform Phase
p
= case Phase
p of
Unlit HscSource
sf -> HscSource -> Phase
Cpp HscSource
sf
Cpp HscSource
sf -> HscSource -> Phase
HsPp HscSource
sf
HsPp HscSource
sf -> HscSource -> Phase
Hsc HscSource
sf
Hsc HscSource
_ -> Phase
maybeHCc
Phase
LlvmOpt -> Phase
LlvmLlc
Phase
LlvmLlc -> Phase
LlvmMangle
Phase
LlvmMangle -> Bool -> Phase
As Bool
False
As Bool
_ -> Phase
MergeForeign
Phase
Ccxx -> Phase
MergeForeign
Phase
Cc -> Phase
MergeForeign
Phase
Cobjc -> Phase
MergeForeign
Phase
Cobjcxx -> Phase
MergeForeign
Phase
CmmCpp -> Phase
Cmm
Phase
Cmm -> Phase
maybeHCc
Phase
HCc -> Phase
MergeForeign
Phase
MergeForeign -> Phase
StopLn
Phase
Js -> Phase
StopLn
Phase
StopLn -> String -> Phase
forall a. HasCallStack => String -> a
panic String
"nextPhase: nothing after StopLn"
where maybeHCc :: Phase
maybeHCc = if Platform -> Bool
platformUnregisterised Platform
platform
then Phase
HCc
else Bool -> Phase
As Bool
False
startPhase :: String -> Phase
startPhase :: String -> Phase
startPhase String
"lhs" = HscSource -> Phase
Unlit HscSource
HsSrcFile
startPhase String
"lhs-boot" = HscSource -> Phase
Unlit HscSource
HsBootFile
startPhase String
"lhsig" = HscSource -> Phase
Unlit HscSource
HsigFile
startPhase String
"hs" = HscSource -> Phase
Cpp HscSource
HsSrcFile
startPhase String
"hs-boot" = HscSource -> Phase
Cpp HscSource
HsBootFile
startPhase String
"hsig" = HscSource -> Phase
Cpp HscSource
HsigFile
startPhase String
"hscpp" = HscSource -> Phase
HsPp HscSource
HsSrcFile
startPhase String
"hspp" = HscSource -> Phase
Hsc HscSource
HsSrcFile
startPhase String
"hc" = Phase
HCc
startPhase String
"c" = Phase
Cc
startPhase String
"cpp" = Phase
Ccxx
startPhase String
"C" = Phase
Cc
startPhase String
"m" = Phase
Cobjc
startPhase String
"M" = Phase
Cobjcxx
startPhase String
"mm" = Phase
Cobjcxx
startPhase String
"cc" = Phase
Ccxx
startPhase String
"cxx" = Phase
Ccxx
startPhase String
"s" = Bool -> Phase
As Bool
False
startPhase String
"S" = Bool -> Phase
As Bool
True
startPhase String
"ll" = Phase
LlvmOpt
startPhase String
"bc" = Phase
LlvmLlc
startPhase String
"lm_s" = Phase
LlvmMangle
startPhase String
"o" = Phase
StopLn
startPhase String
"cmm" = Phase
CmmCpp
startPhase String
"cmmcpp" = Phase
Cmm
startPhase String
"js" = Phase
Js
startPhase String
_ = Phase
StopLn
phaseInputExt :: Phase -> String
phaseInputExt :: Phase -> String
phaseInputExt (Unlit HscSource
HsSrcFile) = String
"lhs"
phaseInputExt (Unlit HscSource
HsBootFile) = String
"lhs-boot"
phaseInputExt (Unlit HscSource
HsigFile) = String
"lhsig"
phaseInputExt (Cpp HscSource
_) = String
"lpp"
phaseInputExt (HsPp HscSource
_) = String
"hscpp"
phaseInputExt (Hsc HscSource
_) = String
"hspp"
phaseInputExt Phase
HCc = String
"hc"
phaseInputExt Phase
Ccxx = String
"cpp"
phaseInputExt Phase
Cobjc = String
"m"
phaseInputExt Phase
Cobjcxx = String
"mm"
phaseInputExt Phase
Cc = String
"c"
phaseInputExt (As Bool
True) = String
"S"
phaseInputExt (As Bool
False) = String
"s"
phaseInputExt Phase
LlvmOpt = String
"ll"
phaseInputExt Phase
LlvmLlc = String
"bc"
phaseInputExt Phase
LlvmMangle = String
"lm_s"
phaseInputExt Phase
CmmCpp = String
"cmmcpp"
phaseInputExt Phase
Cmm = String
"cmm"
phaseInputExt Phase
MergeForeign = String
"o"
phaseInputExt Phase
Js = String
"js"
phaseInputExt Phase
StopLn = String
"o"
haskellish_src_suffixes, backpackish_suffixes, haskellish_suffixes, cish_suffixes,
js_suffixes, haskellish_user_src_suffixes, haskellish_sig_suffixes
:: [String]
haskellish_src_suffixes :: [String]
haskellish_src_suffixes = [String]
haskellish_user_src_suffixes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[ String
"hspp", String
"hscpp" ]
haskellish_suffixes :: [String]
haskellish_suffixes = [String]
haskellish_src_suffixes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
[ String
"hc", String
"cmm", String
"cmmcpp" ]
cish_suffixes :: [String]
cish_suffixes = [ String
"c", String
"cpp", String
"C", String
"cc", String
"cxx", String
"s", String
"S", String
"ll", String
"bc", String
"lm_s", String
"m", String
"M", String
"mm" ]
js_suffixes :: [String]
js_suffixes = [ String
"js" ]
haskellish_user_src_suffixes :: [String]
haskellish_user_src_suffixes =
[String]
haskellish_sig_suffixes [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
"hs", String
"lhs", String
"hs-boot", String
"lhs-boot" ]
haskellish_sig_suffixes :: [String]
haskellish_sig_suffixes = [ String
"hsig", String
"lhsig" ]
backpackish_suffixes :: [String]
backpackish_suffixes = [ String
"bkp" ]
objish_suffixes :: Platform -> [String]
objish_suffixes :: Platform -> [String]
objish_suffixes Platform
platform = case Platform -> OS
platformOS Platform
platform of
OS
OSMinGW32 -> [ String
"o", String
"O", String
"obj", String
"OBJ" ]
OS
_ -> [ String
"o" ]
dynlib_suffixes :: Platform -> [String]
dynlib_suffixes :: Platform -> [String]
dynlib_suffixes Platform
platform = case Platform -> OS
platformOS Platform
platform of
OS
OSMinGW32 -> [String
"dll", String
"DLL"]
OS
OSDarwin -> [String
"dylib", String
"so"]
OS
_ -> [String
"so"]
isHaskellishSuffix, isBackpackishSuffix, isHaskellSrcSuffix, isCishSuffix,
isHaskellUserSrcSuffix, isJsSuffix, isHaskellSigSuffix
:: String -> Bool
isHaskellishSuffix :: String -> Bool
isHaskellishSuffix String
s = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
haskellish_suffixes
isBackpackishSuffix :: String -> Bool
isBackpackishSuffix String
s = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
backpackish_suffixes
isHaskellSigSuffix :: String -> Bool
isHaskellSigSuffix String
s = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
haskellish_sig_suffixes
isHaskellSrcSuffix :: String -> Bool
isHaskellSrcSuffix String
s = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
haskellish_src_suffixes
isCishSuffix :: String -> Bool
isCishSuffix String
s = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
cish_suffixes
isJsSuffix :: String -> Bool
isJsSuffix String
s = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
js_suffixes
isHaskellUserSrcSuffix :: String -> Bool
isHaskellUserSrcSuffix String
s = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
haskellish_user_src_suffixes
isObjectSuffix, isDynLibSuffix :: Platform -> String -> Bool
isObjectSuffix :: Platform -> String -> Bool
isObjectSuffix Platform
platform String
s = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Platform -> [String]
objish_suffixes Platform
platform
isDynLibSuffix :: Platform -> String -> Bool
isDynLibSuffix Platform
platform String
s = String
s String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Platform -> [String]
dynlib_suffixes Platform
platform
isSourceSuffix :: String -> Bool
isSourceSuffix :: String -> Bool
isSourceSuffix String
suff = String -> Bool
isHaskellishSuffix String
suff
Bool -> Bool -> Bool
|| String -> Bool
isCishSuffix String
suff
Bool -> Bool -> Bool
|| String -> Bool
isJsSuffix String
suff
Bool -> Bool -> Bool
|| String -> Bool
isBackpackishSuffix String
suff
isHaskellishTarget :: (String, Maybe Phase) -> Bool
isHaskellishTarget :: (String, Maybe Phase) -> Bool
isHaskellishTarget (String
f,Maybe Phase
Nothing) =
String -> Bool
looksLikeModuleName String
f Bool -> Bool -> Bool
|| String -> Bool
isHaskellSrcFilename String
f Bool -> Bool -> Bool
|| Bool -> Bool
not (String -> Bool
hasExtension String
f)
isHaskellishTarget (String
_,Just Phase
phase) =
Phase
phase Phase -> [Phase] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ Bool -> Phase
As Bool
True, Bool -> Phase
As Bool
False, Phase
Cc, Phase
Cobjc, Phase
Cobjcxx, Phase
CmmCpp, Phase
Cmm, Phase
Js
, Phase
StopLn]
isHaskellishFilename, isHaskellSrcFilename, isCishFilename,
isHaskellUserSrcFilename, isSourceFilename, isHaskellSigFilename
:: FilePath -> Bool
isHaskellishFilename :: String -> Bool
isHaskellishFilename String
f = String -> Bool
isHaskellishSuffix (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeExtension String
f)
isHaskellSrcFilename :: String -> Bool
isHaskellSrcFilename String
f = String -> Bool
isHaskellSrcSuffix (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeExtension String
f)
isCishFilename :: String -> Bool
isCishFilename String
f = String -> Bool
isCishSuffix (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeExtension String
f)
isHaskellUserSrcFilename :: String -> Bool
isHaskellUserSrcFilename String
f = String -> Bool
isHaskellUserSrcSuffix (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeExtension String
f)
isSourceFilename :: String -> Bool
isSourceFilename String
f = String -> Bool
isSourceSuffix (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeExtension String
f)
isHaskellSigFilename :: String -> Bool
isHaskellSigFilename String
f = String -> Bool
isHaskellSigSuffix (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeExtension String
f)
isObjectFilename, isDynLibFilename :: Platform -> FilePath -> Bool
isObjectFilename :: Platform -> String -> Bool
isObjectFilename Platform
platform String
f = Platform -> String -> Bool
isObjectSuffix Platform
platform (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeExtension String
f)
isDynLibFilename :: Platform -> String -> Bool
isDynLibFilename Platform
platform String
f = Platform -> String -> Bool
isDynLibSuffix Platform
platform (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeExtension String
f)
phaseForeignLanguage :: Phase -> Maybe ForeignSrcLang
phaseForeignLanguage :: Phase -> Maybe ForeignSrcLang
phaseForeignLanguage Phase
phase = case Phase
phase of
Phase
Cc -> ForeignSrcLang -> Maybe ForeignSrcLang
forall a. a -> Maybe a
Just ForeignSrcLang
LangC
Phase
Ccxx -> ForeignSrcLang -> Maybe ForeignSrcLang
forall a. a -> Maybe a
Just ForeignSrcLang
LangCxx
Phase
Cobjc -> ForeignSrcLang -> Maybe ForeignSrcLang
forall a. a -> Maybe a
Just ForeignSrcLang
LangObjc
Phase
Cobjcxx -> ForeignSrcLang -> Maybe ForeignSrcLang
forall a. a -> Maybe a
Just ForeignSrcLang
LangObjcxx
Phase
HCc -> ForeignSrcLang -> Maybe ForeignSrcLang
forall a. a -> Maybe a
Just ForeignSrcLang
LangC
As Bool
_ -> ForeignSrcLang -> Maybe ForeignSrcLang
forall a. a -> Maybe a
Just ForeignSrcLang
LangAsm
Phase
MergeForeign -> ForeignSrcLang -> Maybe ForeignSrcLang
forall a. a -> Maybe a
Just ForeignSrcLang
RawObject
Phase
Js -> ForeignSrcLang -> Maybe ForeignSrcLang
forall a. a -> Maybe a
Just ForeignSrcLang
LangJs
Phase
_ -> Maybe ForeignSrcLang
forall a. Maybe a
Nothing