Translations.hs

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 115 "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 137 "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 197 "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
                                ))
         }