X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fmain%2FDriverPhases.hs;h=1532c2fed8f523a932dfb08b3571274d7c0147a2;hp=118b23abfc4e4bcf34230f61fe2d8e1b31c01564;hb=df1fecb95e3a0cf901184605da96dc8ae092b173;hpb=fb38b8bab2b531ca7ac4ea28ad5b259a00e3759b diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index 118b23a..1532c2f 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -11,10 +11,10 @@ module DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase(..), happensBefore, eqPhase, anyHsc, isStopLn, - startPhase, -- :: String -> Phase - phaseInputExt, -- :: Phase -> String + startPhase, -- :: String -> Phase + phaseInputExt, -- :: Phase -> String - isHaskellishSuffix, + isHaskellishSuffix, isHaskellSrcSuffix, isObjectSuffix, isCishSuffix, @@ -23,7 +23,7 @@ module DriverPhases ( isHaskellUserSrcSuffix, isSourceSuffix, - isHaskellishFilename, + isHaskellishFilename, isHaskellSrcFilename, isObjectFilename, isCishFilename, @@ -33,8 +33,10 @@ module DriverPhases ( isSourceFilename -- :: FilePath -> Bool ) where -import Util ( suffixOf ) -import Panic ( panic ) +#include "HsVersions.h" + +import Panic ( panic ) +import System.FilePath ----------------------------------------------------------------------------- -- Phases @@ -42,7 +44,7 @@ import Panic ( panic ) {- 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 @@ -54,7 +56,7 @@ import Panic ( panic ) data HscSource = HsSrcFile | HsBootFile | ExtCoreFile deriving( Eq, Ord, Show ) - -- Ord needed for the finite maps we build in CompManager + -- Ord needed for the finite maps we build in CompManager hscSourceString :: HscSource -> String @@ -64,26 +66,29 @@ hscSourceString ExtCoreFile = "[ext core]" isHsBoot :: HscSource -> Bool isHsBoot HsBootFile = True -isHsBoot other = False +isHsBoot _ = False -data Phase - = Unlit HscSource - | Cpp HscSource - | HsPp HscSource - | Hsc HscSource +data Phase + = Unlit HscSource + | Cpp HscSource + | HsPp HscSource + | Hsc HscSource | Ccpp - | Cc - | HCc -- Haskellised C (as opposed to vanilla C) compilation - | Mangle -- assembly mangling, now done by a separate script. - | SplitMangle -- after mangler if splitting - | SplitAs - | As - | CmmCpp -- pre-process Cmm source - | Cmm -- parse & compile Cmm code - - -- 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 + | Cc + | HCc -- Haskellised C (as opposed to vanilla C) compilation + | Mangle -- assembly mangling, now done by a separate script. + | SplitMangle -- after mangler if splitting + | SplitAs + | As + | 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 + + -- 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) anyHsc :: Phase @@ -91,54 +96,66 @@ anyHsc = Hsc (panic "anyHsc") isStopLn :: Phase -> Bool isStopLn StopLn = True -isStopLn other = False +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 HCc HCc = True -eqPhase Mangle Mangle = True +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 HCc HCc = True +eqPhase Mangle Mangle = True eqPhase SplitMangle SplitMangle = True -eqPhase SplitAs SplitAs = True -eqPhase As As = True -eqPhase CmmCpp CmmCpp = True -eqPhase Cmm Cmm = True -eqPhase StopLn StopLn = True -eqPhase _ _ = False - --- Partial ordering on phases: we want to know which phases will occur before +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 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). -StopLn `happensBefore` y = False +happensBefore :: Phase -> Phase -> Bool +StopLn `happensBefore` _ = False x `happensBefore` y = after_x `eqPhase` y || after_x `happensBefore` y - where - after_x = nextPhase x + where + after_x = nextPhase x nextPhase :: Phase -> Phase -- A conservative approximation the next phase, used in happensBefore -nextPhase (Unlit sf) = Cpp sf -nextPhase (Cpp sf) = HsPp sf -nextPhase (HsPp sf) = Hsc sf -nextPhase (Hsc sf) = HCc -nextPhase HCc = Mangle -nextPhase Mangle = SplitMangle -nextPhase SplitMangle = As -nextPhase As = SplitAs -nextPhase SplitAs = StopLn -nextPhase Ccpp = As -nextPhase Cc = As -nextPhase CmmCpp = Cmm -nextPhase Cmm = HCc -nextPhase StopLn = panic "nextPhase: nothing after StopLn" +nextPhase (Unlit sf) = Cpp sf +nextPhase (Cpp sf) = HsPp sf +nextPhase (HsPp sf) = Hsc sf +nextPhase (Hsc _) = HCc +nextPhase HCc = Mangle +nextPhase Mangle = SplitMangle +nextPhase SplitMangle = As +nextPhase As = SplitAs +nextPhase LlvmOpt = LlvmLlc +#if darwin_TARGET_OS +nextPhase LlvmLlc = LlvmMangle +#else +nextPhase LlvmLlc = As +#endif +nextPhase LlvmMangle = As +nextPhase SplitAs = StopLn +nextPhase Ccpp = As +nextPhase Cc = As +nextPhase CmmCpp = Cmm +nextPhase Cmm = HCc +nextPhase StopLn = panic "nextPhase: nothing after StopLn" -- 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 @@ -156,42 +173,54 @@ startPhase "raw_s" = Mangle startPhase "split_s" = SplitMangle 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 -- all unknown file types +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 Cc = "c" -phaseInputExt Mangle = "raw_s" -phaseInputExt SplitMangle = "split_s" -- not really generated -phaseInputExt As = "s" -phaseInputExt SplitAs = "split_s" -- not really generated -phaseInputExt CmmCpp = "cmm" -phaseInputExt Cmm = "cmmcpp" -phaseInputExt StopLn = "o" +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 Cc = "c" +phaseInputExt Mangle = "raw_s" +phaseInputExt SplitMangle = "split_s" -- not really generated +phaseInputExt As = "s" +phaseInputExt LlvmOpt = "ll" +phaseInputExt LlvmLlc = "bc" +phaseInputExt LlvmMangle = "lm_s" +phaseInputExt SplitAs = "split_s" -- not really generated +phaseInputExt CmmCpp = "cmm" +phaseInputExt Cmm = "cmmcpp" +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" ] + [ "hspp", "hscpp", "hcr", "cmm" ] haskellish_suffixes = haskellish_src_suffixes ++ ["hc", "raw_s"] -cish_suffixes = [ "c", "cpp", "C", "cc", "cxx", "s", "S" ] +cish_suffixes = [ "c", "cpp", "C", "cc", "cxx", "s", "S", "ll", "bc" ] extcoreish_suffixes = [ "hcr" ] -haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ] -- Will not be deleted as temp files +-- Will not be deleted as temp files: +haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ] --- Use the appropriate suffix for the system on which +objish_suffixes :: [String] +-- Use the appropriate suffix for the system on which -- the GHC-compiled code will run #if mingw32_TARGET_OS || cygwin32_TARGET_OS objish_suffixes = [ "o", "O", "obj", "OBJ" ] @@ -199,6 +228,7 @@ objish_suffixes = [ "o", "O", "obj", "OBJ" ] objish_suffixes = [ "o" ] #endif +dynlib_suffixes :: [String] #ifdef mingw32_TARGET_OS dynlib_suffixes = ["dll", "DLL"] #elif defined(darwin_TARGET_OS) @@ -207,23 +237,32 @@ dynlib_suffixes = ["dylib"] dynlib_suffixes = ["so"] #endif +isHaskellishSuffix, isHaskellSrcSuffix, isCishSuffix, isExtCoreSuffix, + isObjectSuffix, isHaskellUserSrcSuffix, isDynLibSuffix + :: 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 isObjectSuffix s = s `elem` objish_suffixes isHaskellUserSrcSuffix s = s `elem` haskellish_user_src_suffixes -isDynLibSuffix s = s `elem` dynlib_suffixes +isDynLibSuffix s = s `elem` dynlib_suffixes +isSourceSuffix :: String -> Bool isSourceSuffix suff = isHaskellishSuffix suff || isCishSuffix suff -isHaskellishFilename f = isHaskellishSuffix (suffixOf f) -isHaskellSrcFilename f = isHaskellSrcSuffix (suffixOf f) -isCishFilename f = isCishSuffix (suffixOf f) -isExtCoreFilename f = isExtCoreSuffix (suffixOf f) -isObjectFilename f = isObjectSuffix (suffixOf f) -isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (suffixOf f) -isDynLibFilename f = isDynLibSuffix (suffixOf f) -isSourceFilename f = isSourceSuffix (suffixOf f) +isHaskellishFilename, isHaskellSrcFilename, isCishFilename, + isExtCoreFilename, isObjectFilename, isHaskellUserSrcFilename, + isDynLibFilename, 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) +isObjectFilename f = isObjectSuffix (drop 1 $ takeExtension f) +isHaskellUserSrcFilename f = isHaskellUserSrcSuffix (drop 1 $ takeExtension f) +isDynLibFilename f = isDynLibSuffix (drop 1 $ takeExtension f) +isSourceFilename f = isSourceSuffix (drop 1 $ takeExtension f)