pprSimplEnv :: SimplEnv -> SDoc
-- Used for debugging; selective
pprSimplEnv env
- = vcat [ptext SLIT("TvSubst:") <+> ppr (seTvSubst env),
- ptext SLIT("IdSubst:") <+> ppr (seIdSubst env) ]
+ = vcat [ptext (sLit "TvSubst:") <+> ppr (seTvSubst env),
+ ptext (sLit "IdSubst:") <+> ppr (seIdSubst env) ]
type SimplIdSubst = IdEnv SimplSR -- IdId |--> OutExpr
-- See Note [Extending the Subst] in CoreSubst
InExpr
instance Outputable SimplSR where
- ppr (DoneEx e) = ptext SLIT("DoneEx") <+> ppr e
- ppr (DoneId v) = ptext SLIT("DoneId") <+> ppr v
- ppr (ContEx tv id e) = vcat [ptext SLIT("ContEx") <+> ppr e {-,
+ ppr (DoneEx e) = ptext (sLit "DoneEx") <+> ppr e
+ ppr (DoneId v) = ptext (sLit "DoneId") <+> ppr v
+ ppr (ContEx tv id e) = vcat [ptext (sLit "ContEx") <+> ppr e {-,
ppr (filter_env tv), ppr (filter_env id) -}]
-- where
-- fvs = exprFreeVars e
ppr (Floats binds ff) = ppr ff $$ ppr (fromOL binds)
instance Outputable FloatFlag where
- ppr FltLifted = ptext SLIT("FltLifted")
- ppr FltOkSpec = ptext SLIT("FltOkSpec")
- ppr FltCareful = ptext SLIT("FltCareful")
+ ppr FltLifted = ptext (sLit "FltLifted")
+ ppr FltOkSpec = ptext (sLit "FltOkSpec")
+ ppr FltCareful = ptext (sLit "FltCareful")
andFF :: FloatFlag -> FloatFlag -> FloatFlag
andFF FltCareful _ = FltCareful
= env { seFloats = seFloats env `addFlts` unitFloat (NonRec id rhs),
seInScope = extendInScopeSet (seInScope env) id }
-extendFloats :: SimplEnv -> [OutBind] -> SimplEnv
+extendFloats :: SimplEnv -> OutBind -> SimplEnv
-- Add these bindings to the floats, and extend the in-scope env too
-extendFloats env binds
- = env { seFloats = seFloats env `addFlts` new_floats,
+extendFloats env bind
+ = env { seFloats = seFloats env `addFlts` unitFloat bind,
seInScope = extendInScopeSetList (seInScope env) bndrs }
where
- bndrs = bindersOfBinds binds
- new_floats = Floats (toOL binds)
- (foldr (andFF . classifyFF) FltLifted binds)
+ bndrs = bindersOf bind
addFloats :: SimplEnv -> SimplEnv -> SimplEnv
-- Add the floats for env2 to env1;