module UHC.Light.Compiler.EHC.CompileUnit
( EHCompileUnit (..)
, ecuASTType, ecuASTFileContent, ecuASTFileUse
, ecuMbCore, ecuCore, ecuMbCoreSem, ecuCoreSem
, ecuMbCore2CoreRunSem, ecuMbCoreRun, ecuCoreRun
, ecuMbCoreSemMod, ecuCoreSemMod
, ecuMbCoreRunSemMod, ecuCoreRunSemMod
, ecuMbHS, ecuHS, ecuMbHSSem, ecuHSSem, ecuMbEH, ecuEH, ecuMbEHSem, ecuEHSem
, ecuFilePath
, emptyECU
, ecuFinalDestinationState
, EcuUpdater, ecuStoreSrcFilePath, ecuStoreState, ecuStoreHS, ecuStoreEH, ecuStoreHSSem, ecuStoreEHSem
, ecuStoreCoreSemMod
, ecuStoreCoreSem
, ecuStoreCore
, ecuStoreCoreRun
, ecuStoreCoreRunSemMod
, ecuStoreCore2CoreRunSem
, ecuSrcHasSuffix
, Optim (..), defaultOptim
, ecuMbCoreTime, ecuCoreTime
, ecuMbCoreRunTime, ecuCoreRunTime
, ecuMbHIInfo, ecuHIInfo, ecuMbPrevHIInfo, ecuPrevHIInfo, ecuMbHSSemMod, ecuHSSemMod, ecuMbSrcTime, ecuSrcTime, ecuMbHIInfoTime, ecuHIInfoTime
, 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
, ecuCanCompile
, EHCCompileSeqNr (..)
, ecuMbPrevSearchInfo, ecuPrevSearchInfo
, 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 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
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)
, _ecuMbPrevSearchInfo :: !(Maybe PrevSearchInfo)
, 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
, _ecuASTType :: !ASTType
, _ecuASTFileContent :: !ASTFileContent
, _ecuASTFileUse :: !ASTFileUse
, ecuImportUsedModules :: !ImportUsedModules
, ecuIsTopMod :: !Bool
, ecuHasMain :: !Bool
, ecuNeedsCompile :: !Bool
, _ecuMbSrcTime :: !(Maybe ClockTime)
, _ecuMbHIInfoTime :: !(Maybe ClockTime)
, _ecuMbCoreTime :: !(Maybe ClockTime)
, _ecuMbCoreRunTime :: !(Maybe ClockTime)
, _ecuMbHSSemMod :: !(Maybe HSSemMod.Syn_AGItf)
, ecuMod :: !Mod
, _ecuMbPrevHIInfo :: !(Maybe HI.HIInfo)
, ecuMbOptim :: !(Maybe Optim)
, _ecuMbHIInfo :: !(Maybe HI.HIInfo)
, ecuDirIsWritable :: !Bool
, ecuMbOpts :: (Maybe EHCOpts)
, ecuTarget :: Target
, ecuPragmas :: !(Set.Set Pragma.Pragma)
, ecuUsedNames :: ModEntRelFilterMp
, ecuSeqNr :: !EHCCompileSeqNr
, ecuGenCodeFiles :: ![FPath]
}
deriving Typeable
mkLabel ''EHCompileUnit
ecuCore = isoMb "ecuMbCore" ecuMbCore
ecuCoreSem = isoMb "ecuMbCoreSem" ecuMbCoreSem
ecuCoreTime = isoMb "ecuMbCoreTime" ecuMbCoreTime
ecuCoreRun = isoMb "ecuMbCoreRun" ecuMbCoreRun
ecuCoreRunTime = isoMb "ecuMbCoreRunTime" ecuMbCoreRunTime
ecuCoreSemMod = isoMb "ecuMbCoreSemMod" ecuMbCoreSemMod
ecuCoreRunSemMod = isoMb "ecuMbCoreRunSemMod" ecuMbCoreRunSemMod
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
ecuHSDeclImpNmS = iumHSDeclModules . 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 -> HI.HIInfo
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
, _ecuMbPrevSearchInfo = 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
, _ecuASTType = ASTType_Unknown
, _ecuASTFileContent = ASTFileContent_Unknown
, _ecuASTFileUse = ASTFileUse_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
, _ecuMbHIInfo = Nothing
, ecuDirIsWritable = False
, 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 [ ecuHSDeclImpNmS 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
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 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 }
ecuStoreCoreSemMod :: EcuUpdater Core2ChkSem.Syn_CodeAGItf
ecuStoreCoreSemMod x ecu = ecu { _ecuMbCoreSemMod = Just x }
ecuStoreCoreSem :: EcuUpdater Core2GrSem.Syn_CodeAGItf
ecuStoreCoreSem x ecu = ecu { _ecuMbCoreSem = Just x }
ecuStoreCore :: EcuUpdater Core.CModule
ecuStoreCore x ecu | x `seq` True = ecu { _ecuMbCore = Just x }
ecuStoreCoreRun :: EcuUpdater CoreRun.Mod
ecuStoreCoreRun x ecu | x `seq` True = ecu { _ecuMbCoreRun = Just x }
ecuStoreCoreRunSemMod :: EcuUpdater CoreRun2ChkSem.Syn_AGItf
ecuStoreCoreRunSemMod x ecu = ecu { _ecuMbCoreRunSemMod = Just x }
ecuStoreCore2CoreRunSem :: EcuUpdater Core2CoreRunSem.Syn_CodeAGItf
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 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 }
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 { _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