import Type
import TyCon
+import MkId ( coercionTokenId )
import Id
-import Var ( Var )
import IdInfo
import DataCon
import CostCentre ( noCCS )
-- floated out a binding, in which case it will be approximate.
consistentCafInfo :: Id -> GenStgBinding Var Id -> Bool
consistentCafInfo id bind
- = WARN( not (exact || is_sat_thing) , ppr id )
+ = WARN( not (exact || is_sat_thing) , ppr id <+> ppr id_marked_caffy <+> ppr binding_is_caffy )
safe
where
safe = id_marked_caffy || not binding_is_caffy
decisions. Hence no black holes.
\begin{code}
-coreToStgExpr (Lit l) = return (StgLit l, emptyFVInfo, emptyVarSet)
-coreToStgExpr (Var v) = coreToStgApp Nothing v []
+coreToStgExpr (Lit l) = return (StgLit l, emptyFVInfo, emptyVarSet)
+coreToStgExpr (Var v) = coreToStgApp Nothing v []
+coreToStgExpr (Coercion _) = coreToStgApp Nothing coercionTokenId []
coreToStgExpr expr@(App _ _)
= coreToStgApp Nothing f args
-- All the free vars of the args are disqualified
-- from being let-no-escaped.
+ -- Forcing these fixes a leak in the code generator, noticed while
+ -- profiling for trac #4367
app `seq` fvs `seq` seqVarSet vars `seq` return (
app,
fvs,
(args', fvs) <- coreToStgArgs args
return (args', fvs)
+coreToStgArgs (Coercion _ : args) -- Coercion argument; replace with place holder
+ = do { (args', fvs) <- coreToStgArgs args
+ ; return (StgVarArg coercionTokenId : args', fvs) }
+
coreToStgArgs (arg : args) = do -- Non-type argument
(stg_args, args_fvs) <- coreToStgArgs args
(arg', arg_fvs, _escs) <- coreToStgExpr arg
assumptions (namely that they will be entered only once).
upd_flag | isPAP env rhs = ReEntrant
- | otherwise = Updatable
+ | otherwise = Updatable
-}
{- ToDo:
go (Cast e _) as = go e as
go (Note _ e) as = go e as
go (Lam b e) as
- | isTyCoVar b = go e as -- Note [Collect args]
+ | isTyVar b = go e as -- Note [Collect args]
go _ _ = pprPanic "CoreToStg.myCollectArgs" (ppr expr)
\end{code}