module UHC.Light.Compiler.EHC.CompileUnit ( EHCompileUnit (..) , ecuFilePath , emptyECU , ecuFinalDestinationState , EcuUpdater, ecuStoreSrcFilePath, ecuStoreState, ecuStoreHS, ecuStoreEH, ecuStoreHSSem, ecuStoreEHSem , ecuStoreCoreSemMod , ecuStoreCoreSem , ecuStoreCore , Optim (..), defaultOptim , ecuHSDeclImpNmS, ecuHIDeclImpNmS, ecuHIUsedImpNmS , ecuIsMainMod , ecuImpNmS, ecuImpNmL , ecuTransClosedUsedModMp, ecuTransClosedOrphanModS , ecuIsOrphan , ecuStoreHSDeclImpS, ecuSetNeedsCompile, ecuStoreHIUsedImpS, ecuStoreHIInfoTime, ecuStoreSrcTime, ecuStoreHSSemMod, ecuStoreIntrodModS, ecuStoreHIDeclImpS, ecuStoreMod, ecuSetIsTopMod, ecuSetHasMain, ecuStoreOptim, ecuStoreHIInfo, ecuStorePrevHIInfo , ecuStoreCoreTime , ecuStoreDirIsWritable , ecuIsHSNewerThanHI , ecuIsValidHIInfo , ecuCanUseHIInsteadOfHS , 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 qualified UHC.Light.Compiler.HS as HS import qualified UHC.Light.Compiler.EH as EH import qualified UHC.Light.Compiler.Core as Core import qualified UHC.Light.Compiler.EH.MainAG as EHSem import qualified UHC.Light.Compiler.HS.MainAG as HSSem import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem import qualified UHC.Light.Compiler.HI as HI import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod 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 92 "src/ehc/EHC/CompileUnit.chs" #-} data Optim = Optim defaultOptim :: Optim defaultOptim = Optim {-# LINE 115 "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 137 "src/ehc/EHC/CompileUnit.chs" #-} data EHCompileUnit = EHCompileUnit { ecuSrcFilePath :: !FPath , ecuMbCppFilePath :: !(Maybe FPath) , ecuFileLocation :: !FileLoc , ecuGrpNm :: !HsName , ecuModNm :: !HsName , ecuMbHS :: !(Maybe HS.AGItf) , ecuMbHSSem :: !(Maybe HSSem.Syn_AGItf) , ecuMbEH :: !(Maybe EH.AGItf) , ecuMbEHSem :: !(Maybe EHSem.Syn_AGItf) , ecuMbCore :: !(Maybe Core.CModule) , ecuMbCoreSem :: !(Maybe Core2GrSem.Syn_CodeAGItf) , ecuMbCoreSemMod :: !(Maybe Core2ChkSem.Syn_CodeAGItf) , ecuState :: !EHCompileUnitState , 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 , ecuMbHSSemMod :: !(Maybe HSSemMod.Syn_AGItf) , ecuMod :: !Mod -- import/export info of module , ecuMbPrevHIInfo :: !(Maybe HI.HIInfo) -- possible HI info of previous run , ecuMbOptim :: !(Maybe Optim) , ecuHIInfo :: !HI.HIInfo -- HI info of module , ecuDirIsWritable :: !Bool -- can be written in dir of module? , 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 } {-# LINE 211 "src/ehc/EHC/CompileUnit.chs" #-} ecuHSDeclImpNmS = iumHSDeclModules . ecuImportUsedModules ecuHIDeclImpNmS = iumHIDeclModules . ecuImportUsedModules ecuHIUsedImpNmS = iumHIUsedModules . ecuImportUsedModules {-# LINE 217 "src/ehc/EHC/CompileUnit.chs" #-} ecuFilePath :: EHCompileUnit -> FPath ecuFilePath ecu = maybe (ecuSrcFilePath ecu) id (ecuMbCppFilePath ecu) {-# LINE 227 "src/ehc/EHC/CompileUnit.chs" #-} ecuIsMainMod :: EHCompileUnit -> Bool ecuIsMainMod e = ecuIsTopMod e && ecuHasMain e {-# LINE 232 "src/ehc/EHC/CompileUnit.chs" #-} -- | give the current value HIInfo, or the previous one ecuAnHIInfo :: EHCompileUnit -> HI.HIInfo ecuAnHIInfo e = case ecuMbPrevHIInfo e of Just pi | HI.hiiIsEmpty hii -> pi _ -> hii where hii = ecuHIInfo e {-# LINE 243 "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 , ecuMbCore = Nothing , ecuMbCoreSem = Nothing , ecuMbCoreSemMod = Nothing , ecuState = ECUS_Unknown , ecuImportUsedModules = emptyImportUsedModules , ecuIsTopMod = False , ecuHasMain = False , ecuNeedsCompile = True , ecuMbSrcTime = Nothing , ecuMbHIInfoTime = Nothing , ecuMbCoreTime = Nothing , ecuMbHSSemMod = Nothing , ecuMod = emptyMod , ecuMbPrevHIInfo = Nothing , ecuMbOptim = Nothing , ecuHIInfo = HI.emptyHIInfo , ecuDirIsWritable = False , ecuMbOpts = Nothing , ecuTarget = defaultTarget , ecuPragmas = Set.empty , ecuUsedNames = Map.empty , ecuSeqNr = zeroEHCCompileSeqNr , ecuGenCodeFiles = [] } {-# LINE 321 "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 [ ecuHSDeclImpNmS ecu, ecuHIDeclImpNmS ecu, ecuHIUsedImpNmS ecu ] ecuImpNmL :: EHCompileUnit -> [HsName] ecuImpNmL = Set.toList . ecuImpNmS -- ecu = (nub $ ecuHSDeclImpNmL ecu ++ ecuHIDeclImpNmL ecu ++ ecuHIUsedImpNmL ecu) \\ [ecuModNm ecu] {-# LINE 330 "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 340 "src/ehc/EHC/CompileUnit.chs" #-} -- | Is orphan, according to .hi info ecuIsOrphan :: EHCompileUnit -> Bool ecuIsOrphan = isJust . HI.hiiMbOrphan . ecuAnHIInfo {-# LINE 360 "src/ehc/EHC/CompileUnit.chs" #-} instance CompileUnitState EHCompileUnitState where cusDefault = ECUS_Eh EHStart cusUnk = ECUS_Unknown cusIsUnk = (==ECUS_Unknown) {-# LINE 369 "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 _ -> False {-# LINE 385 "src/ehc/EHC/CompileUnit.chs" #-} instance FileLocatable EHCompileUnit FileLoc where fileLocation = ecuFileLocation noFileLocation = emptyFileLoc {-# LINE 391 "src/ehc/EHC/CompileUnit.chs" #-} instance CompileUnit EHCompileUnit HsName FileLoc EHCompileUnitState where cuDefault = emptyECU cuFPath = ecuFilePath cuLocation = fileLocation cuKey = ecuModNm cuState = ecuState cuUpdFPath = ecuStoreSrcFilePath cuUpdLocation = ecuStoreFileLocation cuUpdState = ecuStoreState 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 437 "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 454 "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 HS.AGItf ecuStoreHS x ecu = ecu { ecuMbHS = Just x } ecuStoreEH :: EcuUpdater EH.AGItf ecuStoreEH x ecu = ecu { ecuMbEH = Just x } ecuStoreHSSem :: EcuUpdater HSSem.Syn_AGItf ecuStoreHSSem x ecu = ecu { ecuMbHSSem = Just x } ecuStoreEHSem :: EcuUpdater EHSem.Syn_AGItf ecuStoreEHSem x ecu = ecu { ecuMbEHSem = Just x } {-# LINE 479 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreSemMod :: EcuUpdater Core2ChkSem.Syn_CodeAGItf ecuStoreCoreSemMod x ecu = ecu { ecuMbCoreSemMod = Just x } {-# LINE 484 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreSem :: EcuUpdater Core2GrSem.Syn_CodeAGItf ecuStoreCoreSem x ecu = ecu { ecuMbCoreSem = Just x } {-# LINE 489 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCore :: EcuUpdater Core.CModule ecuStoreCore x ecu | x `seq` True = ecu { ecuMbCore = Just x } {-# LINE 546 "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 HSSemMod.Syn_AGItf ecuStoreHSSemMod x ecu = ecu { ecuMbHSSemMod = Just x } ecuStoreHSDeclImpS :: EcuUpdater (Set.Set HsName) ecuStoreHSDeclImpS x ecu = ecu { ecuImportUsedModules = ium {iumHSDeclModules = 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 HI.HIInfo ecuStorePrevHIInfo x ecu = ecu { ecuMbPrevHIInfo = Just x } ecuStoreOptim :: EcuUpdater Optim ecuStoreOptim x ecu = ecu { ecuMbOptim = Just x } ecuStoreHIInfo :: EcuUpdater HI.HIInfo ecuStoreHIInfo x ecu | x `seq` True = ecu { ecuHIInfo = x } {-# LINE 609 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreTime :: EcuUpdater ClockTime ecuStoreCoreTime x ecu = ecu { ecuMbCoreTime = Just x } {-# LINE 619 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreDirIsWritable :: EcuUpdater Bool ecuStoreDirIsWritable x ecu = ecu { ecuDirIsWritable = x } {-# LINE 624 "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 638 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreGenCodeFiles :: EcuUpdater [FPath] ecuStoreGenCodeFiles x ecu = ecu { ecuGenCodeFiles = x } {-# LINE 643 "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 655 "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 674 "src/ehc/EHC/CompileUnit.chs" #-} ecuIsValidHIInfo :: EHCompileUnit -> Bool ecuIsValidHIInfo ecu = case ecuMbPrevHIInfo ecu of Just i -> HI.hiiValidity i == HI.HIValidity_Ok _ -> False {-# LINE 682 "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)