diff options
Diffstat (limited to 'compiler/stgSyn/CoreToStg.hs')
| -rw-r--r-- | compiler/stgSyn/CoreToStg.hs | 19 |
1 files changed, 13 insertions, 6 deletions
diff --git a/compiler/stgSyn/CoreToStg.hs b/compiler/stgSyn/CoreToStg.hs index dcb923afea..37df9e2146 100644 --- a/compiler/stgSyn/CoreToStg.hs +++ b/compiler/stgSyn/CoreToStg.hs @@ -196,7 +196,7 @@ import Control.Monad (liftM, ap) -- Setting variable info: top-level, binds, RHSs -- -------------------------------------------------------------- -coreToStg :: DynFlags -> Module -> CoreProgram -> [StgBinding] +coreToStg :: DynFlags -> Module -> CoreProgram -> [StgTopBinding] coreToStg dflags this_mod pgm = pgm' where (_, _, pgm') = coreTopBindsToStg dflags this_mod emptyVarEnv pgm @@ -211,7 +211,7 @@ coreTopBindsToStg -> Module -> IdEnv HowBound -- environment for the bindings -> CoreProgram - -> (IdEnv HowBound, FreeVarsInfo, [StgBinding]) + -> (IdEnv HowBound, FreeVarsInfo, [StgTopBinding]) coreTopBindsToStg _ _ env [] = (env, emptyFVInfo, []) coreTopBindsToStg dflags this_mod env (b:bs) @@ -229,7 +229,14 @@ coreTopBindToStg -> IdEnv HowBound -> FreeVarsInfo -- Info about the body -> CoreBind - -> (IdEnv HowBound, FreeVarsInfo, StgBinding) + -> (IdEnv HowBound, FreeVarsInfo, StgTopBinding) + +coreTopBindToStg _ _ env body_fvs (NonRec id (Lit (MachStr str))) + -- top-level string literal + = let + env' = extendVarEnv env id how_bound + how_bound = LetBound TopLet 0 + in (env', body_fvs, StgTopStringLit id str) coreTopBindToStg dflags this_mod env body_fvs (NonRec id rhs) = let @@ -241,7 +248,7 @@ coreTopBindToStg dflags this_mod env body_fvs (NonRec id rhs) (stg_rhs, fvs') <- coreToTopStgRhs dflags this_mod body_fvs (id,rhs) return (stg_rhs, fvs') - bind = StgNonRec id stg_rhs + bind = StgTopLifted $ StgNonRec id stg_rhs in ASSERT2(consistentCafInfo id bind, ppr id ) -- NB: previously the assertion printed 'rhs' and 'bind' @@ -265,7 +272,7 @@ coreTopBindToStg dflags this_mod env body_fvs (Rec pairs) let fvs' = unionFVInfos fvss' return (stg_rhss, fvs') - bind = StgRec (zip binders stg_rhss) + bind = StgTopLifted $ StgRec (zip binders stg_rhss) in ASSERT2(consistentCafInfo (head binders) bind, ppr binders) (env', fvs' `unionFVInfo` body_fvs, bind) @@ -275,7 +282,7 @@ coreTopBindToStg dflags this_mod env body_fvs (Rec pairs) -- what CoreToStg has figured out about the binding's SRT. The -- CafInfo will be exact in all cases except when CorePrep has -- floated out a binding, in which case it will be approximate. -consistentCafInfo :: Id -> GenStgBinding Var Id -> Bool +consistentCafInfo :: Id -> GenStgTopBinding Var Id -> Bool consistentCafInfo id bind = WARN( not (exact || is_sat_thing) , ppr id <+> ppr id_marked_caffy <+> ppr binding_is_caffy ) safe |