X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fmain%2FDriverPhases.hs;h=0b1c41536e2dcf23b292e4b7f7987b5ddab445dd;hb=508a505e9853984bfdaa3ad855ae3fcbc6d31787;hp=37d73d3d6d0e0f0c57a32f882cc65d117ef98b3e;hpb=f9d8c8e0ab44b24d06b654d98543e8b39d4ebeca;p=ghc-hetmet.git diff --git a/ghc/compiler/main/DriverPhases.hs b/ghc/compiler/main/DriverPhases.hs index 37d73d3..0b1c415 100644 --- a/ghc/compiler/main/DriverPhases.hs +++ b/ghc/compiler/main/DriverPhases.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $Id: DriverPhases.hs,v 1.31 2005/01/18 13:51:28 simonmar Exp $ +-- $Id: DriverPhases.hs,v 1.32 2005/01/27 10:44:27 simonpj Exp $ -- -- GHC Driver -- @@ -10,8 +10,9 @@ #include "../includes/ghcconfig.h" module DriverPhases ( - Phase(..), - happensBefore, + HscSource(..), isHsBoot, hscSourceString, + HscTarget(..), Phase(..), + happensBefore, eqPhase, anyHsc, isStopPhase, startPhase, -- :: String -> Phase phaseInputExt, -- :: Phase -> String @@ -26,6 +27,7 @@ module DriverPhases ( ) where import DriverUtil +import Panic ( panic ) ----------------------------------------------------------------------------- -- Phases @@ -42,87 +44,157 @@ import DriverUtil 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 other = False + +data HscTarget + = HscC + | HscAsm + | HscJava + | HscILX + | HscInterpreted + | HscNothing + deriving (Eq, Show) + data Phase - = Unlit - | Cpp - | HsPp - | Hsc + = Unlit HscSource + | Cpp HscSource + | HsPp HscSource + | Hsc HscSource | 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 - | Ln | CmmCpp -- pre-process Cmm source | Cmm -- parse & compile Cmm code #ifdef ILX | Ilx2Il | Ilasm #endif - deriving (Eq, Show) + + -- 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 (Show) + +anyHsc :: Phase +anyHsc = Hsc (panic "anyHsc") + +isStopPhase :: Phase -> Bool +isStopPhase StopLn = True +isStopPhase other = False + +eqPhase :: Phase -> Phase -> Bool +-- Equality of constructors, ignoring the HscSource field +eqPhase (Unlit _) (Unlit _) = True +eqPhase (Cpp _) (Cpp _) = True +eqPhase (HsPp _) (HsPp _) = True +eqPhase (Hsc _) (Hsc _) = 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 -- which others. This is used for sanity checking, to ensure that the -- pipeline will stop at some point (see DriverPipeline.runPipeline). -x `happensBefore` y - | x `elem` haskell_pipe = y `elem` tail (dropWhile (/= x) haskell_pipe) - | x `elem` cmm_pipe = y `elem` tail (dropWhile (/= x) cmm_pipe) - | x `elem` c_pipe = y `elem` tail (dropWhile (/= x) c_pipe) - | otherwise = False - -haskell_post_hsc = [HCc,Mangle,SplitMangle,As,SplitAs,Ln] -haskell_pipe = Unlit : Cpp : HsPp : Hsc : haskell_post_hsc -cmm_pipe = CmmCpp : Cmm : haskell_post_hsc -c_pipe = [Cc,As,Ln] +StopLn `happensBefore` y = False +x `happensBefore` y = after_x `eqPhase` y || after_x `happensBefore` y + 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 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 "lhs" = Unlit -startPhase "hs" = Cpp -startPhase "hscpp" = HsPp -startPhase "hspp" = Hsc -startPhase "hcr" = Hsc -startPhase "hc" = HCc -startPhase "c" = Cc -startPhase "cpp" = Cc -startPhase "C" = Cc -startPhase "cc" = Cc -startPhase "cxx" = Cc -startPhase "raw_s" = Mangle -startPhase "s" = As -startPhase "S" = As -startPhase "o" = Ln -startPhase "cmm" = CmmCpp -startPhase "cmmcpp" = Cmm -startPhase _ = Ln -- all unknown file types +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" = Cc +startPhase "C" = Cc +startPhase "cc" = Cc +startPhase "cxx" = Cc +startPhase "raw_s" = Mangle +startPhase "s" = As +startPhase "S" = As +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 Unlit = "lhs" -phaseInputExt Cpp = "lpp" -- intermediate only -phaseInputExt HsPp = "hscpp" -phaseInputExt Hsc = "hspp" -phaseInputExt HCc = "hc" -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 Ln = "o" -phaseInputExt CmmCpp = "cmm" -phaseInputExt Cmm = "cmmcpp" +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 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" #ifdef ILX -phaseInputExt Ilx2Il = "ilx" -phaseInputExt Ilasm = "il" +phaseInputExt Ilx2Il = "ilx" +phaseInputExt Ilasm = "il" #endif -haskellish_suffixes = [ "hs", "lhs", "hspp", "hscpp", "hcr", "hc", "raw_s", "cmm" ] -haskellish_src_suffixes = [ "hs", "lhs", "hspp", "hscpp", "hcr", "cmm" ] +haskellish_src_suffixes = haskellish_user_src_suffixes ++ + [ "hspp", "hscpp", "hcr", "cmm" ] +haskellish_suffixes = haskellish_src_suffixes ++ ["hc", "raw_s"] cish_suffixes = [ "c", "cpp", "C", "cc", "cxx", "s", "S" ] extcoreish_suffixes = [ "hcr" ] -haskellish_user_src_suffixes = [ "hs", "lhs" ] +haskellish_user_src_suffixes = [ "hs", "lhs", "hs-boot", "lhs-boot" ] -- Will not be deleted as temp files -- Use the appropriate suffix for the system on which -- the GHC-compiled code will run