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 Data.Typeable
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
data Optim
= Optim
defaultOptim :: Optim
defaultOptim
= Optim
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
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))
, ecuImportUsedModules :: !ImportUsedModules
, _ecuIsTopMod :: !Bool
, ecuHasMain :: !Bool
, ecuNeedsCompile :: !Bool
, _ecuMbSrcTime :: !(Maybe ClockTime)
, _ecuMbHIInfoTime :: !(Maybe ClockTime)
, _ecuMbCoreTime :: !(Maybe ClockTime)
, _ecuMbCoreRunTime :: !(Maybe ClockTime)
, _ecuMbHSSemMod :: !(Maybe AST_HS_Sem_Mod)
, ecuMod :: !Mod
, _ecuMbPrevHIInfo :: !(Maybe AST_HI)
, ecuMbOptim :: !(Maybe Optim)
, _ecuMbHIInfo :: !(Maybe AST_HI)
, _ecuDirIsWritable :: !Bool
, _ecuMbPrevSearchInfo :: !(Maybe PrevSearchInfo)
, ecuMbOpts :: (Maybe EHCOpts)
, ecuTarget :: Target
, ecuPragmas :: !(Set.Set Pragma.Pragma)
, ecuUsedNames :: ModEntRelFilterMp
, ecuSeqNr :: !EHCCompileSeqNr
, ecuGenCodeFiles :: ![FPath]
}
deriving Typeable
mkLabel ''EHCompileUnit
ecuCore = isoMb "ecuMbCore" ecuMbCore
ecuCoreRun = isoMb "ecuMbCoreRun" ecuMbCoreRun
ecuCoreSemMod = isoMb "ecuMbCoreSemMod" ecuMbCoreSemMod
ecuCoreRunSemMod = isoMb "ecuMbCoreRunSemMod" ecuMbCoreRunSemMod
ecuCoreRunSemChk = isoMb "ecuMbCoreRunSemChk" ecuMbCoreRunSemChk
ecuEH = isoMb "ecuMbEH" ecuMbEH
ecuEHSem = isoMb "ecuMbEHSem" ecuMbEHSem
ecuHS = isoMb "ecuMbHS" ecuMbHS
ecuHSSem = isoMb "ecuMbHSSem" ecuMbHSSem
ecuHIInfo = isoMbWithDefault HI.emptyHIInfo ecuMbHIInfo
ecuPrevHIInfo = isoMb "ecuMbPrevHIInfo" ecuMbPrevHIInfo
ecuHSSemMod = isoMb "ecuMbHSSemMod" ecuMbHSSemMod
ecuSrcTime = isoMb "ecuMbSrcTime" ecuMbSrcTime
ecuHIInfoTime = isoMb "ecuMbHIInfoTime" ecuMbHIInfoTime
ecuPrevSearchInfo = isoMb "ecuMbPrevSearchInfo" ecuMbPrevSearchInfo
ecuCoreTime = isoMb "ecuMbCoreTime" ecuMbCoreTime
ecuCoreRunTime = isoMb "ecuMbCoreRunTime" ecuMbCoreRunTime
ecuSrcDeclImpNmS = iumSrcDeclModules . ecuImportUsedModules
ecuHIDeclImpNmS = iumHIDeclModules . ecuImportUsedModules
ecuHIUsedImpNmS = iumHIUsedModules . ecuImportUsedModules
ecuFilePath :: EHCompileUnit -> FPath
ecuFilePath ecu
= maybe (ecuSrcFilePath ecu) id (ecuMbCppFilePath ecu)
ecuIsMainMod :: EHCompileUnit -> Bool
ecuIsMainMod e = _ecuIsTopMod e && ecuHasMain e
ecuAnHIInfo :: EHCompileUnit -> AST_HI
ecuAnHIInfo e
= case _ecuMbPrevHIInfo e of
Just pi | HI.hiiIsEmpty hii
-> pi
_ -> hii
where hii = e ^. ecuHIInfo
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 = []
}
ecuImpNmS :: EHCompileUnit -> Set.Set HsName
ecuImpNmS ecu =
Set.delete (ecuModNm ecu) $ Set.unions [ ecuSrcDeclImpNmS ecu, ecuHIDeclImpNmS ecu, ecuHIUsedImpNmS ecu ]
ecuImpNmL :: EHCompileUnit -> [HsName]
ecuImpNmL = Set.toList . ecuImpNmS
ecuTransClosedUsedModMp :: EHCompileUnit -> HI.HIInfoUsedModMp
ecuTransClosedUsedModMp = HI.hiiTransClosedUsedModMp . ecuAnHIInfo
ecuTransClosedOrphanModS :: EHCompileUnit -> Set.Set HsName
ecuTransClosedOrphanModS = HI.hiiTransClosedOrphanModS . ecuAnHIInfo
ecuIsOrphan :: EHCompileUnit -> Bool
ecuIsOrphan = isJust . HI.hiiMbOrphan . ecuAnHIInfo
ecuHasAlreadyFlowedWith :: ASTType -> ASTAlreadyFlowIntoCRSIInfo -> EHCompileUnit -> Bool
ecuHasAlreadyFlowedWith asttype flowstage ecu
= case Map.lookup asttype (ecu ^. ecuAlreadyFlowIntoCRSI) of
Just s -> Set.member flowstage s
_ -> False
ecuHasAlreadyFlowed :: ASTType -> ASTSemFlowStage -> EHCompileUnit -> Bool
ecuHasAlreadyFlowed asttype flowstage ecu = ecuHasAlreadyFlowedWith asttype (flowstage,Nothing) ecu
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)
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
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
instance FileLocatable EHCompileUnit FileLoc where
fileLocation = ecuFileLocation
noFileLocation = emptyFileLoc
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 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)
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
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 }
ecuStoreCoreSemMod :: EcuUpdater AST_Core_Sem_Check
ecuStoreCoreSemMod x ecu = ecu { _ecuMbCoreSemMod = Just x }
ecuStoreCore :: EcuUpdater AST_Core
ecuStoreCore x ecu | x `seq` True = ecu { _ecuMbCore = Just x }
ecuStoreCoreRun :: EcuUpdater AST_CoreRun
ecuStoreCoreRun x ecu | x `seq` True = ecu { _ecuMbCoreRun = Just x }
ecuStoreCoreRunSemMod :: EcuUpdater AST_CoreRun_Sem_Mod
ecuStoreCoreRunSemMod x ecu = ecu { _ecuMbCoreRunSemMod = Just x }
ecuStoreCore2CoreRunSem :: EcuUpdater AST_Core_Sem_ToCoreRun
ecuStoreCore2CoreRunSem x ecu = ecu { _ecuMbCore2CoreRunSem = Just x }
ecuStoreSrcTime :: EcuUpdater ClockTime
ecuStoreSrcTime x ecu = ecu { _ecuMbSrcTime = 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 }
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 }
ecuStoreCoreTime :: EcuUpdater ClockTime
ecuStoreCoreTime x ecu = ecu { _ecuMbCoreTime = Just x }
ecuStoreCoreRunTime :: EcuUpdater ClockTime
ecuStoreCoreRunTime x ecu = ecu { _ecuMbCoreRunTime = Just x }
ecuStoreDirIsWritable :: EcuUpdater Bool
ecuStoreDirIsWritable x ecu = ecu { _ecuDirIsWritable = x }
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 }
ecuStoreGenCodeFiles :: EcuUpdater [FPath]
ecuStoreGenCodeFiles x ecu = ecu { ecuGenCodeFiles = x }
ecuStoreSeqNr :: EcuUpdater EHCCompileSeqNr
ecuStoreSeqNr x ecu = ecu { ecuSeqNr = x }
ecuStoreCppFilePath :: EcuUpdater FPath
ecuStoreCppFilePath x ecu = ecu { ecuMbCppFilePath = Just x }
ecuSrcHasSuffix :: String -> EHCompileUnit -> Bool
ecuSrcHasSuffix suff ecu
= maybe False (==suff') $ fpathMbSuff $ ecuSrcFilePath ecu
where suff' = case suff of {('.':s) -> s; _ -> suff}
ecuIsHSNewerThanHI :: EHCompileUnit -> Bool
ecuIsHSNewerThanHI ecu
= case (_ecuMbSrcTime ecu,_ecuMbHIInfoTime ecu) of
(Just ths,Just thi) -> ths `diffClockTimes` thi > noTimeDiff
(Nothing ,Just thi) -> False
_ -> True
ecuIsValidHIInfo :: EHCompileUnit -> Bool
ecuIsValidHIInfo ecu
= case _ecuMbPrevHIInfo ecu of
Just i -> HI.hiiValidity i == HI.HIValidity_Ok
_ -> False
ecuCanUseHIInsteadOfHS :: EHCompileUnit -> Bool
ecuCanUseHIInsteadOfHS ecu
= ecuIsValidHIInfo ecu && not (ecuIsHSNewerThanHI ecu)
ecuCanCompile :: EHCompileUnit -> Bool
ecuCanCompile ecu = isJust (_ecuMbSrcTime ecu) && _ecuDirIsWritable ecu