module UHC.Light.Compiler.EHC.CompilePhase.Semantics
( cpFoldCore2Grin
, cpFoldEH
, cpFoldHs
, cpFoldCoreMod
, cpFoldHsMod
, cpFoldHIInfo )
where
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.MainAG 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 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.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
import UHC.Light.Compiler.Base.Debug
import UHC.Util.Pretty









{-# LINE 63 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}
cpFoldCore2Grin :: HsName -> EHCompilePhase ()
cpFoldCore2Grin modNm
  =  do  {  cr <- get
         ;  let  (ecu,crsi,opts,_) = crBaseInfo modNm cr
                 mbCore   = ecuMbCore ecu
                 core     = panicJust "cpFoldCore2Grin" mbCore
                 coreInh  = crsiCoreInh crsi
                 coreSem  = Core2GrSem.wrap_CodeAGItf
                              (Core2GrSem.sem_CodeAGItf (Core.CodeAGItf_AGItf core))
                              (coreInh { Core2GrSem.gUniq_Inh_CodeAGItf                         = crsiHereUID crsi
                                       , Core2GrSem.opts_Inh_CodeAGItf                          = opts
                                       , Core2GrSem.importUsedModules_Inh_CodeAGItf             = ecuImportUsedModules ecu
                                       })
         ;  when (isJust mbCore)
                 (cpUpdCU modNm ( ecuStoreCoreSem coreSem
                                ))
         }

{-# LINE 85 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}
cpFoldCoreMod :: HsName -> EHCompilePhase ()
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
                                , Core2ChkSem.dataGam_Inh_CodeAGItf = EHSem.dataGam_Inh_AGItf $ crsiEHInh crsi
                                }
                 coreSem  = Core2ChkSem.cmodCheck' inh core
                 hasMain  = Core2ChkSem.hasMain_Syn_CodeAGItf coreSem
                 mod      = Core2ChkSem.mod_Syn_CodeAGItf coreSem
         -- ;  lift $ putStrLn $ "cpFoldCoreMod " ++ show hasMain
         ;  when (isJust mbCore)
                 (cpUpdCU modNm ( ecuStoreCoreSemMod coreSem
                                . ecuSetHasMain hasMain
                                . ecuStoreMod mod
                                ))
         }

{-# LINE 109 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}
cpFoldEH :: HsName -> EHCompilePhase ()
cpFoldEH modNm
  =  do  {  cr <- get
         ;  mieimpl <- cpGenModuleImportExportImpl modNm
         ;  let  (ecu,crsi,opts,_) = crBaseInfo modNm cr
                 mbEH   = ecuMbEH ecu
                 ehSem  = EHSem.wrap_AGItf (EHSem.sem_AGItf $ panicJust "cpFoldEH" mbEH)
                                           ((crsiEHInh crsi)
                                                  { EHSem.moduleNm_Inh_AGItf         		= ecuModNm ecu
                                                  , EHSem.gUniq_Inh_AGItf            		= crsiHereUID crsi
                                                  , 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 136 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}
cpFoldHs :: HsName -> EHCompilePhase ()
cpFoldHs modNm
  =  do  {  cr <- get
         ;  let  (ecu,crsi,opts,_) = crBaseInfo modNm cr
                 mbHS   = ecuMbHS ecu
                 inh    = crsiHSInh crsi
                 hsSem  = HSSem.wrap_AGItf (HSSem.sem_AGItf $ panicJust "cpFoldHs" mbHS)
                                           (inh { HSSem.opts_Inh_AGItf             = opts
                                                , HSSem.gUniq_Inh_AGItf            = crsiHereUID crsi
                                                , HSSem.moduleNm_Inh_AGItf         = modNm
                                                , HSSem.isTopMod_Inh_AGItf         = 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) $
                                                           ecuHSDeclImpNmS ecu)
                                     -- . ecuSetHasMain hasMain
                                     )
                     ; when (ehcOptVerbosity opts >= VerboseDebug)
                            (lift $ putStrLn (show modNm ++ " hasMain=" ++ show hasMain))
                     -- ; when hasMain (crSetAndCheckMain modNm)
                     })
         }

{-# LINE 183 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}
cpFoldHsMod :: HsName -> EHCompilePhase ()
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        = crsiHereUID crsi
                                                       , HSSemMod.moduleNm_Inh_AGItf     = modNm
                                                       })
                 hasMain= HSSemMod.mainValExists_Syn_AGItf hsSemMod
                 pragmas = HSSemMod.fileHeaderPragmas_Syn_AGItf hsSemMod
                 (ecuOpts,modifiedOpts)
                         = ehcOptUpdateWithPragmas pragmas opts
         ;  when (isJust mbHS)
                 (cpUpdCU modNm ( ecuStoreHSSemMod hsSemMod
                                . ecuSetHasMain hasMain
                                . ecuStorePragmas pragmas
                                . (if modifiedOpts then ecuStoreOpts ecuOpts else id)
                 )              )
         }

{-# LINE 211 "src/ehc/EHC/CompilePhase/Semantics.chs" #-}
cpFoldHIInfo :: HsName -> EHCompilePhase ()
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)
                            (lift $ putStrLn
                               (show modNm
                                ++ ": hi imps, decl=" ++ show (HI.hiiHIDeclImpModS hiInfo)
                                ++ ", used=" ++ show (HI.hiiHIUsedImpModS hiInfo)
                            )  )
                     })
         }