module UHC.Light.Compiler.EHC.CompilePhase.Translations ( cpTranslateHs2EH , cpTranslateEH2Output , cpTranslateEH2Core ) where import qualified Data.Map as Map import qualified Data.Set as Set import qualified UHC.Util.FastSeq as Seq import UHC.Util.Lens import Control.Monad.State import UHC.Light.Compiler.EHC.CompilePhase.Output import UHC.Light.Compiler.EHC.ASTHandler.Instances import qualified UHC.Light.Compiler.Config as Cfg import UHC.Light.Compiler.Base.Trace import UHC.Light.Compiler.EHC.Common import UHC.Light.Compiler.EHC.CompileUnit import UHC.Light.Compiler.EHC.CompileRun import UHC.Light.Compiler.Base.Target import qualified UHC.Light.Compiler.EH.Main as EHSem import qualified UHC.Light.Compiler.HS.MainAG as HSSem import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem import UHC.Light.Compiler.Core.Trf.ElimNonCodegenConstructs import UHC.Light.Compiler.Base.Optimize import UHC.Light.Compiler.EHC.CompilePhase.Module import UHC.Light.Compiler.CodeGen.ValAccess as VA import UHC.Light.Compiler.CodeGen.RefGenerator import UHC.Light.Compiler.EHC.CompilePhase.Common import UHC.Light.Compiler.CodeGen.ModuleImportExportImpl {-# LINE 105 "src/ehc/EHC/CompilePhase/Translations.chs" #-} cpTranslateHs2EH :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpTranslateHs2EH modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr mbHsSem= _ecuMbHSSem ecu hsSem = panicJust "cpTranslateHs2EH" mbHsSem eh = HSSem.eh_Syn_AGItf hsSem errs = Seq.toList $ HSSem.errSq_Syn_AGItf hsSem ; when (isJust mbHsSem) (do { cpUpdCU modNm (ecuStoreEH eh) ; let trpp = HSSem.trpp_Syn_AGItf hsSem ; when (not $ trppIsEmpty trpp) $ trPPOnIO trpp ; cpSetLimitErrsWhen 5 "Dependency/name analysis" errs ; when (ehcOptEmitHS opts) (liftIO $ putPPFPath (mkOutputFPath opts modNm fp "hs2") (HSSem.pp_Syn_AGItf hsSem) 1000) ; when (ehcOptShowHS opts) (liftIO $ putWidthPPLn 120 (HSSem.pp_Syn_AGItf hsSem)) }) } {-# LINE 127 "src/ehc/EHC/CompilePhase/Translations.chs" #-} cpTranslateEH2Output :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpTranslateEH2Output modNm = do { cr <- get -- ; isTopMod <- bcall $ IsTopMod $ mkPrevFileSearchKeyWithName modNm ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr mbEHSem= _ecuMbEHSem ecu ehSem = panicJust "cpTranslateEH2Output" mbEHSem about = "EH analyses: Type checking" errs = Seq.toList $ EHSem.allErrSq_Syn_AGItf ehSem ; when (isJust mbEHSem) (do { let trpp = EHSem.trpp_Syn_AGItf ehSem ; when (not $ trppIsEmpty trpp) $ trPPOnIO trpp ; when (ehcOptEmitEH opts) (liftIO $ putPPFPath (mkOutputFPath opts modNm fp "eh2") (EHSem.pp_Syn_AGItf ehSem) 1000) ; when (EhOpt_Dump `elem` ehcOptEhOpts opts) $ -- void $ cpOutputSomeModule (^. ecuEH) astHandler'_EH ASTFileContent_Text "" Cfg.suffixDotlessOutputTextualEh (ecuModNm ecu) liftIO $ putPPFPath (mkOutputFPath opts modNm fp Cfg.suffixDotlessOutputTextualEh) (EHSem.pp_Syn_AGItf ehSem) 1000 ; when (ehcOptShowEH opts) (liftIO $ putWidthPPLn 120 (EHSem.pp_Syn_AGItf ehSem)) ; when (_ecuIsTopMod ecu && EhOpt_DumpAST `elem` ehcOptEhOpts opts) $ liftIO $ putPPFPath (mkOutputFPath opts modNm fp Cfg.suffixDotlessOutputTextualEhAST) (EHSem.ppAST_Syn_AGItf ehSem) 1000 ; cpSetLimitErrsWhen 5 about errs } ) } {-# LINE 187 "src/ehc/EHC/CompilePhase/Translations.chs" #-} cpTranslateEH2Core :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpTranslateEH2Core modNm = do { cr <- get ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr mbEHSem= _ecuMbEHSem ecu ehSem = panicJust "cpTranslateEH2Core" mbEHSem core = cmodTrfElimNonCodegenConstructs opts $ EHSem.cmodule_Syn_AGItf ehSem ; when (isJust mbEHSem) (cpUpdCU modNm ( ecuStoreCore core )) }