module UHC.Light.Compiler.EHC.Common ( module Data.Maybe, module Data.List, module Data.Char , module System.IO , module UHC.Util.CompileRun, module UHC.Util.Pretty, module UHC.Util.FPath, module UHC.Util.Utils , module UHC.Light.Compiler.Base.Common, module UHC.Light.Compiler.Base.HsName.Builtin, module UHC.Light.Compiler.Opts , module UHC.Light.Compiler.Error, module UHC.Light.Compiler.Error.Pretty , module UHC.Light.Compiler.Gam.Full , HSState (..) , EHState (..) , CRState (..) , EHCompileUnitState (..) , ecuStateFinalDestination , ecuStateIsCore , EHCompileUnitKind (..) , ecuStateToKind , FinalCompileHow (..) , mkShellCmd, mkShellCmd', showShellCmd , mkInOrOutputFPathDirFor , mkInOrOutputFPathFor , mkOutputFPath , mkPerModuleOutputFPath , mkPerExecOutputFPath , hsstateIsLiteral , hsstateShowLit , hsstateNext , CState (..), OState (..) ) where import Data.List import Data.Char import Data.Maybe import Control.Monad.State import System.IO import UHC.Util.CompileRun import UHC.Util.Pretty import UHC.Util.FPath import UHC.Util.Utils import UHC.Light.Compiler.Base.Common import UHC.Light.Compiler.Base.HsName.Builtin import UHC.Light.Compiler.Opts import UHC.Light.Compiler.Error import UHC.Light.Compiler.Error.Pretty import UHC.Light.Compiler.Gam.Full import UHC.Light.Compiler.Opts.CommandLine import UHC.Util.Time import System.Directory {-# LINE 35 "src/ehc/EHC/Common.chs" #-} -- dummy, so module is not empty for initial variants, and exports will take effect {-# LINE 45 "src/ehc/EHC/Common.chs" #-} data HSState = HSStart -- starting from .hs | HSAllSem -- done all semantics for .hs | HMOnlyMinimal -- done minimal info only -- | HMStart -- starting from nothing, not using .hi info nor .hs file, just for linking etc | HSOnlyImports -- done imports from .hs | HIStart -- starting from .hi | HIAllSem -- done all semantics for .hi | HIOnlyImports -- done imports from .hi | LHSStart -- starting from .lhs | LHSOnlyImports -- done imports from .lhs deriving (Show,Eq) {-# LINE 66 "src/ehc/EHC/Common.chs" #-} hsstateIsLiteral :: HSState -> Bool hsstateIsLiteral LHSStart = True hsstateIsLiteral LHSOnlyImports = True hsstateIsLiteral _ = False {-# LINE 75 "src/ehc/EHC/Common.chs" #-} hsstateShowLit :: HSState -> String hsstateShowLit LHSStart = "Literal" hsstateShowLit LHSOnlyImports = "Literal" hsstateShowLit _ = "" {-# LINE 86 "src/ehc/EHC/Common.chs" #-} hsstateNext :: HSState -> HSState hsstateNext HSStart = HSOnlyImports hsstateNext HIStart = HIOnlyImports -- hsstateNext HMStart = HMOnlyMinimal hsstateNext LHSStart = LHSOnlyImports hsstateNext st = st {-# LINE 99 "src/ehc/EHC/Common.chs" #-} data EHState = EHStart | EHAllSem deriving (Show,Eq) {-# LINE 108 "src/ehc/EHC/Common.chs" #-} -- | State for .c files data CState = CStart | CAllSem deriving (Show,Eq) -- | State for .o files data OState = OStart | OAllSem deriving (Show,Eq) {-# LINE 124 "src/ehc/EHC/Common.chs" #-} data CRState = CRStartText | CRStartBinary | CROnlyImports | CRAllSem deriving (Show,Eq) {-# LINE 135 "src/ehc/EHC/Common.chs" #-} data EHCompileUnitState = ECUS_Unknown | ECUS_Haskell !HSState | ECUS_Eh !EHState | ECUS_C !CState | ECUS_O !OState | ECUS_Core !CRState | ECUS_Grin | ECUS_Fail deriving (Show,Eq) {-# LINE 152 "src/ehc/EHC/Common.chs" #-} -- | The final state ecuStateFinalDestination :: (EHCompileUnitState -> EHCompileUnitState) -> EHCompileUnitState -> EHCompileUnitState ecuStateFinalDestination postModf = postModf . n where n (ECUS_Haskell _) = ECUS_Haskell HSAllSem n (ECUS_Eh _) = ECUS_Eh EHAllSem n (ECUS_C _) = ECUS_C CAllSem n (ECUS_O _) = ECUS_O OAllSem n (ECUS_Core _) = ECUS_Core CRAllSem n _ = ECUS_Fail {-# LINE 169 "src/ehc/EHC/Common.chs" #-} -- | Is compilation from Core source ecuStateIsCore :: EHCompileUnitState -> Bool ecuStateIsCore st = case st of ECUS_Core _ -> True _ -> False {-# LINE 183 "src/ehc/EHC/Common.chs" #-} data EHCompileUnitKind = EHCUKind_HS -- Haskell: .hs .lhs .hi | EHCUKind_C -- C: .c | EHCUKind_None -- Nothing deriving Eq {-# LINE 193 "src/ehc/EHC/Common.chs" #-} ecuStateToKind :: EHCompileUnitState -> EHCompileUnitKind ecuStateToKind s = case s of ECUS_Haskell _ -> EHCUKind_HS ECUS_C _ -> EHCUKind_C _ -> EHCUKind_None {-# LINE 208 "src/ehc/EHC/Common.chs" #-} data FinalCompileHow = FinalCompile_Module | FinalCompile_Exec {-# LINE 218 "src/ehc/EHC/Common.chs" #-} mkShellCmd' :: [Cmd] -> FilePath -> CmdLineOpts -> (FilePath,[String]) mkShellCmd' forCmds cmdStr o = (cmdStr, showCmdLineOpts' forCmds o) mkShellCmd :: [String] -> (FilePath,[String]) mkShellCmd (cmd:args) = (cmd,args) showShellCmd :: (FilePath,[String]) -> String showShellCmd (cmd,args) = concat $ intersperse " " $ [cmd] ++ args {-# LINE 233 "src/ehc/EHC/Common.chs" #-} mkInOrOutputFPathDirFor :: FPATH nm => InOrOutputFor -> EHCOpts -> nm -> FPath -> String -> (FPath,Maybe String) mkInOrOutputFPathDirFor inoutputfor opts modNm fp suffix = (fpathSetSuff suffix fp', d) where (fp',d) = case inoutputfor of OutputFor_Module -> f ehcOptOutputDir OutputFor_Pkg -> f ehcOptOutputDir -- ehcOptOutputPkgLibDir InputFrom_Loc l | filelocIsPkg l -> f (const Nothing) | otherwise -> f ehcOptOutputDir f g = case g opts of Just d -> ( fpathPrependDir d' $ fpathSetBase (fpathBase fp) -- ensure possibly adapted name in filesys is used $ mkFPath modNm -- includes module hierarchy into filename , Just d' ) where d' = filePathUnPrefix d _ -> (fp,Nothing) {-# LINE 258 "src/ehc/EHC/Common.chs" #-} mkInOrOutputFPathFor :: FPATH nm => InOrOutputFor -> EHCOpts -> nm -> FPath -> String -> FPath mkInOrOutputFPathFor inoutputfor opts modNm fp suffix = fst $ mkInOrOutputFPathDirFor inoutputfor opts modNm fp suffix {-# LINE 264 "src/ehc/EHC/Common.chs" #-} mkOutputFPath :: FPATH nm => EHCOpts -> nm -> FPath -> String -> FPath mkOutputFPath = mkInOrOutputFPathFor OutputFor_Module {-# LINE 273 "src/ehc/EHC/Common.chs" #-} -- | FPath for per module output mkPerModuleOutputFPath :: EHCOpts -> Bool -> HsName -> FPath -> String -> FPath mkPerModuleOutputFPath opts doSepBy_ modNm fp suffix = fpO modNm fp where fpO m f= case ehcOptPkgOpt opts of Just _ -> nm_ _ | doSepBy_ -> nm_ | otherwise -> mkOutputFPath opts m f suffix where nm_ = mkOutputFPath opts (hsnMapQualified (const base) m) (fpathSetBase base f) suffix where base = hsnShow "_" "_" m {-# LINE 290 "src/ehc/EHC/Common.chs" #-} -- | FPath for final executable, with possible suffix (and forcing flag, even on given exec) mkPerExecOutputFPath :: EHCOpts -> HsName -> FPath -> Maybe (String, Bool) -> FPath mkPerExecOutputFPath opts modNm fp mbSuffix = maybe id (\(s,force) -> if force then fpathSetSuff s else id) mbSuffix fpExec where fpExecBasedOnSrc = maybe (mkOutputFPath opts modNm fp "") (\(s,_) -> mkOutputFPath opts modNm fp s) mbSuffix fpExec = maybe fpExecBasedOnSrc id (ehcOptMbOutputFile opts)