module UHC.Light.Compiler.EHC.CompilePhase.Semantics ( cpFoldCore2CoreRun , cpFoldEH , cpFoldHs , cpFoldCoreMod , cpFoldHsMod , cpFoldHIInfo ) where import UHC.Util.Lens import Control.Monad.State import qualified Data.Map as Map import UHC.Light.Compiler.EHC.Common import UHC.Light.Compiler.EHC.CompileUnit import UHC.Light.Compiler.EHC.CompileRun import qualified UHC.Light.Compiler.EH.Main as EHSem import qualified UHC.Light.Compiler.HS.MainAG as HSSem import qualified UHC.Light.Compiler.Core as Core import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem import qualified UHC.Light.Compiler.Core.ToCoreRun as Core2CoreRunSem import qualified UHC.Light.Compiler.CoreRun as CoreRun import qualified Data.Set as Set import UHC.Light.Compiler.EHC.CompilePhase.Common 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.Util.Rel as Rel import UHC.Light.Compiler.Module.ImportExport import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod {-# LINE 99 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} cpFoldCore2CoreRun :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldCore2CoreRun modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr mbCore = _ecuMbCore ecu hasMain = ecuHasMain ecu core = panicJust "cpFoldCore2CoreRun" mbCore inhLbl = crsiCoreRunState ^* crcrsiNm2RefMp core2RunInh = crsi ^. inhLbl (corerun,nm2ref,sem) = Core2CoreRunSem.cmod2CoreRun' opts hasMain Nothing core2RunInh core core2RunInh' = nm2ref `CoreRun.nm2refUnion` core2RunInh ; when (isJust mbCore) $ do -- between module flow part cpUpdSI $ inhLbl ^= core2RunInh' -- cpUpdSI (\crsi -> crsi {_crsiCore2RunInh = core2RunInh'}) -- per module part cpUpdCU modNm ( ecuStoreCoreRun corerun . ecuStoreCore2CoreRunSem sem ) } {-# LINE 149 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} cpFoldCoreMod :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldCoreMod modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr mbCore = _ecuMbCore ecu core = panicJust "cpFoldCoreMod" mbCore inh = Core2ChkSem.Inh_CodeAGItf { Core2ChkSem.opts_Inh_CodeAGItf = opts , Core2ChkSem.moduleNm_Inh_CodeAGItf = modNm } coreSem = Core2ChkSem.cmodCheck' inh core hasMain = Core2ChkSem.hasMain_Syn_CodeAGItf coreSem mod = Core2ChkSem.mod_Syn_CodeAGItf coreSem -- ; liftIO $ putStrLn $ "cpFoldCoreMod " ++ show hasMain ; when (isJust mbCore) (cpUpdCU modNm ( ecuStoreCoreSemMod coreSem . ecuSetHasMain hasMain . ecuStoreMod mod )) } {-# LINE 172 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} cpFoldEH :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldEH modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr ; mieimpl <- cpGenModuleImportExportImpl modNm -- ; mieimpl <- bcall $ ImportExportImpl (mkPrevFileSearchKeyWithName modNm) (ehcOptOptimizationScope opts) ; let mbEH = _ecuMbEH ecu ehSem = EHSem.wrap_AGItf (EHSem.sem_AGItf $ panicJust "cpFoldEH" mbEH) ((crsi ^. crsiEHInh) { EHSem.moduleNm_Inh_AGItf = ecuModNm ecu , EHSem.gUniq_Inh_AGItf = crsi ^. crsiHereUID , EHSem.opts_Inh_AGItf = opts , EHSem.importUsedModules_Inh_AGItf = ecuImportUsedModules ecu , EHSem.moduleImportExportImpl_Inh_AGItf = mieimpl , EHSem.isMainMod_Inh_AGItf = ecuIsMainMod ecu }) ; when (isJust mbEH) (cpUpdCU modNm $! ecuStoreEHSem $! ehSem) } {-# LINE 200 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} cpFoldHs :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldHs modNm = do { cr <- get -- ; isTopMod <- bcall $ IsTopMod $ mkPrevFileSearchKeyWithName modNm ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr mbHS = _ecuMbHS ecu inh = crsi ^. crsiHSInh hsSem = HSSem.wrap_AGItf (HSSem.sem_AGItf $ panicJust "cpFoldHs" mbHS) (inh { HSSem.opts_Inh_AGItf = opts , HSSem.gUniq_Inh_AGItf = crsi ^. crsiHereUID , HSSem.moduleNm_Inh_AGItf = modNm , HSSem.isTopMod_Inh_AGItf = {- isTopMod -- -} _ecuIsTopMod ecu , HSSem.modInScope_Inh_AGItf = inscps , HSSem.modEntToOrig_Inh_AGItf = exps , HSSem.topInstanceNmL_Inh_AGItf = modInstNmL (ecuMod ecu) }) where mmi = panicJust "cpFoldHs.crsiModMp" $ Map.lookup modNm $ crsiModMp crsi inscps = Rel.toDomMap --- $ (\v -> tr "XX mmiInscps mmi" (pp v ) v) $ mmiInscps --- $ (\v -> tr "XX mmi" (pp v ) v) $ mmi exps = Rel.toRngMap $ Rel.restrictRng (\o -> let mq = hsnQualifier (ioccNm o) in isJust mq && fromJust mq /= modNm) $ Rel.mapRng mentIdOcc $ mmiExps mmi hasMain= HSSem.mainValExists_Syn_AGItf hsSem ; when (isJust mbHS) (do { cpUpdCU modNm ( ecuStoreHSSem hsSem . ecuStoreHIDeclImpS ( -- (\v -> tr "YY" (pp $ Set.toList v) v) $ ecuSrcDeclImpNmS ecu) -- . ecuSetHasMain hasMain ) ; when (ehcOptVerbosity opts >= VerboseDebug) (liftIO $ putStrLn (show modNm ++ " hasMain=" ++ show hasMain)) -- ; when hasMain (crSetAndCheckMain modNm) }) } {-# LINE 250 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} cpFoldHsMod :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldHsMod modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr mbHS = _ecuMbHS ecu inh = crsiHSModInh crsi hsSemMod = HSSemMod.wrap_AGItf (HSSemMod.sem_AGItf $ panicJust "cpFoldHsMod" mbHS) (inh { HSSemMod.gUniq_Inh_AGItf = crsi ^. crsiHereUID , HSSemMod.moduleNm_Inh_AGItf = modNm }) hasMain= HSSemMod.mainValExists_Syn_AGItf hsSemMod pragmas = HSSemMod.fileHeaderPragmas_Syn_AGItf hsSemMod (ecuOpts,modifiedOpts) = ehcOptUpdateWithPragmas pragmas opts -- ; liftIO $ putStrLn $ "pragmas:" ++ show pragmas ; when (isJust mbHS) (cpUpdCU modNm ( ecuStoreHSSemMod hsSemMod . ecuSetHasMain hasMain . ecuStorePragmas pragmas . (if modifiedOpts then ecuStoreOpts ecuOpts else id) ) ) } {-# LINE 279 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} cpFoldHIInfo :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpFoldHIInfo modNm = do { cr <- get ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr mbHIInfo = _ecuMbPrevHIInfo ecu hiInfo = panicJust "cpFoldHIInfo" mbHIInfo hasMain = HI.hiiHasMain hiInfo ; when (isJust mbHIInfo && HI.hiiValidity hiInfo == HI.HIValidity_Ok) (do { let mm = crsiModMp crsi mmi = Map.findWithDefault emptyModMpInfo modNm mm mmi' = mkModMpInfo modNm (mmiInscps mmi) ( -- (\v -> tr "cpFoldHIInfo.hiiExps" (pp v) v) $ HI.hiiExps hiInfo) (HI.hiiHiddenExps hiInfo) -- ; when hasMain (crSetAndCheckMain modNm) ; cpUpdSI (\crsi -> crsi {crsiModMp = Map.insert modNm mmi' mm}) ; cpUpdCU modNm ( ecuStorePrevHIInfo hiInfo . ecuStoreHIDeclImpS (HI.hiiHIDeclImpModS hiInfo) . ecuStoreHIUsedImpS (HI.hiiHIUsedImpModS hiInfo) . ecuSetHasMain hasMain ) ; when (ehcOptVerbosity opts >= VerboseDebug) (liftIO $ putStrLn (show modNm ++ ": hi imps, decl=" ++ show (HI.hiiHIDeclImpModS hiInfo) ++ ", used=" ++ show (HI.hiiHIUsedImpModS hiInfo) ) ) }) }