module UHC.Light.Compiler.EHC.CompileRun.Base
( module UHC.Light.Compiler.CodeGen.CEnv
, BuildGlobal (..)
, BFun' (..)
, BFun (..)
, BFunCacheEntry (..)
, BCache (..), emptyBCache
, bcacheResolveModNm
, BRef (..)
, ASTResult (..)
, mkASTResult'
, mkASTResult
, BState, emptyBState
, EHCompileRunCoreRunStateInfo (..), emptyEHCompileRunCoreRunStateInfo
, EHCompileRunStateInfo (..)
, emptyEHCompileRunStateInfo
, EHCCompileRunner
, EHCompileRun, EHCompilePhaseT, EHCompilePhase
, TmOfRes (..), emptyTmOfRes
, bcacheCache, bcacheDpdRel, bcacheModNmForward
, bstateCache, bstateCallStack
, crcrsiReqdModules, crcrsiNm2RefMp
, crsiOpts, crsiASTPipe, crsiNextUID, crsiHereUID, crsiHSInh, crsiEHInh, crsiBState, crsiFileSuffMp
, crsiCEnv
, crsiCoreRunState
, astresAST, astresRef, astresPipe
, tmofresChoice, tmofresIsOverr, tmofresHasMain
, crBaseInfo, crMbBaseInfo, crBaseInfo'
, cpStepUID, cpSetUID
, cpTrPP, cpTr
, cpMsg, cpMsg'
, cpSystem', cpSystem
, cpSystemRaw
, bUpdAlreadyFlowIntoCRSIWith, bUpdAlreadyFlowIntoCRSI
, bLookupECUInCR, bLookupECU', bLookupECU, bUpdECU
, TmOfResMb, TmOfResM, updTmChoice, updTmChoiceM
, TmOfDelayedRes (..), emptyTmOfDelayedRes
, astresTimeStamp
, tmofdresModNm, tmofdresHasMain, tmofdresImpMp
, tmofresDelayed, tmofresTm
, crsiExpNmOffMpDbg, crsiExpNmOffMp
, EHCIOInfo (..)
, EHCTime
, EHCTimeDiff, getEHCTime, ehcTimeDiff, ehcTimeDiffFmt
, cpRegisterFilesToRm
, cpRmFilesToRm
, crPartitionIntoPkgAndOthers )
where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.IntMap as IMap
import Data.Maybe
import Data.Typeable
import GHC.Generics (Generic)
import qualified UHC.Util.RelMap as Rel
import UHC.Util.Hashable
import Control.Exception as CE
import UHC.Util.Lens
import Data.Functor.Identity
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.Base.Trace
import UHC.Light.Compiler.EHC.FileSuffMp
import UHC.Light.Compiler.Base.Optimize
import Control.Monad.State hiding (get)
import qualified Control.Monad.State as MS
import Control.Applicative
import UHC.Util.Error
import Control.Monad.Fix
import System.IO
import System.Exit
import System.Environment
import System.Process
import UHC.Light.Compiler.EHC.CompileUnit
import qualified UHC.Light.Compiler.CoreRun as CoreRun
import UHC.Light.Compiler.CodeGen.ValAccess as VA
import UHC.Light.Compiler.CodeGen.CEnv
import UHC.Light.Compiler.EHC.CompileGroup
import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod
import UHC.Light.Compiler.CodeGen.ModuleImportExportImpl
import UHC.Light.Compiler.Module.ImportExport
import UHC.Util.Time
import System.CPUTime
import System.Locale
import Data.IORef
import System.IO.Unsafe
import System.Directory
import UHC.Util.FPath
import UHC.Util.Time
import System.CPUTime
import System.Locale
import Data.IORef
import System.IO.Unsafe
import UHC.Light.Compiler.Base.PackageDatabase
import qualified UHC.Light.Compiler.Base.Pragma as Pragma
data BuildGlobal =
BuildGlobal
{ _bglobPipe :: ASTPipe
}
deriving (Eq, Ord, Typeable, Generic)
instance Hashable BuildGlobal
instance Show BuildGlobal where
show (BuildGlobal p) = "Glob(" ++ show p ++ ")"
instance PP BuildGlobal where
pp (BuildGlobal p) = "Glob" >#< p
data BFun' m res where
CRSI
:: BFun' m (EHCompileRunStateInfo m)
CRSIWithCompileOrderPl
:: !BuildGlobal
-> ![[HsName]]
-> !ASTBuildPlan
-> BFun' m (EHCompileRunStateInfo m)
CRSIWithImpsPl
:: !BuildGlobal
-> !PrevFileSearchKey
-> !(Set.Set HsName)
-> !ASTBuildPlan
-> BFun' m (EHCompileRunStateInfo m)
CRSIOfNameP
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTPipe
-> BFun' m (EHCompileRunStateInfo m)
CRSIOfNamePl
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m (EHCompileRunStateInfo m)
FPathSearchForFile
:: !String
-> !FilePath
-> BFun' m (HsName, FPath)
FPathForAST
:: !PrevFileSearchKey
-> !ASTType
-> !ASTSuffixKey
-> !ASTFileTiming
-> BFun' m (FPath, ASTFileSuffOverride, EHCompileUnit)
ImportsOfNamePl
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m (HsName, Set.Set HsName)
ImportsRecursiveWithImpsP
:: !BuildGlobal
-> !(Maybe PrevSearchInfo)
-> !(Set.Set HsName)
-> !ASTPipe
-> BFun' m
( Map.Map HsName (Set.Set HsName)
)
ImportsRecursiveOfNameP
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTPipe
-> BFun' m
( HsName
, Set.Set HsName
, Map.Map HsName (Set.Set HsName)
)
EcuOf
:: !HsName
-> BFun' m EHCompileUnit
EcuOfPrevNameAndPath
:: !PrevFileSearchKey
-> BFun' m EHCompileUnit
EHCOptsOf
:: !PrevFileSearchKey
-> BFun' m EHCOpts
ActualModNm
:: !PrevFileSearchKey
-> BFun' m HsName
BuildPlanPMb
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTPipe
-> BFun' m (Maybe ASTBuildPlan)
ASTBuildPlanChoicePMb
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTPipe
-> BFun' m (Maybe (TmOfRes m))
ASTRefFromFileEither
:: Typeable ast
=> !PrevFileSearchKey
-> !Bool
-> !(AlwaysEq ASTFileTimeHandleHow)
-> !ASTType
-> !ASTSuffixKey
-> !ASTFileTiming
-> BFun' m (Either (String,[Err]) (BRef m ast))
ASTFromFile
:: !PrevFileSearchKey
-> !(AlwaysEq ASTFileTimeHandleHow)
-> !ASTType
-> !ASTSuffixKey
-> !ASTFileTiming
-> BFun' m res
ASTP
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTPipe
-> BFun' m res
ASTPMb
:: Typeable ast
=> !BuildGlobal
-> !PrevFileSearchKey
-> !ASTPipe
-> BFun' m (Maybe (ASTResult m ast))
ASTPlMb
:: Typeable ast
=> !BuildGlobal
-> !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m (Maybe (ASTResult m ast))
ModfTimeOfFile
:: !PrevFileSearchKey
-> !ASTType
-> !ASTSuffixKey
-> !ASTFileTiming
-> BFun' m
(Maybe
( ClockTime
, FPath
) )
ASTFileIsValid
:: !PrevFileSearchKey
-> !ASTType
-> !ASTSuffixKey
-> !ASTFileTiming
-> BFun' m Bool
ASTFileIsNewerThan
:: !(PrevFileSearchKey
,ASTType
,ASTSuffixKey
,ASTFileTiming
)
-> !(PrevFileSearchKey
,ASTType
,ASTSuffixKey
,ASTFileTiming
)
-> BFun' m (Maybe Bool)
DirOfModIsWriteable
:: !PrevFileSearchKey
-> BFun' m Bool
CanCompile
:: !PrevFileSearchKey
-> BFun' m Bool
IsTopMod
:: !PrevFileSearchKey
-> BFun' m Bool
HasMain
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTPipe
-> BFun' m Bool
FoldHsMod
:: !PrevFileSearchKey
-> !(Maybe [PkgModulePartition])
-> BFun' m
( AST_HS_Sem_Mod
, Bool
, Set.Set Pragma.Pragma
, Maybe EHCOpts
)
ModnameAndImportsPlMb
:: !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m
( Maybe
( HsName
, Set.Set HsName
, Maybe PrevSearchInfo
, Bool
) )
HsModnameAndImports
:: !PrevFileSearchKey
-> BFun' m
( HsName
, Set.Set HsName
, Maybe PrevSearchInfo
, Bool
)
FoldHIInfo
:: !PrevFileSearchKey
-> BFun' m
( AST_HI
, Set.Set HsName
, Set.Set HsName
, Bool
)
ImportNameInfo
:: !PrevFileSearchKey
-> OptimizationScope
-> BFun' m [HsName]
ImportExportImpl
:: !PrevFileSearchKey
-> OptimizationScope
-> BFun' m ModuleImportExportImpl
FoldHsPMb
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTPipe
-> BFun' m
( Maybe
( AST_HS_Sem_Check
, Bool
) )
FoldHsPlMb
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m
( Maybe
( AST_HS_Sem_Check
, Bool
) )
FoldEHPMb
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTPipe
-> BFun' m
( Maybe
( AST_EH_Sem_Check
) )
FoldEHPlMb
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m
( Maybe
( AST_EH_Sem_Check
) )
FoldCoreModPlMb
:: !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m
( Maybe
( AST_Core_Sem_Check
, HsName
, Set.Set HsName
, Mod
, Bool
, Maybe PrevSearchInfo
) )
FoldCore2CoreRunPlMb
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m
( Maybe
( AST_Core_Sem_ToCoreRun
) )
FoldCoreRunModPlMb
:: !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m
( Maybe
( AST_CoreRun_Sem_Mod
, HsName
, Set.Set HsName
, Mod
, Bool
, Maybe PrevSearchInfo
) )
FoldCoreRunCheckPlMb
:: !BuildGlobal
-> !PrevFileSearchKey
-> !ASTBuildPlan
-> BFun' m
( Maybe
( AST_CoreRun_Sem_Check
, AST_CoreRun
) )
FPathPreprocessedWithCPP
:: [PkgModulePartition]
-> !PrevFileSearchKey
-> BFun' m FPath
ExposedPackages
:: BFun' m [PkgModulePartition]
bfunCompare :: BFun' m res1 -> BFun' m res2 -> Ordering
bfunCompare f1 f2 = case (f1,f2) of
(CRSI , CRSI ) -> EQ
(CRSIWithCompileOrderPl a1 b1 c1 , CRSIWithCompileOrderPl a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(CRSIWithImpsPl a1 b1 c1 d1 , CRSIWithImpsPl a2 b2 c2 d2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2, d1 `compare` d2]
(CRSIOfNameP a1 b1 c1 , CRSIOfNameP a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(CRSIOfNamePl a1 b1 c1 , CRSIOfNamePl a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(FPathSearchForFile a1 b1 , FPathSearchForFile a2 b2 ) -> lexico [a1 `compare` a2, b1 `compare` b2]
(FPathForAST a1 b1 c1 d1 , FPathForAST a2 b2 c2 d2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2, d1 `compare` d2]
(ImportsOfNamePl a1 b1 c1 , ImportsOfNamePl a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(ImportsRecursiveWithImpsP a1 b1 c1 d1 , ImportsRecursiveWithImpsP a2 b2 c2 d2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2, d1 `compare` d2]
(ImportsRecursiveOfNameP a1 b1 c1 , ImportsRecursiveOfNameP a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(ActualModNm a1 , ActualModNm a2 ) -> a1 `compare` a2
(BuildPlanPMb a1 b1 c1 , BuildPlanPMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(ASTBuildPlanChoicePMb a1 b1 c1 , ASTBuildPlanChoicePMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(EcuOf a1 , EcuOf a2 ) -> a1 `compare` a2
(EcuOfPrevNameAndPath a1 , EcuOfPrevNameAndPath a2 ) -> a1 `compare` a2
(EHCOptsOf a1 , EHCOptsOf a2 ) -> a1 `compare` a2
(ASTRefFromFileEither a1 b1 c1 d1 e1 f1 , ASTRefFromFileEither a2 b2 c2 d2 e2 f2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2, d1 `compare` d2, e1 `compare` e2, f1 `compare` f2]
(ASTFromFile a1 b1 c1 d1 e1 , ASTFromFile a2 b2 c2 d2 e2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2, d1 `compare` d2, e1 `compare` e2]
(ASTP a1 b1 c1 , ASTP a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(ASTPMb a1 b1 c1 , ASTPMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(ASTPlMb a1 b1 c1 , ASTPlMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(ModfTimeOfFile a1 b1 c1 d1 , ModfTimeOfFile a2 b2 c2 d2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2, d1 `compare` d2]
(ASTFileIsValid a1 b1 c1 d1 , ASTFileIsValid a2 b2 c2 d2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2, d1 `compare` d2]
(ASTFileIsNewerThan a1 b1 , ASTFileIsNewerThan a2 b2 ) -> lexico [a1 `compare` a2, b1 `compare` b2]
(DirOfModIsWriteable a1 , DirOfModIsWriteable a2 ) -> a1 `compare` a2
(CanCompile a1 , CanCompile a2 ) -> a1 `compare` a2
(IsTopMod a1 , IsTopMod a2 ) -> a1 `compare` a2
(HasMain a1 b1 c1 , HasMain a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(FoldHsMod a1 b1 , FoldHsMod a2 b2 ) -> lexico [a1 `compare` a2, b1 `compare` b2]
(ModnameAndImportsPlMb a1 b1 , ModnameAndImportsPlMb a2 b2 ) -> lexico [a1 `compare` a2, b1 `compare` b2]
(HsModnameAndImports a1 , HsModnameAndImports a2 ) -> a1 `compare` a2
(FoldHIInfo a1 , FoldHIInfo a2 ) -> a1 `compare` a2
(ImportExportImpl a1 b1 , ImportExportImpl a2 b2 ) -> lexico [a1 `compare` a2, b1 `compare` b2]
(ImportNameInfo a1 b1 , ImportNameInfo a2 b2 ) -> lexico [a1 `compare` a2, b1 `compare` b2]
(FoldHsPMb a1 b1 c1 , FoldHsPMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(FoldHsPlMb a1 b1 c1 , FoldHsPlMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(FoldEHPMb a1 b1 c1 , FoldEHPMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(FoldEHPlMb a1 b1 c1 , FoldEHPlMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(FoldCoreModPlMb a1 b1 , FoldCoreModPlMb a2 b2 ) -> lexico [a1 `compare` a2, b1 `compare` b2]
(FoldCore2CoreRunPlMb a1 b1 c1 , FoldCore2CoreRunPlMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(FoldCoreRunModPlMb a1 b1 , FoldCoreRunModPlMb a2 b2 ) -> lexico [a1 `compare` a2, b1 `compare` b2]
(FoldCoreRunCheckPlMb a1 b1 c1 , FoldCoreRunCheckPlMb a2 b2 c2 ) -> lexico [a1 `compare` a2, b1 `compare` b2, c1 `compare` c2]
(FPathPreprocessedWithCPP a1 b1 , FPathPreprocessedWithCPP a2 b2 ) -> lexico [a1 `compare` a2, b1 `compare` b2]
(ExposedPackages , ExposedPackages ) -> EQ
where lexico = orderingLexic
instance Ord (BFun' m res) where
compare = bfunCompare
deriving instance Eq (BFun' m res)
deriving instance Show (BFun' m res)
deriving instance Typeable BFun'
instance Hashable (BFun' m res) where
hashWithSalt salt x = case x of
CRSI -> salt `hashWithSalt` (maxBound1::Int)
CRSIWithCompileOrderPl a b c -> salt `hashWithSalt` (0::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
CRSIWithImpsPl a b c d -> salt `hashWithSalt` (1::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d
CRSIOfNameP a b c -> salt `hashWithSalt` (3::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
CRSIOfNamePl a b c -> salt `hashWithSalt` (4::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
FPathSearchForFile a b -> salt `hashWithSalt` (5::Int) `hashWithSalt` a `hashWithSalt` b
FPathForAST a b c d -> salt `hashWithSalt` (6::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d
ImportsOfNamePl a b c -> salt `hashWithSalt` (7::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
ImportsRecursiveWithImpsP a b c d -> salt `hashWithSalt` (8::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d
ImportsRecursiveOfNameP a b c -> salt `hashWithSalt` (9::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
ActualModNm a -> salt `hashWithSalt` (10::Int) `hashWithSalt` a
BuildPlanPMb a b c -> salt `hashWithSalt` (11::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
ASTBuildPlanChoicePMb a b c -> salt `hashWithSalt` (11::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
EcuOf a -> salt `hashWithSalt` (12::Int) `hashWithSalt` a
EHCOptsOf a -> salt `hashWithSalt` (14::Int) `hashWithSalt` a
EcuOfPrevNameAndPath a -> salt `hashWithSalt` (15::Int) `hashWithSalt` a
ASTRefFromFileEither a b c d e f -> salt `hashWithSalt` (18::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d `hashWithSalt` e `hashWithSalt` f
ASTFromFile a b c d e -> salt `hashWithSalt` (19::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d `hashWithSalt` e
ASTP a b c -> salt `hashWithSalt` (20::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
ASTPMb a b c -> salt `hashWithSalt` (21::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
ASTPlMb a b c -> salt `hashWithSalt` (22::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
ModfTimeOfFile a b c d -> salt `hashWithSalt` (23::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d
ASTFileIsValid a b c d -> salt `hashWithSalt` (24::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c `hashWithSalt` d
ASTFileIsNewerThan a b -> salt `hashWithSalt` (25::Int) `hashWithSalt` a `hashWithSalt` b
DirOfModIsWriteable a -> salt `hashWithSalt` (26::Int) `hashWithSalt` a
CanCompile a -> salt `hashWithSalt` (27::Int) `hashWithSalt` a
IsTopMod a -> salt `hashWithSalt` (29::Int) `hashWithSalt` a
HasMain a b c -> salt `hashWithSalt` (29::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
FoldHsMod a b -> salt `hashWithSalt` (30::Int) `hashWithSalt` a `hashWithSalt` b
ModnameAndImportsPlMb a b -> salt `hashWithSalt` (33::Int) `hashWithSalt` a `hashWithSalt` b
HsModnameAndImports a -> salt `hashWithSalt` (34::Int) `hashWithSalt` a
FoldHIInfo a -> salt `hashWithSalt` (35::Int) `hashWithSalt` a
ImportExportImpl a b -> salt `hashWithSalt` (36::Int) `hashWithSalt` a `hashWithSalt` b
ImportNameInfo a b -> salt `hashWithSalt` (37::Int) `hashWithSalt` a `hashWithSalt` b
FoldHsPMb a b c -> salt `hashWithSalt` (38::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
FoldHsPlMb a b c -> salt `hashWithSalt` (39::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
FoldEHPMb a b c -> salt `hashWithSalt` (40::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
FoldEHPlMb a b c -> salt `hashWithSalt` (41::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
FoldCoreModPlMb a b -> salt `hashWithSalt` (42::Int) `hashWithSalt` a `hashWithSalt` b
FoldCore2CoreRunPlMb a b c -> salt `hashWithSalt` (44::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
FoldCoreRunModPlMb a b -> salt `hashWithSalt` (45::Int) `hashWithSalt` a `hashWithSalt` b
FoldCoreRunCheckPlMb a b c -> salt `hashWithSalt` (46::Int) `hashWithSalt` a `hashWithSalt` b `hashWithSalt` c
FPathPreprocessedWithCPP a b -> salt `hashWithSalt` (47::Int) `hashWithSalt` a `hashWithSalt` b
ExposedPackages -> salt `hashWithSalt` (maxBound2::Int)
data BFun m
= forall res
. ( Typeable res)
=> BFun
{ bfcdFun :: !(BFun' m res)
}
instance Eq (BFun m) where
(BFun {bfcdFun=f1}) == (BFun {bfcdFun=f2}) = bfunCompare f1 f2 == EQ
instance Ord (BFun m) where
(BFun {bfcdFun=f1}) `compare` (BFun {bfcdFun=f2}) = bfunCompare f1 f2
instance Hashable (BFun m) where
hashWithSalt salt (BFun {bfcdFun=x}) = hashWithSalt salt x
instance Show (BFun m) where
show (BFun {bfcdFun=x}) = show x
data BFunCacheEntry m
= forall f res
. (Typeable f, Typeable res)
=> BFunCacheEntry
{ bfceFun :: !(BFun' m res)
, bfceVal :: !(f res)
}
data BCache m
= BCache
{ _bcacheCache :: IMap.IntMap [BFunCacheEntry m]
, _bcacheModNmForward :: Map.Map HsName HsName
, _bcacheDpdRel :: Rel.Rel (BFun m) (BFun m)
}
emptyBCache :: BCache m
emptyBCache = BCache IMap.empty Map.empty Rel.empty
bcacheResolveModNm :: BCache m -> HsName -> HsName
bcacheResolveModNm c n = maybe n (bcacheResolveModNm c) $ Map.lookup n (_bcacheModNmForward c)
data BRef (m :: * -> *) val where
BRef_CRSI
:: BRef m (EHCompileRunStateInfo m)
BRef_ExposedPackages
:: BRef m [PkgModulePartition]
BRef_ECU
:: !HsName
-> BRef m EHCompileUnit
BRef_ASTFile
:: !PrevFileSearchKey
-> ASTType
-> ASTSuffixKey
-> ASTFileTiming
-> BRef m val
BRef_AST
:: !PrevFileSearchKey
-> ASTType
-> BRef m val
BRef_EHCOpts
:: !HsName
-> BRef m EHCOpts
deriving instance Typeable BRef
deriving instance Show (BRef m val)
data ASTResult m ast =
ASTResult
{ _astresAST :: ast
, _astresRef :: BRef m ast
, _astresPipe :: ASTPipe
, _astresTimeStamp :: ClockTime
}
deriving (Typeable, Show)
mkASTResult'
:: EHCCompileRunner m
=> ast
-> BRef m ast
-> ASTPipe
-> Maybe ClockTime
-> EHCompilePhaseT m (ASTResult m ast)
mkASTResult' ast ref astpipe mbTm
= do
tm <- maybe (liftIO getClockTime) return mbTm
return $
ASTResult ast ref astpipe
tm
mkASTResult :: EHCCompileRunner m => ast -> BRef m ast -> ASTPipe -> EHCompilePhaseT m (ASTResult m ast)
mkASTResult ast ref astpipe = mkASTResult' ast ref astpipe Nothing
data BState m
= BState
{ _bstateCache :: !(BCache m)
, _bstateCallStack :: ![BFun m]
}
emptyBState :: BState m
emptyBState = BState emptyBCache []
data EHCIOInfo
= EHCIOInfo
{ ehcioinfoStartTime :: EHCTime
, ehcioinfoLastTime :: EHCTime
}
type EHCTime = Integer
data EHCompileRunCoreRunStateInfo
= EHCompileRunCoreRunStateInfo
{ _crcrsiReqdModules :: [HsName]
, _crcrsiNm2RefMp :: !CoreRun.Nm2RefMp
}
emptyEHCompileRunCoreRunStateInfo :: EHCompileRunCoreRunStateInfo
emptyEHCompileRunCoreRunStateInfo
= EHCompileRunCoreRunStateInfo
{ _crcrsiReqdModules = []
, _crcrsiNm2RefMp = CoreRun.emptyNm2RefMp
}
data EHCompileRunStateInfo (m :: * -> *)
= EHCompileRunStateInfo
{ _crsiOpts :: !EHCOpts
, _crsiASTPipe :: !ASTPipe
, _crsiNextUID :: !UID
, _crsiHereUID :: !UID
, _crsiHSInh :: !AST_HS_Inh_Check
, _crsiEHInh :: !AST_EH_Inh_Check
, _crsiFileSuffMp :: FileSuffMp
, _crsiCEnv :: CEnv
, _crsiCoreRunState :: !EHCompileRunCoreRunStateInfo
, crsiMbMainNm :: !(Maybe HsName)
, crsiHSModInh :: !HSSemMod.Inh_AGItf
, crsiModMp :: !ModMp
, crsiGrpMp :: (Map.Map HsName EHCompileGroup)
, crsiOptim :: !Optim
, crsiModOffMp :: !VA.HsName2FldMpMp
, crsiEHCIOInfo :: !(IORef EHCIOInfo)
, crsiFilesToRm :: ![FPath]
, _crsiBState :: !(BState m)
}
deriving (Typeable)
emptyEHCompileRunStateInfo :: EHCompileRunStateInfo m
emptyEHCompileRunStateInfo
= EHCompileRunStateInfo
{ _crsiOpts = defaultEHCOpts
, _crsiASTPipe = emptyASTPipe
, _crsiNextUID = uidStart
, _crsiHereUID = uidStart
, _crsiHSInh = panic "emptyEHCompileRunStateInfo.crsiHSInh"
, _crsiEHInh = panic "emptyEHCompileRunStateInfo.crsiEHInh"
, _crsiFileSuffMp = emptyFileSuffMp
, _crsiCEnv = emptyCEnv
, _crsiCoreRunState = emptyEHCompileRunCoreRunStateInfo
, crsiMbMainNm = Nothing
, crsiHSModInh = panic "emptyEHCompileRunStateInfo.crsiHSModInh"
, crsiModMp = Map.empty
, crsiGrpMp = Map.empty
, crsiOptim = defaultOptim
, crsiModOffMp = Map.empty
, crsiEHCIOInfo = panic "emptyEHCompileRunStateInfo.crsiEHCIOInfo"
, crsiFilesToRm = []
, _crsiBState = emptyBState
}
instance Show (EHCompileRunStateInfo m) where
show _ = "EHCompileRunStateInfo"
instance PP (EHCompileRunStateInfo m) where
pp i = "CRSI:" >#< ppModMp (crsiModMp i)
instance CompileRunStateInfo (EHCompileRunStateInfo m) HsName () where
crsiImportPosOfCUKey n i = ()
class ( MonadIO m
, MonadFix m
, Typeable m
, CompileRunner FileSuffInitState HsName () FileLoc EHCompileUnit (EHCompileRunStateInfo m) Err (EHCompilePhaseAddonT m)
)
=> EHCCompileRunner m where
instance ( CompileRunStateInfo (EHCompileRunStateInfo m) HsName ()
, CompileUnit EHCompileUnit HsName FileLoc FileSuffInitState
, CompileRunError Err ()
, MonadIO m
, MonadFix m
, Typeable m
, Monad m
) => CompileRunner FileSuffInitState HsName () FileLoc EHCompileUnit (EHCompileRunStateInfo m) Err (EHCompilePhaseAddonT m)
instance ( CompileRunStateInfo (EHCompileRunStateInfo m) HsName ()
, CompileUnit EHCompileUnit HsName FileLoc FileSuffInitState
, CompileRunError Err ()
, MonadIO m
, MonadFix m
, Typeable m
, Monad m
) => EHCCompileRunner m
type EHCompileRun m = CompileRun HsName EHCompileUnit (EHCompileRunStateInfo m) Err
type EHCompilePhaseAddonT m = StateT (EHCompileRun m) m
type EHCompilePhaseT m = CompilePhaseT HsName EHCompileUnit (EHCompileRunStateInfo m) Err (EHCompilePhaseAddonT m)
type EHCompilePhase = EHCompilePhaseT IO
data TmOfDelayedRes =
TmOfDelayedRes
{ _tmofdresModNm :: HsName
, _tmofdresHasMain :: Bool
, _tmofdresImpMp :: Map.Map HsName ClockTime
}
deriving (Typeable)
emptyTmOfDelayedRes :: TmOfDelayedRes
emptyTmOfDelayedRes = TmOfDelayedRes hsnUnknown False Map.empty
data TmOfRes (m :: * -> *) =
TmOfRes
{ _tmofresChoice :: TmChoice
, _tmofresIsOverr :: Bool
, _tmofresDelayed :: EHCompilePhaseT m (Maybe TmOfDelayedRes)
, _tmofresTm :: ClockTime
, _tmofresHasMain :: Bool
}
deriving (Typeable)
emptyTmOfRes :: TmOfRes m
emptyTmOfRes = TmOfRes Choice_End False
(panic "emptyTmOfRes.tmofresDelayed") (panic "emptyTmOfRes.tmofresTm")
False
mkLabel ''BCache
mkLabel ''BState
mkLabel ''EHCompileRunCoreRunStateInfo
mkLabel ''EHCompileRunStateInfo
mkLabel ''ASTResult
mkLabel ''TmOfDelayedRes
mkLabel ''TmOfRes
crBaseInfo' :: EHCompileRun m -> (EHCompileRunStateInfo m,EHCOpts)
crBaseInfo' cr
= (crsi,opts)
where crsi = _crStateInfo cr
opts = crsi ^. crsiOpts
crMbBaseInfo :: HsName -> EHCompileRun m -> (Maybe EHCompileUnit, EHCompileRunStateInfo m, EHCOpts, Maybe FPath)
crMbBaseInfo modNm cr
= ( mbEcu ,crsi
, maybe opts id $ mbEcu >>= ecuMbOpts
, fmap ecuFilePath mbEcu
)
where mbEcu = crMbCU modNm cr
(crsi,opts) = crBaseInfo' cr
crBaseInfo :: HsName -> EHCompileRun m -> (EHCompileUnit,EHCompileRunStateInfo m,EHCOpts,FPath)
crBaseInfo modNm cr
= ( maybe (panic $ "crBaseInfo.mbEcu " ++ show modNm) id mbEcu
, crsi
, opts
, maybe (panic $ "crBaseInfo.mbFp " ++ show modNm) id mbFp
)
where (mbEcu, crsi, opts, mbFp) = crMbBaseInfo modNm cr
cpStepUID :: EHCCompileRunner m => EHCompilePhaseT m ()
cpStepUID
= cpUpdSI (\crsi -> let (n,h) = mkNewLevUID (crsi ^. crsiNextUID)
in crsiNextUID ^= n $ crsiHereUID ^= h $ crsi
)
cpSetUID :: EHCCompileRunner m => UID -> EHCompilePhaseT m ()
cpSetUID u
= cpUpdSI $ crsiNextUID ^= u
type EHCTimeDiff = Integer
getEHCTime :: IO EHCTime
getEHCTime = getCPUTime
ehcTimeDiff :: EHCTime -> EHCTime -> EHCTimeDiff
ehcTimeDiff = ()
ehcTimeDiffFmt :: EHCTimeDiff -> String
ehcTimeDiffFmt t
= fm 2 hrs ++ ":" ++ fm 2 mins ++ ":" ++ fm 2 secs ++ ":" ++ fm 6 (psecs `div` 1000000)
where (r0 , psecs) = t `quotRem` 1000000000000
(r1 , secs ) = r0 `quotRem` 60
(r2 , mins ) = r1 `quotRem` 60
(days, hrs ) = r2 `quotRem` 24
fm n x = strPadLeft '0' n (show x)
cpRegisterFilesToRm :: EHCCompileRunner m => [FPath] -> EHCompilePhaseT m ()
cpRegisterFilesToRm fpL
= cpUpdSI (\crsi -> crsi {crsiFilesToRm = fpL ++ crsiFilesToRm crsi})
cpRmFilesToRm :: EHCCompileRunner m => EHCompilePhaseT m ()
cpRmFilesToRm
= do { cr <- MS.get
; let (crsi,opts) = crBaseInfo' cr
files = Set.toList $ Set.fromList $ map fpathToStr $ crsiFilesToRm crsi
; liftIO $ mapM rm files
; cpUpdSI (\crsi -> crsi {crsiFilesToRm = []})
}
where rm f = CE.catch (removeFile f)
(\(e :: SomeException) -> hPutStrLn stderr (show f ++ ": " ++ show e))
cpTrPP :: EHCCompileRunner m => TraceOn -> [PP_Doc] -> EHCompilePhaseT m ()
cpTrPP ton ms = do
cr <- MS.get
let (_,opts) = crBaseInfo' cr
trOnPP (`Set.member` ehcOptTraceOn opts) ton ms
cpTr :: EHCCompileRunner m => TraceOn -> [String] -> EHCompilePhaseT m ()
cpTr ton ms = cpTrPP ton $ map pp ms
cpMemUsage :: EHCCompileRunner m => EHCompilePhaseT m ()
cpMemUsage
= return ()
cpMsg :: EHCCompileRunner m => HsName -> Verbosity -> String -> EHCompilePhaseT m ()
cpMsg modNm v m
= do { cr <- MS.get
; let (_,_,_,mbFp) = crMbBaseInfo modNm cr
; cpMsg' modNm v m Nothing (maybe emptyFPath id mbFp)
}
cpMsg' :: EHCCompileRunner m => HsName -> Verbosity -> String -> Maybe String -> FPath -> EHCompilePhaseT m ()
cpMsg' modNm v m mbInfo fp
= do { cr <- MS.get
; let (mbEcu,crsi,opts,_) = crMbBaseInfo modNm cr
; ehcioinfo <- liftIO $ readIORef (crsiEHCIOInfo crsi)
; clockTime <- liftIO getEHCTime
; let clockStartTimePrev = ehcioinfoStartTime ehcioinfo
clockTimePrev = ehcioinfoLastTime ehcioinfo
clockStartTimeDiff = ehcTimeDiff clockTime clockStartTimePrev
clockTimeDiff = ehcTimeDiff clockTime clockTimePrev
; let
t = if v >= VerboseALot then "<" ++ strBlankPad 35 (ehcTimeDiffFmt clockStartTimeDiff ++ "/" ++ ehcTimeDiffFmt clockTimeDiff) ++ ">" else ""
m' = maybe "" (\ecu -> show (ecuSeqNr ecu) ++ t ++ " ") mbEcu ++ m
; liftIO $ putCompileMsg v (ehcOptVerbosity opts) m' mbInfo modNm fp
; clockTime <- liftIO getEHCTime
; liftIO $ writeIORef (crsiEHCIOInfo crsi) (ehcioinfo {ehcioinfoLastTime = clockTime})
; cpMemUsage
}
cpSystem' :: EHCCompileRunner m => Maybe FilePath -> (FilePath,[String]) -> EHCompilePhaseT m ()
cpSystem' mbStdOut (cmd,args)
= do { exitCode <- liftIO $ system $ showShellCmd $ (cmd,args ++ (maybe [] (\o -> [">", o]) mbStdOut))
; case exitCode of
ExitSuccess -> return ()
_ -> cpSetFail
}
cpSystem :: EHCCompileRunner m => (FilePath,[String]) -> EHCompilePhaseT m ()
cpSystem = cpSystem' Nothing
cpSystemRaw :: EHCCompileRunner m => String -> [String] -> EHCompilePhaseT m ()
cpSystemRaw cmd args
= do { exitCode <- liftIO $ rawSystem cmd args
; case exitCode of
ExitSuccess -> return ()
_ -> cpSetErrs [rngLift emptyRange Err_PP $ pp $ show exitCode]
}
crPartitionIntoPkgAndOthers :: EHCompileRun m -> [HsName] -> ([PkgModulePartition],[HsName])
crPartitionIntoPkgAndOthers cr modNmL
= ( [ (p,d,m)
| ((p,d),m) <- Map.toList $ Map.unionsWith (++) $ map Map.fromList ps
]
, concat ms
)
where (ps,ms) = unzip $ map loc modNmL
loc m = case filelocKind $ ecuFileLocation ecu of
FileLocKind_Dir -> ([ ], [m])
FileLocKind_Pkg p d -> ([((p,d),[m])], [ ])
where (ecu,_,_,_) = crBaseInfo m cr
crsiExpNmOffMpDbg :: String -> HsName -> EHCompileRunStateInfo m -> VA.HsName2FldMp
crsiExpNmOffMpDbg ctxt modNm crsi = mmiNmOffMp $ panicJust ("crsiExpNmOffMp." ++ ctxt ++ show ks ++ ": " ++ show modNm) $ Map.lookup modNm $ crsiModMp crsi
where ks = Map.keys $ crsiModMp crsi
crsiExpNmOffMp :: HsName -> EHCompileRunStateInfo m -> VA.HsName2FldMp
crsiExpNmOffMp modNm crsi = mmiNmOffMp $ panicJust ("crsiExpNmOffMp: " ++ show modNm) $ Map.lookup modNm $ crsiModMp crsi
bUpdAlreadyFlowIntoCRSIWith :: EHCCompileRunner m => HsName -> ASTType -> ASTAlreadyFlowIntoCRSIInfo -> EHCompilePhaseT m ()
bUpdAlreadyFlowIntoCRSIWith modNm asttype flowstage =
bUpdECU modNm $ ecuAlreadyFlowIntoCRSI
^$= Map.insertWith Set.union asttype (Set.singleton flowstage)
bUpdAlreadyFlowIntoCRSI :: EHCCompileRunner m => HsName -> ASTType -> ASTSemFlowStage -> EHCompilePhaseT m ()
bUpdAlreadyFlowIntoCRSI modNm asttype flowstage = bUpdAlreadyFlowIntoCRSIWith modNm asttype (flowstage,Nothing)
bLookupECUInCR :: HsName -> EHCompileRun m -> Maybe (HsName, EHCompileUnit)
bLookupECUInCR n cr = lkn n <|> lkn (bcacheResolveModNm (cr ^. crStateInfo ^. crsiBState ^. bstateCache) n)
where lkn n = fmap ((,) n) $ crMbCU n cr
bLookupECU' :: EHCCompileRunner m => HsName -> EHCompilePhaseT m (Maybe (HsName, EHCompileUnit))
bLookupECU' n = MS.gets (bLookupECUInCR n)
bLookupECU :: EHCCompileRunner m => HsName -> EHCompilePhaseT m (Maybe EHCompileUnit)
bLookupECU n = fmap (fmap snd) $ bLookupECU' n
bUpdECU :: EHCCompileRunner m => HsName -> (EHCompileUnit -> EHCompileUnit) -> EHCompilePhaseT m ()
bUpdECU n f = do
cr <- MS.get
cpUpdCU (maybe n fst $ bLookupECUInCR n cr) f
type TmOfResMb m = Maybe (TmOfRes m)
type TmOfResM m = EHCompilePhaseT m (TmOfResMb m)
updTmChoice upd = tmofresChoice ^$= upd
updTmChoiceM upd = fmap (fmap (updTmChoice upd))