Transformations.hs

module UHC.Light.Compiler.EHC.CompilePhase.Transformations
( cpTransformCore )
where
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Monad.State
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.Base.Optimize
import UHC.Light.Compiler.EHC.CompileUnit
import UHC.Light.Compiler.EHC.CompileRun
import qualified UHC.Light.Compiler.Config as Cfg
import UHC.Light.Compiler.CodeGen.TrfUtils
import UHC.Light.Compiler.Core.Trf
import UHC.Light.Compiler.EHC.CompilePhase.Output
import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem
import qualified UHC.Light.Compiler.HI as HI
import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem
import UHC.Light.Compiler.EHC.CompilePhase.Module(cpUpdHiddenExports)










{-# LINE 71 "src/ehc/EHC/CompilePhase/Transformations.chs" #-}
cpTransformCore :: OptimizationScope -> HsName -> EHCompilePhase ()
cpTransformCore optimScope modNm
  = do { cr <- get
       ; let  (ecu,crsi,opts,fp) = crBaseInfo modNm cr
       ; cpMsg' modNm VerboseALot "Transforming Core ..." Nothing fp

         -- transform
       ; let  mbCore     = ecuMbCore ecu
              coreInh    = crsiCoreInh crsi
              trfcoreIn  = emptyTrfCore
                             { trfstMod             	= panicJust "cpTransformCore" mbCore
                             , trfstUniq            	= crsiNextUID crsi
                             , trfstExtra = emptyTrfCoreExtra
                                 { trfcoreECUState		= ecuState ecu
                                 , trfcoreIsLamLifted	= maybe False Core2ChkSem.isLamLifted_Syn_CodeAGItf $ ecuMbCoreSemMod ecu
                                 , trfcoreExpNmOffMp    = crsiExpNmOffMpDbg "cpTransformCore" modNm crsi
								 , trfcoreInhLamMp      = Core2GrSem.lamMp_Inh_CodeAGItf $ crsiCoreInh crsi
                                 }
                             }
              trfcoreOut = trfCore opts optimScope (Core2GrSem.dataGam_Inh_CodeAGItf $ crsiCoreInh crsi) modNm trfcoreIn

       -- ; lift $ putStrLn $ "cpTransformCore trfcoreIsLamLifted: " ++ show (trfcoreIsLamLifted $ trfstExtra trfcoreIn)
         -- put back result: Core
       ; cpUpdCU modNm $! ecuStoreCore (trfstMod trfcoreOut)

         -- put back result: unique counter
       ; cpSetUID (trfstUniq trfcoreOut)

         -- put back result: call info map (lambda arity, ...)
       ; let hii   = ecuHIInfo ecu
             lamMp = HI.hiiLamMp hii
       ; cpUpdCU modNm
           ( ecuStoreHIInfo
               (hii { HI.hiiLamMp = (trfcoreGathLamMp $ trfstExtra trfcoreOut) `Map.union` lamMp
                    })
           )
         -- put back result: additional hidden exports, it should be in a cpFlowXX variant
       ; cpUpdHiddenExports modNm $ zip (Set.toList $ trfcoreExtraExports $ trfstExtra trfcoreOut) (repeat IdOcc_Val)

         -- dump intermediate stages, print errors, if any
       ; let (nms,mcs,errs) = unzip3 $ trfstModStages trfcoreOut
       ; cpOutputCoreModules CPOutputCoreHow_Text [{- CoreOpt_DumpAlsoNonParseable -}] (\n nm -> "-" ++ show optimScope ++ "-" ++ show n ++ "-" ++ nm) Cfg.suffixDotlessOutputTextualCore modNm [ (n,nm) | (n, Just nm) <- zip nms mcs ]
       ; cpSeq $ zipWith (\nm err -> cpSetLimitErrsWhen 5 ("Core errors: " ++ nm) err) nms errs
       }