{-# LANGUAGE TemplateHaskell #-} module UHC.Light.Compiler.EHC.CompileUnit ( EHCompileUnit (..) , ecuASTAvailFiles, ecuASTType, ecuASTFileContent, ecuASTFileUse , ecuMbCore, ecuCore , ecuMbCore2CoreRunSem, ecuMbCoreRun, ecuCoreRun , ecuMbCoreSemMod, ecuCoreSemMod , ecuMbCoreRunSemMod, ecuCoreRunSemMod, ecuMbCoreRunSemChk, ecuCoreRunSemChk , ecuMbHS, ecuHS, ecuMbHSSem, ecuHSSem, ecuMbEH, ecuEH, ecuMbEHSem, ecuEHSem , ecuAlreadyFlowIntoCRSI , ecuFilePath , emptyECU , ecuHasAlreadyFlowedWith, ecuHasAlreadyFlowed , ecuLookupAvailASTFile , ecuFinalDestinationState , EcuUpdater, ecuStoreSrcFilePath, ecuStoreState, ecuStoreHS, ecuStoreEH, ecuStoreHSSem, ecuStoreEHSem , ecuStoreCoreSemMod , ecuStoreCore , ecuStoreCoreRun , ecuStoreCoreRunSemMod , ecuStoreCore2CoreRunSem , ecuSrcHasSuffix , Optim (..), defaultOptim , ecuIsTopMod , ecuMbHIInfo, ecuHIInfo, ecuMbPrevHIInfo, ecuPrevHIInfo, ecuMbHSSemMod, ecuHSSemMod, ecuMbSrcTime, ecuSrcTime, ecuMbHIInfoTime, ecuHIInfoTime , ecuDirIsWritable, ecuMbPrevSearchInfo, ecuPrevSearchInfo , ecuMbCoreTime, ecuCoreTime , ecuMbCoreRunTime, ecuCoreRunTime , ecuSrcDeclImpNmS, ecuHIDeclImpNmS, ecuHIUsedImpNmS , ecuIsMainMod , ecuImpNmS, ecuImpNmL , ecuTransClosedUsedModMp, ecuTransClosedOrphanModS , ecuIsOrphan , ecuStoreSrcDeclImpS, ecuSetNeedsCompile, ecuStoreHIUsedImpS, ecuStoreHIInfoTime, ecuStoreSrcTime, ecuStoreHSSemMod, ecuStoreIntrodModS, ecuStoreHIDeclImpS, ecuStoreMod, ecuSetIsTopMod, ecuSetHasMain, ecuStoreOptim, ecuStoreHIInfo, ecuStorePrevHIInfo , ecuStoreCoreTime , ecuStoreCoreRunTime , ecuStoreDirIsWritable , ecuIsHSNewerThanHI , ecuIsValidHIInfo , ecuCanUseHIInsteadOfHS , ecuCanCompile , EHCCompileSeqNr (..) , ecuAnHIInfo , ecuStoreOpts, ecuStorePragmas, ecuStoreUsedNames, ecuSetTarget , ecuStoreGenCodeFiles , ecuStoreCppFilePath, ecuStoreSeqNr ) where import qualified Data.Map as Map import qualified Data.Set as Set import UHC.Light.Compiler.EHC.Common import UHC.Util.Lens import UHC.Light.Compiler.EHC.ASTTypes import qualified UHC.Light.Compiler.HI as HI import UHC.Light.Compiler.Module.ImportExport import UHC.Light.Compiler.CodeGen.ImportUsedModules import UHC.Util.Time import System.Directory import qualified UHC.Light.Compiler.Base.Pragma as Pragma import UHC.Light.Compiler.Base.Target import UHC.Util.Debug {-# LINE 59 "src/ehc/EHC/CompileUnit.chs" #-} data Optim = Optim defaultOptim :: Optim defaultOptim = Optim {-# LINE 82 "src/ehc/EHC/CompileUnit.chs" #-} data EHCCompileSeqNr = EHCCompileSeqNr { ecseqnrThis :: !Int , ecseqnrTotal :: !Int } deriving (Eq,Ord) zeroEHCCompileSeqNr :: EHCCompileSeqNr zeroEHCCompileSeqNr = EHCCompileSeqNr 0 0 instance Show EHCCompileSeqNr where show (EHCCompileSeqNr this total) = "[" ++ replicate (length tot - length ths) ' ' ++ ths ++ "/" ++ tot ++ "]" where tot = show total ths = show this {-# LINE 104 "src/ehc/EHC/CompileUnit.chs" #-} -- | Single compilation unit info, fields prefixed with _ have Lens access data EHCompileUnit = EHCompileUnit { ecuSrcFilePath :: !FPath , ecuMbCppFilePath :: !(Maybe FPath) , ecuFileLocation :: !FileLoc , ecuGrpNm :: !HsName , ecuModNm :: !HsName , _ecuMbHS :: !(Maybe AST_HS) , _ecuMbHSSem :: !(Maybe AST_HS_Sem_Check) , _ecuMbEH :: !(Maybe AST_EH) , _ecuMbEHSem :: !(Maybe AST_EH_Sem_Check) , _ecuASTAvailFiles :: [ASTAvailableFile] , _ecuMbCore :: !(Maybe AST_Core) , _ecuMbCore2CoreRunSem:: !(Maybe AST_Core_Sem_ToCoreRun) , _ecuMbCoreSemMod :: !(Maybe AST_Core_Sem_Check) , _ecuMbCoreRun :: !(Maybe AST_CoreRun) , _ecuMbCoreRunSemMod :: !(Maybe AST_CoreRun_Sem_Mod) , _ecuMbCoreRunSemChk :: !(Maybe AST_CoreRun_Sem_Check) , ecuState :: !EHCompileUnitState , _ecuASTType :: !ASTType , _ecuASTFileContent :: !ASTFileContent , _ecuASTFileUse :: !ASTFileUse , _ecuAlreadyFlowIntoCRSI :: !(Map.Map ASTType (Set.Set ASTAlreadyFlowIntoCRSIInfo)) -- the semantics already flown into global state , ecuImportUsedModules :: !ImportUsedModules -- imported modules info , _ecuIsTopMod :: !Bool -- module has been specified for compilation on commandline , ecuHasMain :: !Bool -- has a def for 'main'? , ecuNeedsCompile :: !Bool -- (re)compilation from .hs needed? , _ecuMbSrcTime :: !(Maybe ClockTime) -- timestamp of possibly absent source (hs, or other type) file , _ecuMbHIInfoTime :: !(Maybe ClockTime) -- timestamp of possibly previously generated hi file , _ecuMbCoreTime :: !(Maybe ClockTime) -- timestamp of possibly previously generated core file , _ecuMbCoreRunTime :: !(Maybe ClockTime) -- timestamp of possibly previously generated corerun file , _ecuMbHSSemMod :: !(Maybe AST_HS_Sem_Mod) , ecuMod :: !Mod -- import/export info of module , _ecuMbPrevHIInfo :: !(Maybe AST_HI) -- possible HI info of previous run , ecuMbOptim :: !(Maybe Optim) , _ecuMbHIInfo :: !(Maybe AST_HI) -- HI info of module , _ecuDirIsWritable :: !Bool -- can be written in dir of module? , _ecuMbPrevSearchInfo :: !(Maybe PrevSearchInfo) -- file search info required for imported module search , ecuMbOpts :: (Maybe EHCOpts) -- possibly per module adaption of options (caused by pragmas) , ecuTarget :: Target -- target for which we compile , ecuPragmas :: !(Set.Set Pragma.Pragma) -- pragmas of module , ecuUsedNames :: ModEntRelFilterMp -- map holding actually used names, to later filter cache of imported hi's to be included in this module's hi , ecuSeqNr :: !EHCCompileSeqNr -- sequence nr of sorted compilation , ecuGenCodeFiles :: ![FPath] -- generated code files } deriving Typeable {-# LINE 200 "src/ehc/EHC/CompileUnit.chs" #-} mkLabel ''EHCompileUnit {-# LINE 211 "src/ehc/EHC/CompileUnit.chs" #-} ecuCore = isoMb "ecuMbCore" ecuMbCore {-# LINE 221 "src/ehc/EHC/CompileUnit.chs" #-} ecuCoreRun = isoMb "ecuMbCoreRun" ecuMbCoreRun {-# LINE 224 "src/ehc/EHC/CompileUnit.chs" #-} ecuCoreSemMod = isoMb "ecuMbCoreSemMod" ecuMbCoreSemMod {-# LINE 227 "src/ehc/EHC/CompileUnit.chs" #-} ecuCoreRunSemMod = isoMb "ecuMbCoreRunSemMod" ecuMbCoreRunSemMod ecuCoreRunSemChk = isoMb "ecuMbCoreRunSemChk" ecuMbCoreRunSemChk {-# LINE 232 "src/ehc/EHC/CompileUnit.chs" #-} ecuEH = isoMb "ecuMbEH" ecuMbEH ecuEHSem = isoMb "ecuMbEHSem" ecuMbEHSem ecuHS = isoMb "ecuMbHS" ecuMbHS ecuHSSem = isoMb "ecuMbHSSem" ecuMbHSSem {-# LINE 245 "src/ehc/EHC/CompileUnit.chs" #-} ecuHIInfo = isoMbWithDefault HI.emptyHIInfo ecuMbHIInfo ecuPrevHIInfo = isoMb "ecuMbPrevHIInfo" ecuMbPrevHIInfo ecuHSSemMod = isoMb "ecuMbHSSemMod" ecuMbHSSemMod ecuSrcTime = isoMb "ecuMbSrcTime" ecuMbSrcTime ecuHIInfoTime = isoMb "ecuMbHIInfoTime" ecuMbHIInfoTime {-# LINE 253 "src/ehc/EHC/CompileUnit.chs" #-} ecuPrevSearchInfo = isoMb "ecuMbPrevSearchInfo" ecuMbPrevSearchInfo {-# LINE 257 "src/ehc/EHC/CompileUnit.chs" #-} ecuCoreTime = isoMb "ecuMbCoreTime" ecuMbCoreTime {-# LINE 265 "src/ehc/EHC/CompileUnit.chs" #-} ecuCoreRunTime = isoMb "ecuMbCoreRunTime" ecuMbCoreRunTime {-# LINE 269 "src/ehc/EHC/CompileUnit.chs" #-} ecuSrcDeclImpNmS = iumSrcDeclModules . ecuImportUsedModules ecuHIDeclImpNmS = iumHIDeclModules . ecuImportUsedModules ecuHIUsedImpNmS = iumHIUsedModules . ecuImportUsedModules {-# LINE 275 "src/ehc/EHC/CompileUnit.chs" #-} ecuFilePath :: EHCompileUnit -> FPath ecuFilePath ecu = maybe (ecuSrcFilePath ecu) id (ecuMbCppFilePath ecu) {-# LINE 285 "src/ehc/EHC/CompileUnit.chs" #-} ecuIsMainMod :: EHCompileUnit -> Bool ecuIsMainMod e = _ecuIsTopMod e && ecuHasMain e {-# LINE 290 "src/ehc/EHC/CompileUnit.chs" #-} -- | give the current value HIInfo, or the previous one ecuAnHIInfo :: EHCompileUnit -> AST_HI ecuAnHIInfo e = case _ecuMbPrevHIInfo e of Just pi | HI.hiiIsEmpty hii -> pi _ -> hii where hii = e ^. ecuHIInfo {-# LINE 301 "src/ehc/EHC/CompileUnit.chs" #-} emptyECU :: EHCompileUnit emptyECU = EHCompileUnit { ecuSrcFilePath = emptyFPath , ecuMbCppFilePath = Nothing , ecuFileLocation = emptyFileLoc , ecuGrpNm = hsnUnknown , ecuModNm = hsnUnknown , _ecuMbHS = Nothing , _ecuMbHSSem = Nothing , _ecuMbEH = Nothing , _ecuMbEHSem = Nothing , _ecuASTAvailFiles = [] , _ecuMbCore = Nothing , _ecuMbCore2CoreRunSem= Nothing , _ecuMbCoreSemMod = Nothing , _ecuMbCoreRun = Nothing , _ecuMbCoreRunSemMod = Nothing , _ecuMbCoreRunSemChk = Nothing , ecuState = ECUS_Unknown , _ecuASTType = ASTType_Unknown , _ecuASTFileContent = ASTFileContent_Unknown , _ecuASTFileUse = ASTFileUse_Unknown , _ecuAlreadyFlowIntoCRSI = Map.empty , ecuImportUsedModules = emptyImportUsedModules , _ecuIsTopMod = False , ecuHasMain = False , ecuNeedsCompile = True , _ecuMbSrcTime = Nothing , _ecuMbHIInfoTime = Nothing , _ecuMbCoreTime = Nothing , _ecuMbCoreRunTime = Nothing , _ecuMbHSSemMod = Nothing , ecuMod = emptyMod , _ecuMbPrevHIInfo = Nothing , ecuMbOptim = Nothing , _ecuMbHIInfo = Nothing , _ecuDirIsWritable = False , _ecuMbPrevSearchInfo = Nothing , ecuMbOpts = Nothing , ecuTarget = defaultTarget , ecuPragmas = Set.empty , ecuUsedNames = Map.empty , ecuSeqNr = zeroEHCCompileSeqNr , ecuGenCodeFiles = [] } {-# LINE 401 "src/ehc/EHC/CompileUnit.chs" #-} ecuImpNmS :: EHCompileUnit -> Set.Set HsName ecuImpNmS ecu = -- (\v -> tr "XX" (pp $ Set.toList v) v) $ Set.delete (ecuModNm ecu) $ Set.unions [ ecuSrcDeclImpNmS ecu, ecuHIDeclImpNmS ecu, ecuHIUsedImpNmS ecu ] ecuImpNmL :: EHCompileUnit -> [HsName] ecuImpNmL = Set.toList . ecuImpNmS -- ecu = (nub $ ecuHSDeclImpNmL ecu ++ ecuHIDeclImpNmL ecu ++ ecuHIUsedImpNmL ecu) \\ [ecuModNm ecu] {-# LINE 410 "src/ehc/EHC/CompileUnit.chs" #-} -- | The used modules, for linking, according to .hi info ecuTransClosedUsedModMp :: EHCompileUnit -> HI.HIInfoUsedModMp ecuTransClosedUsedModMp = HI.hiiTransClosedUsedModMp . ecuAnHIInfo -- | The orphan modules, must be .hi read, according to .hi info ecuTransClosedOrphanModS :: EHCompileUnit -> Set.Set HsName ecuTransClosedOrphanModS = HI.hiiTransClosedOrphanModS . ecuAnHIInfo {-# LINE 420 "src/ehc/EHC/CompileUnit.chs" #-} -- | Is orphan, according to .hi info ecuIsOrphan :: EHCompileUnit -> Bool ecuIsOrphan = isJust . HI.hiiMbOrphan . ecuAnHIInfo {-# LINE 430 "src/ehc/EHC/CompileUnit.chs" #-} -- | Semantics for an AST already has flowed into global state ecuHasAlreadyFlowedWith :: ASTType -> ASTAlreadyFlowIntoCRSIInfo -> EHCompileUnit -> Bool ecuHasAlreadyFlowedWith asttype flowstage ecu = case Map.lookup asttype (ecu ^. ecuAlreadyFlowIntoCRSI) of Just s -> Set.member flowstage s _ -> False -- | Semantics for an AST already has flowed into global state ecuHasAlreadyFlowed :: ASTType -> ASTSemFlowStage -> EHCompileUnit -> Bool ecuHasAlreadyFlowed asttype flowstage ecu = ecuHasAlreadyFlowedWith asttype (flowstage,Nothing) ecu {-# LINE 449 "src/ehc/EHC/CompileUnit.chs" #-} -- | Lookup available AST file, left biased (according to fileSuffMpHs (in the end)) ecuLookupAvailASTFile :: ASTType -> ASTFileUse -> (ASTSuffixKey -> Bool) -> EHCompileUnit -> Maybe ASTAvailableFile ecuLookupAvailASTFile t u isOkCont ecu = find (\a -> _astavailfType a == t && _astavailfUse a == u && isOkCont (_astavailfContent a, u)) (_ecuASTAvailFiles ecu) {-# LINE 459 "src/ehc/EHC/CompileUnit.chs" #-} instance CompileUnitState FileSuffInitState where cusDefault = (ECUS_Eh EHStart, ASTType_EH, ASTFileContent_Text, ASTFileUse_Src) cusUnk = (ECUS_Unknown, ASTType_Unknown, ASTFileContent_Unknown, ASTFileUse_Unknown) cusIsUnk (ECUS_Unknown,_,_,_) = True cusIsUnk _ = False {-# LINE 469 "src/ehc/EHC/CompileUnit.chs" #-} cusIsImpKnown (s,_,_,_) = case s of ECUS_Haskell HSOnlyImports -> True ECUS_Haskell HIOnlyImports -> True ECUS_Haskell HMOnlyMinimal -> True ECUS_Haskell LHSOnlyImports -> True ECUS_Haskell HSAllSem -> True ECUS_Haskell HIAllSem -> True ECUS_Core CROnlyImports -> True ECUS_CoreRun CRROnlyImports -> True _ -> False {-# LINE 488 "src/ehc/EHC/CompileUnit.chs" #-} instance FileLocatable EHCompileUnit FileLoc where fileLocation = ecuFileLocation noFileLocation = emptyFileLoc {-# LINE 494 "src/ehc/EHC/CompileUnit.chs" #-} instance CompileUnit EHCompileUnit HsName FileLoc FileSuffInitState where cuDefault = emptyECU cuFPath = ecuFilePath cuLocation = fileLocation cuKey = ecuModNm cuState u = (ecuState u, _ecuASTType u, _ecuASTFileContent u, _ecuASTFileUse u) cuUpdFPath = ecuStoreSrcFilePath cuUpdLocation = ecuStoreFileLocation cuUpdState (s,t,c,u) = ecuStoreState s . (ecuASTType ^= t) . (ecuASTFileContent ^= c) . (ecuASTFileUse ^= u) cuUpdKey nm u = u {ecuModNm = nm} cuImports = ecuImpNmL cuParticipation u = if not (Set.null $ Set.filter (Pragma.pragmaIsExcludeTarget $ ecuTarget u) $ ecuPragmas u) then [CompileParticipation_NoImport] else [] -- instance FPathError Err instance CompileRunError Err () where crePPErrL = ppErrL creMkNotFoundErrL _ fp sp sufs = [rngLift emptyRange Err_FileNotFound fp sp sufs] creAreFatal = errLIsFatal instance CompileModName HsName where mkCMNm = hsnFromString instance Show EHCompileUnit where show _ = "EHCompileUnit" instance PP EHCompileUnit where pp ecu = ecuModNm ecu >|< ":" >#< ppBracketsCommas (ecuImpNmL ecu) >|< "," >#< show (ecuState ecu) {-# LINE 540 "src/ehc/EHC/CompileUnit.chs" #-} -- | The final state to be reached ecuFinalDestinationState :: EHCompileUnit -> EHCompileUnitState ecuFinalDestinationState ecu = ecuStateFinalDestination upd $ ecuState ecu where upd (ECUS_Haskell _) | ecuNeedsCompile ecu = ECUS_Haskell HSAllSem | otherwise = ECUS_Haskell HIAllSem upd s = s {-# LINE 557 "src/ehc/EHC/CompileUnit.chs" #-} type EcuUpdater a = a -> EHCompileUnit -> EHCompileUnit ecuStoreSrcFilePath :: EcuUpdater FPath ecuStoreSrcFilePath x ecu = ecu { ecuSrcFilePath = x } ecuStoreFileLocation :: EcuUpdater FileLoc ecuStoreFileLocation x ecu = ecu { ecuFileLocation = x } ecuStoreState :: EcuUpdater EHCompileUnitState ecuStoreState x ecu = ecu { ecuState = x } ecuStoreHS :: EcuUpdater AST_HS ecuStoreHS x ecu = ecu { _ecuMbHS = Just x } ecuStoreEH :: EcuUpdater AST_EH ecuStoreEH x ecu = ecu { _ecuMbEH = Just x } ecuStoreHSSem :: EcuUpdater AST_HS_Sem_Check ecuStoreHSSem x ecu = ecu { _ecuMbHSSem = Just x } ecuStoreEHSem :: EcuUpdater AST_EH_Sem_Check ecuStoreEHSem x ecu = ecu { _ecuMbEHSem = Just x } {-# LINE 582 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreSemMod :: EcuUpdater AST_Core_Sem_Check ecuStoreCoreSemMod x ecu = ecu { _ecuMbCoreSemMod = Just x } {-# LINE 592 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCore :: EcuUpdater AST_Core ecuStoreCore x ecu | x `seq` True = ecu { _ecuMbCore = Just x } {-# LINE 603 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreRun :: EcuUpdater AST_CoreRun ecuStoreCoreRun x ecu | x `seq` True = ecu { _ecuMbCoreRun = Just x } {-# LINE 608 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreRunSemMod :: EcuUpdater AST_CoreRun_Sem_Mod ecuStoreCoreRunSemMod x ecu = ecu { _ecuMbCoreRunSemMod = Just x } {-# LINE 613 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCore2CoreRunSem :: EcuUpdater AST_Core_Sem_ToCoreRun ecuStoreCore2CoreRunSem x ecu = ecu { _ecuMbCore2CoreRunSem = Just x } {-# LINE 659 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreSrcTime :: EcuUpdater ClockTime ecuStoreSrcTime x ecu = ecu { _ecuMbSrcTime = Just x } -- ecuStoreHITime :: EcuUpdater ClockTime -- ecuStoreHITime x ecu = ecu { ecuMbHITime = Just x } ecuStoreHIInfoTime :: EcuUpdater ClockTime ecuStoreHIInfoTime x ecu = ecu { _ecuMbHIInfoTime = Just x } ecuStoreHSSemMod :: EcuUpdater AST_HS_Sem_Mod ecuStoreHSSemMod x ecu = ecu { _ecuMbHSSemMod = Just x } ecuStoreSrcDeclImpS :: EcuUpdater (Set.Set HsName) ecuStoreSrcDeclImpS x ecu = ecu { ecuImportUsedModules = ium {iumSrcDeclModules = x} } where ium = ecuImportUsedModules ecu ecuStoreHIDeclImpS :: EcuUpdater (Set.Set HsName) ecuStoreHIDeclImpS x ecu = ecu { ecuImportUsedModules = ium {iumHIDeclModules = x} } where ium = ecuImportUsedModules ecu ecuStoreHIUsedImpS :: EcuUpdater (Set.Set HsName) ecuStoreHIUsedImpS x ecu = ecu { ecuImportUsedModules = ium {iumHIUsedModules = x} } where ium = ecuImportUsedModules ecu ecuStoreIntrodModS :: EcuUpdater (Set.Set HsName) ecuStoreIntrodModS x ecu = ecu { ecuImportUsedModules = ium {iumIntrodModules = x} } where ium = ecuImportUsedModules ecu ecuStoreMod :: EcuUpdater Mod ecuStoreMod x ecu = ecu { ecuMod = x } ecuSetIsTopMod :: EcuUpdater Bool ecuSetIsTopMod x ecu = ecu { _ecuIsTopMod = x } ecuSetHasMain :: EcuUpdater Bool ecuSetHasMain x ecu = ecu { ecuHasMain = x } ecuSetNeedsCompile :: EcuUpdater Bool ecuSetNeedsCompile x ecu = ecu { ecuNeedsCompile = x } -- ecuStorePrevHI :: EcuUpdater HI.AGItf -- ecuStorePrevHI x ecu = ecu { ecuMbPrevHI = Just x } -- ecuStorePrevHISem :: EcuUpdater HISem.Syn_AGItf -- ecuStorePrevHISem x ecu = ecu { ecuMbPrevHISem = Just x } ecuStorePrevHIInfo :: EcuUpdater AST_HI ecuStorePrevHIInfo x ecu = ecu { _ecuMbPrevHIInfo = Just x } ecuStoreOptim :: EcuUpdater Optim ecuStoreOptim x ecu = ecu { ecuMbOptim = Just x } ecuStoreHIInfo :: EcuUpdater AST_HI ecuStoreHIInfo x ecu | x `seq` True = ecu { _ecuMbHIInfo = Just x } {-# LINE 720 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreTime :: EcuUpdater ClockTime ecuStoreCoreTime x ecu = ecu { _ecuMbCoreTime = Just x } {-# LINE 725 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreRunTime :: EcuUpdater ClockTime ecuStoreCoreRunTime x ecu = ecu { _ecuMbCoreRunTime = Just x } {-# LINE 735 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreDirIsWritable :: EcuUpdater Bool ecuStoreDirIsWritable x ecu = ecu { _ecuDirIsWritable = x } {-# LINE 740 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreOpts :: EcuUpdater EHCOpts ecuStoreOpts x ecu = ecu { ecuMbOpts = Just x } ecuSetTarget :: EcuUpdater Target ecuSetTarget x ecu = ecu { ecuTarget = x } ecuStorePragmas :: EcuUpdater (Set.Set Pragma.Pragma) ecuStorePragmas x ecu = ecu { ecuPragmas = x } ecuStoreUsedNames :: EcuUpdater ModEntRelFilterMp ecuStoreUsedNames x ecu = ecu { ecuUsedNames = x } {-# LINE 754 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreGenCodeFiles :: EcuUpdater [FPath] ecuStoreGenCodeFiles x ecu = ecu { ecuGenCodeFiles = x } {-# LINE 759 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreSeqNr :: EcuUpdater EHCCompileSeqNr ecuStoreSeqNr x ecu = ecu { ecuSeqNr = x } ecuStoreCppFilePath :: EcuUpdater FPath ecuStoreCppFilePath x ecu = ecu { ecuMbCppFilePath = Just x } {-# LINE 771 "src/ehc/EHC/CompileUnit.chs" #-} -- | Has the source file the given extension? Given suffix is stripped from possible prefixed '.'. ecuSrcHasSuffix :: String -> EHCompileUnit -> Bool ecuSrcHasSuffix suff ecu = maybe False (==suff') $ fpathMbSuff $ ecuSrcFilePath ecu where suff' = case suff of {('.':s) -> s; _ -> suff} {-# LINE 779 "src/ehc/EHC/CompileUnit.chs" #-} -- | Is HS newer? -- If no HS exists False is returned. ecuIsHSNewerThanHI :: EHCompileUnit -> Bool ecuIsHSNewerThanHI ecu = case (_ecuMbSrcTime ecu,_ecuMbHIInfoTime ecu) of (Just ths,Just thi) -> ths `diffClockTimes` thi > noTimeDiff (Nothing ,Just thi) -> False _ -> True {-# LINE 790 "src/ehc/EHC/CompileUnit.chs" #-} ecuIsValidHIInfo :: EHCompileUnit -> Bool ecuIsValidHIInfo ecu = case _ecuMbPrevHIInfo ecu of Just i -> HI.hiiValidity i == HI.HIValidity_Ok _ -> False {-# LINE 798 "src/ehc/EHC/CompileUnit.chs" #-} -- | Can HI be used instead of HS? -- This is purely based on HI being of the right version and HS not newer. -- The need for recompilation considers dependencies on imports as well. ecuCanUseHIInsteadOfHS :: EHCompileUnit -> Bool ecuCanUseHIInsteadOfHS ecu = ecuIsValidHIInfo ecu && not (ecuIsHSNewerThanHI ecu) {-# LINE 807 "src/ehc/EHC/CompileUnit.chs" #-} -- | Compilation can actually be done? ecuCanCompile :: EHCompileUnit -> Bool ecuCanCompile ecu = isJust (_ecuMbSrcTime ecu) && _ecuDirIsWritable ecu