module UHC.Light.Compiler.EHC.Common ( module Data.Maybe, module Data.List, module Data.Char , module System.IO , module UHC.Util.CompileRun2, 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 (..) , CRRState (..) , EHCompileUnitState (..) , ecuStateFinalDestination , ecuStateIsCore , ecuStateIsCoreRun , EHCompileUnitKind (..) , ecuStateToKind , ASTType (..) , ASTFileContent (..) , ASTHandlerKey , ASTFileUse (..) , ASTSuffixKey , ASTFileTiming (..) , FileSuffInitState , PrevSearchInfo , FinalCompileHow (..) , mkShellCmd, mkShellCmd', showShellCmd , mkInOrOutputFPathDirFor , mkInOrOutputFPathFor , mkOutputFPath , mkPerModuleOutputFPath , mkPerExecOutputFPath , hsstateIsLiteral , hsstateShowLit , hsstateNext , CState (..), OState (..) , prevSearchInfoAdaptedSearchPath ) where import Data.List import Data.Char import Data.Maybe import Control.Monad.State import System.IO import UHC.Util.CompileRun2 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 GHC.Generics import UHC.Light.Compiler.Gam.Full import UHC.Light.Compiler.Opts.CommandLine import qualified UHC.Util.RelMap as Rel import UHC.Util.Time import System.Directory {-# LINE 40 "src/ehc/EHC/Common.chs" #-} -- dummy, so module is not empty for initial variants, and exports will take effect {-# LINE 50 "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 71 "src/ehc/EHC/Common.chs" #-} hsstateIsLiteral :: HSState -> Bool hsstateIsLiteral LHSStart = True hsstateIsLiteral LHSOnlyImports = True hsstateIsLiteral _ = False {-# LINE 80 "src/ehc/EHC/Common.chs" #-} hsstateShowLit :: HSState -> String hsstateShowLit LHSStart = "Literal" hsstateShowLit LHSOnlyImports = "Literal" hsstateShowLit _ = "" {-# LINE 91 "src/ehc/EHC/Common.chs" #-} hsstateNext :: HSState -> HSState hsstateNext HSStart = HSOnlyImports hsstateNext HIStart = HIOnlyImports -- hsstateNext HMStart = HMOnlyMinimal hsstateNext LHSStart = LHSOnlyImports hsstateNext st = st {-# LINE 104 "src/ehc/EHC/Common.chs" #-} data EHState = EHStart | EHAllSem deriving (Show,Eq) {-# LINE 113 "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 129 "src/ehc/EHC/Common.chs" #-} data CRState = CRStartBinary | CRStartText | CROnlyImports | CRAllSem deriving (Show,Eq) {-# LINE 138 "src/ehc/EHC/Common.chs" #-} data CRRState = CRRStartBinary -- | CRRStartText | CRROnlyImports | CRRAllSem deriving (Show,Eq) {-# LINE 149 "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_CoreRun !CRRState | ECUS_Grin | ECUS_Fail deriving (Show,Eq) {-# LINE 169 "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_CoreRun _) = ECUS_CoreRun CRRAllSem n _ = ECUS_Fail {-# LINE 189 "src/ehc/EHC/Common.chs" #-} -- | Is compilation from Core source ecuStateIsCore :: EHCompileUnitState -> Bool ecuStateIsCore st = case st of ECUS_Core _ -> True _ -> False {-# LINE 199 "src/ehc/EHC/Common.chs" #-} -- | Is compilation from CoreRun source ecuStateIsCoreRun :: EHCompileUnitState -> Bool ecuStateIsCoreRun st = case st of ECUS_CoreRun _ -> True _ -> False {-# LINE 213 "src/ehc/EHC/Common.chs" #-} data EHCompileUnitKind = EHCUKind_HS -- Haskell: .hs .lhs .hi | EHCUKind_C -- C: .c | EHCUKind_None -- Nothing deriving Eq {-# LINE 223 "src/ehc/EHC/Common.chs" #-} ecuStateToKind :: EHCompileUnitState -> EHCompileUnitKind ecuStateToKind s = case s of ECUS_Haskell _ -> EHCUKind_HS ECUS_C _ -> EHCUKind_C _ -> EHCUKind_None {-# LINE 238 "src/ehc/EHC/Common.chs" #-} -- | An 'Enum' of all types of ast we can deal with data ASTType = ASTType_HS | ASTType_EH | ASTType_HI | ASTType_Core | ASTType_CoreRun | ASTType_C | ASTType_O | ASTType_Unknown deriving (Eq, Ord, Enum, Typeable, Generic, Bounded, Show) instance Hashable ASTType {-# LINE 271 "src/ehc/EHC/Common.chs" #-} -- | File content variations of ast we can deal with (in principle) data ASTFileContent = ASTFileContent_Text | ASTFileContent_LitText | ASTFileContent_Binary | ASTFileContent_Unknown deriving (Eq, Ord, Enum, Typeable, Generic, Bounded, Show) instance Hashable ASTFileContent {-# LINE 283 "src/ehc/EHC/Common.chs" #-} -- | Combination of 'ASTType' and 'ASTFileContent' as key into map of handlers type ASTHandlerKey = (ASTType, ASTFileContent) {-# LINE 288 "src/ehc/EHC/Common.chs" #-} -- | File usage variations of ast data ASTFileUse = ASTFileUse_Cache -- ^ internal use cache on file | ASTFileUse_Dump -- ^ output: dumped, possibly usable as src later on | ASTFileUse_Target -- ^ output: as target of compilation | ASTFileUse_Src -- ^ input: src file | ASTFileUse_Unknown -- ^ unknown deriving (Eq, Ord, Enum, Typeable, Generic, Bounded, Show) instance Hashable ASTFileUse {-# LINE 301 "src/ehc/EHC/Common.chs" #-} -- | Key for allowed suffixes, multiples allowed to cater for different suffixes type ASTSuffixKey = (ASTFileContent, ASTFileUse) {-# LINE 306 "src/ehc/EHC/Common.chs" #-} -- | File timing variations of ast data ASTFileTiming = ASTFileTiming_Prev -- ^ previously generated | ASTFileTiming_Current -- ^ current one deriving (Eq, Ord, Enum, Typeable, Generic, Bounded, Show) instance Hashable ASTFileTiming {-# LINE 320 "src/ehc/EHC/Common.chs" #-} -- | initial state/settings categorizing the kind of file/ast dealing with type FileSuffInitState = ( EHCompileUnitState , ASTType , ASTFileContent , ASTFileUse ) {-# LINE 334 "src/ehc/EHC/Common.chs" #-} type PrevSearchInfo = (HsName,(FPath,FileLoc)) {-# LINE 338 "src/ehc/EHC/Common.chs" #-} -- | strip tail part corresponding to module name, and use it to search as well prevSearchInfoAdaptedSearchPath :: Maybe PrevSearchInfo -> FileLocPath -> FileLocPath prevSearchInfoAdaptedSearchPath (Just (prevNm,(prevFp,prevLoc))) searchPath = case (fpathMbDir (mkFPath prevNm), fpathMbDir prevFp, prevLoc) of (_, _, p) | filelocIsPkg p -> p : searchPath (Just n, Just p, _) -> mkDirFileLoc (filePathUnPrefix prefix) : searchPath where (prefix,_) = splitAt (length p - length n) p _ -> searchPath prevSearchInfoAdaptedSearchPath _ searchPath = searchPath {-# LINE 356 "src/ehc/EHC/Common.chs" #-} data FinalCompileHow = FinalCompile_Module | FinalCompile_Exec {-# LINE 366 "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 381 "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 406 "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 412 "src/ehc/EHC/Common.chs" #-} mkOutputFPath :: FPATH nm => EHCOpts -> nm -> FPath -> String -> FPath mkOutputFPath = mkInOrOutputFPathFor OutputFor_Module {-# LINE 421 "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 438 "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)