X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fmain%2FDriverPhases.hs;h=8d8fec4f4deb433bd3ad8f49cf07455b45737ea2;hb=7bb3d1fc79521d591cd9f824893963141a7997b6;hp=b684d0e80b49c9f2f36e21417dfc6a8b36aa3b49;hpb=ad94d40948668032189ad22a0ad741ac1f645f50;p=ghc-hetmet.git diff --git a/compiler/main/DriverPhases.hs b/compiler/main/DriverPhases.hs index b684d0e..8d8fec4 100644 --- a/compiler/main/DriverPhases.hs +++ b/compiler/main/DriverPhases.hs @@ -7,13 +7,6 @@ -- ----------------------------------------------------------------------------- -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings --- for details - module DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase(..), @@ -40,8 +33,10 @@ module DriverPhases ( isSourceFilename -- :: FilePath -> Bool ) where -import Util ( suffixOf ) +#include "HsVersions.h" + import Panic ( panic ) +import System.FilePath ----------------------------------------------------------------------------- -- Phases @@ -71,7 +66,7 @@ hscSourceString ExtCoreFile = "[ext core]" isHsBoot :: HscSource -> Bool isHsBoot HsBootFile = True -isHsBoot other = False +isHsBoot _ = False data Phase = Unlit HscSource @@ -98,7 +93,7 @@ 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 @@ -122,7 +117,8 @@ 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 @@ -132,7 +128,7 @@ nextPhase :: Phase -> Phase nextPhase (Unlit sf) = Cpp sf nextPhase (Cpp sf) = HsPp sf nextPhase (HsPp sf) = Hsc sf -nextPhase (Hsc sf) = HCc +nextPhase (Hsc _) = HCc nextPhase HCc = Mangle nextPhase Mangle = SplitMangle nextPhase SplitMangle = As @@ -146,6 +142,7 @@ 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 @@ -171,6 +168,7 @@ 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" @@ -191,14 +189,19 @@ 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" ] 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" ] @@ -206,6 +209,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) @@ -214,23 +218,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)