module UHC.Light.Compiler.EHC.CompileUnit ( EHCompileUnit (..) , ecuFilePath , emptyECU , ecuFinalDestinationState , EcuUpdater, ecuStoreSrcFilePath, ecuStoreState, ecuStoreHS, ecuStoreEH, ecuStoreHSSem, ecuStoreEHSem , ecuStoreCoreSemMod , ecuStoreCoreSem , ecuStoreCore , ecuStoreCoreRun , ecuStoreCoreRunSemMod , ecuStoreCore2CoreRunSem , ecuSrcHasSuffix , 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 , ecuStoreCoreRunTime , 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.CoreRun as CoreRun 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.ToCoreRun as Core2CoreRunSem import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem import qualified UHC.Light.Compiler.CoreRun.Check as CoreRun2ChkSem 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 99 "src/ehc/EHC/CompileUnit.chs" #-} data Optim = Optim defaultOptim :: Optim defaultOptim = Optim {-# LINE 122 "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 144 "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) , ecuMbCore2CoreRunSem :: !(Maybe Core2CoreRunSem.Syn_CodeAGItf) , ecuMbCoreSemMod :: !(Maybe Core2ChkSem.Syn_CodeAGItf) , ecuMbCoreRun :: !(Maybe CoreRun.Mod) , ecuMbCoreRunSemMod :: !(Maybe CoreRun2ChkSem.Syn_AGItf) , 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 , ecuMbCoreRunTime :: !(Maybe ClockTime) -- timestamp of possibly previously generated corerun 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 230 "src/ehc/EHC/CompileUnit.chs" #-} ecuHSDeclImpNmS = iumHSDeclModules . ecuImportUsedModules ecuHIDeclImpNmS = iumHIDeclModules . ecuImportUsedModules ecuHIUsedImpNmS = iumHIUsedModules . ecuImportUsedModules {-# LINE 236 "src/ehc/EHC/CompileUnit.chs" #-} ecuFilePath :: EHCompileUnit -> FPath ecuFilePath ecu = maybe (ecuSrcFilePath ecu) id (ecuMbCppFilePath ecu) {-# LINE 246 "src/ehc/EHC/CompileUnit.chs" #-} ecuIsMainMod :: EHCompileUnit -> Bool ecuIsMainMod e = ecuIsTopMod e && ecuHasMain e {-# LINE 251 "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 262 "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 , ecuMbCore2CoreRunSem = Nothing , ecuMbCoreSemMod = Nothing , ecuMbCoreRun = Nothing , ecuMbCoreRunSemMod = Nothing , ecuState = ECUS_Unknown , ecuImportUsedModules = emptyImportUsedModules , ecuIsTopMod = False , ecuHasMain = False , ecuNeedsCompile = True , ecuMbSrcTime = Nothing , ecuMbHIInfoTime = Nothing , ecuMbCoreTime = Nothing , ecuMbCoreRunTime = 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 352 "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 361 "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 371 "src/ehc/EHC/CompileUnit.chs" #-} -- | Is orphan, according to .hi info ecuIsOrphan :: EHCompileUnit -> Bool ecuIsOrphan = isJust . HI.hiiMbOrphan . ecuAnHIInfo {-# LINE 391 "src/ehc/EHC/CompileUnit.chs" #-} instance CompileUnitState EHCompileUnitState where cusDefault = ECUS_Eh EHStart cusUnk = ECUS_Unknown cusIsUnk = (==ECUS_Unknown) {-# LINE 400 "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 419 "src/ehc/EHC/CompileUnit.chs" #-} instance FileLocatable EHCompileUnit FileLoc where fileLocation = ecuFileLocation noFileLocation = emptyFileLoc {-# LINE 425 "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 471 "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 488 "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 513 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreSemMod :: EcuUpdater Core2ChkSem.Syn_CodeAGItf ecuStoreCoreSemMod x ecu = ecu { ecuMbCoreSemMod = Just x } {-# LINE 518 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreSem :: EcuUpdater Core2GrSem.Syn_CodeAGItf ecuStoreCoreSem x ecu = ecu { ecuMbCoreSem = Just x } {-# LINE 523 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCore :: EcuUpdater Core.CModule ecuStoreCore x ecu | x `seq` True = ecu { ecuMbCore = Just x } {-# LINE 534 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreRun :: EcuUpdater CoreRun.Mod ecuStoreCoreRun x ecu | x `seq` True = ecu { ecuMbCoreRun = Just x } {-# LINE 539 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreRunSemMod :: EcuUpdater CoreRun2ChkSem.Syn_AGItf ecuStoreCoreRunSemMod x ecu = ecu { ecuMbCoreRunSemMod = Just x } {-# LINE 544 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCore2CoreRunSem :: EcuUpdater Core2CoreRunSem.Syn_CodeAGItf ecuStoreCore2CoreRunSem x ecu = ecu { ecuMbCore2CoreRunSem = Just x } {-# LINE 595 "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 658 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreTime :: EcuUpdater ClockTime ecuStoreCoreTime x ecu = ecu { ecuMbCoreTime = Just x } {-# LINE 663 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreCoreRunTime :: EcuUpdater ClockTime ecuStoreCoreRunTime x ecu = ecu { ecuMbCoreRunTime = Just x } {-# LINE 673 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreDirIsWritable :: EcuUpdater Bool ecuStoreDirIsWritable x ecu = ecu { ecuDirIsWritable = x } {-# LINE 678 "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 692 "src/ehc/EHC/CompileUnit.chs" #-} ecuStoreGenCodeFiles :: EcuUpdater [FPath] ecuStoreGenCodeFiles x ecu = ecu { ecuGenCodeFiles = x } {-# LINE 697 "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 709 "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 717 "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 736 "src/ehc/EHC/CompileUnit.chs" #-} ecuIsValidHIInfo :: EHCompileUnit -> Bool ecuIsValidHIInfo ecu = case ecuMbPrevHIInfo ecu of Just i -> HI.hiiValidity i == HI.HIValidity_Ok _ -> False {-# LINE 744 "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)