diff options
author | Sebastian Graf <sebastian.graf@kit.edu> | 2021-06-22 14:02:49 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-06-27 14:57:39 -0400 |
commit | d7758da490db3cc662dbebdac4397b4b2c38d0f0 (patch) | |
tree | ee8da5279b12a0ca2999789e92dea81b1552df67 | |
parent | 3e71874b32725cb0bd95f6a7effc77190a860b3e (diff) | |
download | haskell-d7758da490db3cc662dbebdac4397b4b2c38d0f0.tar.gz |
Simplifier: Do Cast W/W for INLINE strong loop-breakers
Strong loop-breakers never inline, INLINE pragma or not.
Hence they should be treated as if there was no INLINE pragma on them.
Also not doing Cast W/W for INLINE strong loop-breakers will trip up Strictness
W/W, because it treats them as if there was no INLINE pragma. Subsequently,
that will lead to a panic once Strictness W/W will no longer do eta-expansion,
as we discovered while implementing !5814.
I also renamed to `unfoldingInfo` to `realUnfoldingInfo` and redefined
`unfoldingInfo` to zap the unfolding it returns in case of a strong loop-breaker.
Now the naming and semantics is symmetrical to `idUnfolding`/`realIdUnfolding`.
Now there was no more reason for `hasInlineUnfolding` to operate on `Id`,
because the zapping of strong loop-breaker unfoldings moved from `idUnfolding`
to `unfoldingInfo`, so I refactored it to take `IdInfo` and call it both from
the Simplifier and WorkWrap, making it utterly clear that both checks are
equivalent.
-rw-r--r-- | compiler/GHC/Core/Opt/Pipeline.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/Simplify.hs | 30 | ||||
-rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Ppr.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Core/Seq.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/SimpleOpt.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Subst.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Core/Tidy.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Unfold.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Core/Utils.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/CoreToIface.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Iface/Tidy.hs | 6 | ||||
-rw-r--r-- | compiler/GHC/Types/Id.hs | 31 | ||||
-rw-r--r-- | compiler/GHC/Types/Id/Info.hs | 26 |
14 files changed, 68 insertions, 59 deletions
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs index 666725f320..26a46321b4 100644 --- a/compiler/GHC/Core/Opt/Pipeline.hs +++ b/compiler/GHC/Core/Opt/Pipeline.hs @@ -1007,7 +1007,7 @@ hasShortableIdInfo :: Id -> Bool hasShortableIdInfo id = isEmptyRuleInfo (ruleInfo info) && isDefaultInlinePragma (inlinePragInfo info) - && not (isStableUnfolding (unfoldingInfo info)) + && not (isStableUnfolding (realUnfoldingInfo info)) where info = idInfo id @@ -1048,7 +1048,7 @@ transferIdInfo exported_id local_id local_info = idInfo local_id transfer exp_info = exp_info `setDmdSigInfo` dmdSigInfo local_info `setCprSigInfo` cprSigInfo local_info - `setUnfoldingInfo` unfoldingInfo local_info + `setUnfoldingInfo` realUnfoldingInfo local_info `setInlinePragInfo` inlinePragInfo local_info `setRuleInfo` addRuleInfo (ruleInfo exp_info) new_info new_info = setRuleInfoHead (idName exported_id) diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs index d1ca3e3f9c..6c7379faa2 100644 --- a/compiler/GHC/Core/Opt/Simplify.hs +++ b/compiler/GHC/Core/Opt/Simplify.hs @@ -544,14 +544,17 @@ Wrinkles Notice that the stable unfolding moves to the worker! Now demand analysis will work fine on $wf, whereas it has trouble with the original f. c.f. Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap. + This point also applies to strong loopbreakers with INLINE pragmas, see + wrinkle (4). -4. We should /not/ do cast w/w for INLINE functions (hence isInlineUnfolding in - tryCastWorkerWrapper) becuase they'll be inlined, cast and all anyway. And - if we do cast w/w for an INLINE function with arity zero, we get something - really silly: we inline that "worker" right back into the wrapper! Worse than - a no-op, because we haev then lost the stable unfolding. +4. We should /not/ do cast w/w for non-loop-breaker INLINE functions (hence + hasInlineUnfolding in tryCastWorkerWrapper, which responds False to + loop-breakers) because they'll definitely be inlined anyway, cast and + all. And if we do cast w/w for an INLINE function with arity zero, we get + something really silly: we inline that "worker" right back into the wrapper! + Worse than a no-op, because we have then lost the stable unfolding. -Both these wrinkles are exactly like worker/wrapper for strictness analysis: +All these wrinkles are exactly like worker/wrapper for strictness analysis: f is the wrapper and must inline like crazy $wf is the worker and must carry f's original pragma See Note [Worker/wrapper for INLINABLE functions] @@ -600,10 +603,10 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co) | not (isJoinId bndr) -- Not for join points , not (isDFunId bndr) -- nor DFuns; cast w/w is no help, and we can't transform -- a DFunUnfolding in mk_worker_unfolding - , not (exprIsTrivial rhs) -- Not x = y |> co; Wrinkle 1 - , not (isInlineUnfolding unf) -- Not INLINE things: Wrinkle 4 - , not (isUnliftedType rhs_ty) -- Not if rhs has an unlifted type; - -- see Note [Cast w/w: unlifted] + , not (exprIsTrivial rhs) -- Not x = y |> co; Wrinkle 1 + , not (hasInlineUnfolding info) -- Not INLINE things: Wrinkle 4 + , not (isUnliftedType rhs_ty) -- Not if rhs has an unlifted type; + -- see Note [Cast w/w: unlifted] = do { (rhs_floats, work_rhs) <- prepareRhs mode top_lvl occ_fs rhs ; uniq <- getUniqueM ; let work_name = mkSystemVarName uniq occ_fs @@ -637,7 +640,6 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co) occ_fs = getOccFS bndr rhs_ty = coercionLKind co info = idInfo bndr - unf = unfoldingInfo info worker_info = vanillaIdInfo `setDmdSigInfo` dmdSigInfo info `setCprSigInfo` cprSigInfo info @@ -654,8 +656,8 @@ tryCastWorkerWrapper env top_lvl old_bndr occ_info bndr (Cast rhs co) -- Non-stable case: use work_rhs -- Wrinkle 3 of Note [Cast worker/wrapper] mk_worker_unfolding work_id work_rhs - = case unf of - CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src } + = case realUnfoldingInfo info of -- NB: the real one, even for loop-breakers + unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) | isStableSource src -> return (unf { uf_tmpl = mkCast unf_rhs (mkSymCo co) }) _ -> mkLetUnfolding (sm_uf_opts mode) top_lvl InlineRhs work_id work_rhs @@ -895,7 +897,7 @@ completeBind env top_lvl mb_cont old_bndr new_bndr new_rhs | otherwise = assert (isId new_bndr) $ do { let old_info = idInfo old_bndr - old_unf = unfoldingInfo old_info + old_unf = realUnfoldingInfo old_info occ_info = occInfo old_info mode = getMode env diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs index 58ac9f4c62..18b4d848e1 100644 --- a/compiler/GHC/Core/Opt/WorkWrap.hs +++ b/compiler/GHC/Core/Opt/WorkWrap.hs @@ -517,7 +517,7 @@ tryWW ww_opts is_rec fn_id rhs = return [(new_fn_id, filler)] -- See Note [Don't w/w INLINE things] - | hasInlineUnfolding fn_id + | hasInlineUnfolding fn_info = return [(new_fn_id, rhs)] -- See Note [No worker/wrapper for record selectors] @@ -800,7 +800,7 @@ mkWWBindPair ww_opts fn_id fn_info rhs work_uniq div cpr fn_inl_prag = inlinePragInfo fn_info fn_inline_spec = inl_inline fn_inl_prag - fn_unfolding = unfoldingInfo fn_info + fn_unfolding = realUnfoldingInfo fn_info -- Even if we don't w/w join points for CPR, we might still do so for -- strictness. In which case a join point worker keeps its original CPR diff --git a/compiler/GHC/Core/Ppr.hs b/compiler/GHC/Core/Ppr.hs index cc3159d646..f1791dfebf 100644 --- a/compiler/GHC/Core/Ppr.hs +++ b/compiler/GHC/Core/Ppr.hs @@ -426,7 +426,7 @@ pprTypedLamBinder bind_site debug_on var 2 (vcat [ dcolon <+> pprType (idType var) , pp_unf])) where - unf_info = unfoldingInfo (idInfo var) + unf_info = realUnfoldingInfo (idInfo var) pp_unf | hasSomeUnfolding unf_info = text "Unf=" <> ppr unf_info | otherwise = empty @@ -510,7 +510,7 @@ instance Outputable IdInfo where str_info = dmdSigInfo info has_str_info = not (isTopSig str_info) - unf_info = unfoldingInfo info + unf_info = realUnfoldingInfo info has_unf = hasSomeUnfolding unf_info rules = ruleInfoRules (ruleInfo info) @@ -557,7 +557,7 @@ ppIdInfo id info cpr_info = cprSigInfo info has_cpr_info = cpr_info /= topCprSig - unf_info = unfoldingInfo info + unf_info = realUnfoldingInfo info has_unf = hasSomeUnfolding unf_info rules = ruleInfoRules (ruleInfo info) diff --git a/compiler/GHC/Core/Seq.hs b/compiler/GHC/Core/Seq.hs index 129b87f932..0addae9775 100644 --- a/compiler/GHC/Core/Seq.hs +++ b/compiler/GHC/Core/Seq.hs @@ -32,7 +32,7 @@ megaSeqIdInfo info -- Omitting this improves runtimes a little, presumably because -- some unfoldings are not calculated at all --- seqUnfolding (unfoldingInfo info) `seq` +-- seqUnfolding (realUnfoldingInfo info) `seq` seqDemand (demandInfo info) `seq` seqDmdSig (dmdSigInfo info) `seq` diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs index 67dc4609c3..16906df1c1 100644 --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -33,7 +33,7 @@ import GHC.Core.Make ( FloatBind(..) ) import GHC.Core.Opt.OccurAnal( occurAnalyseExpr, occurAnalysePgm ) import GHC.Types.Literal import GHC.Types.Id -import GHC.Types.Id.Info ( unfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) ) +import GHC.Types.Id.Info ( realUnfoldingInfo, setUnfoldingInfo, setRuleInfo, IdInfo (..) ) import GHC.Types.Var ( isNonCoVarId ) import GHC.Types.Var.Set import GHC.Types.Var.Env @@ -667,7 +667,7 @@ add_info env old_bndr top_level new_rhs new_bndr old_rules = ruleInfo old_info new_rules = substSpec subst new_bndr old_rules - old_unfolding = unfoldingInfo old_info + old_unfolding = realUnfoldingInfo old_info new_unfolding | isStableUnfolding old_unfolding = substUnfolding subst old_unfolding | otherwise diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs index 3d93084fc4..36f3bad0d4 100644 --- a/compiler/GHC/Core/Subst.hs +++ b/compiler/GHC/Core/Subst.hs @@ -626,7 +626,7 @@ substIdInfo subst new_id info `setUnfoldingInfo` substUnfolding subst old_unf) where old_rules = ruleInfo info - old_unf = unfoldingInfo info + old_unf = realUnfoldingInfo info nothing_to_do = isEmptyRuleInfo old_rules && not (hasCoreUnfolding old_unf) ------------------ diff --git a/compiler/GHC/Core/Tidy.hs b/compiler/GHC/Core/Tidy.hs index 933e8714c4..aaf42eafd2 100644 --- a/compiler/GHC/Core/Tidy.hs +++ b/compiler/GHC/Core/Tidy.hs @@ -161,7 +161,7 @@ tidyIdBndr env@(tidy_env, var_env) id -- see Note [Preserve OneShotInfo] `setOneShotInfo` oneShotInfo old_info old_info = idInfo id - old_unf = unfoldingInfo old_info + old_unf = realUnfoldingInfo old_info new_unf = zapUnfolding old_unf -- See Note [Preserve evaluatedness] in ((tidy_env', var_env'), id') @@ -211,7 +211,7 @@ tidyLetBndr rec_tidy_env env@(tidy_env, var_env) id `setInlinePragInfo` inlinePragInfo old_info `setUnfoldingInfo` new_unf - old_unf = unfoldingInfo old_info + old_unf = realUnfoldingInfo old_info new_unf | isStableUnfolding old_unf = tidyUnfolding rec_tidy_env old_unf old_unf | otherwise = zapUnfolding old_unf -- See Note [Preserve evaluatedness] diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs index fc05566d9f..4e054ea709 100644 --- a/compiler/GHC/Core/Unfold.hs +++ b/compiler/GHC/Core/Unfold.hs @@ -967,7 +967,6 @@ certainlyWillInline :: UnfoldingOpts -> IdInfo -> Maybe Unfolding certainlyWillInline opts fn_info = case fn_unf of CoreUnfolding { uf_tmpl = expr, uf_guidance = guidance, uf_src = src } - | loop_breaker -> Nothing -- Won't inline, so try w/w | noinline -> Nothing -- See Note [Worker/wrapper for NOINLINE functions] | otherwise -> case guidance of @@ -989,9 +988,8 @@ certainlyWillInline opts fn_info _other_unf -> Nothing where - loop_breaker = isStrongLoopBreaker (occInfo fn_info) noinline = inlinePragmaSpec (inlinePragInfo fn_info) == NoInline - fn_unf = unfoldingInfo fn_info + fn_unf = unfoldingInfo fn_info -- NB: loop-breakers never inline -- The UnfIfGoodArgs case seems important. If we w/w small functions -- binary sizes go up by 10%! (This is with SplitObjs.) diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs index a9a8769259..a120bed3b0 100644 --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -2282,7 +2282,7 @@ diffIdInfo env bndr1 bndr2 && callArityInfo info1 == callArityInfo info2 && levityInfo info1 == levityInfo info2 = locBind "in unfolding of" bndr1 bndr2 $ - diffUnfold env (unfoldingInfo info1) (unfoldingInfo info2) + diffUnfold env (realUnfoldingInfo info1) (realUnfoldingInfo info2) | otherwise = locBind "in Id info of" bndr1 bndr2 [fsep [pprBndr LetBind bndr1, text "/=", pprBndr LetBind bndr2]] diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs index 4ca3065ece..2356f6c7f5 100644 --- a/compiler/GHC/CoreToIface.hs +++ b/compiler/GHC/CoreToIface.hs @@ -483,7 +483,7 @@ toIfaceIdInfo id_info cpr_hsinfo | cpr_info /= topCprSig = Just (HsCprSig cpr_info) | otherwise = Nothing ------------ Unfolding -------------- - unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info) + unfold_hsinfo = toIfUnfolding loop_breaker (realUnfoldingInfo id_info) loop_breaker = isStrongLoopBreaker (occInfo id_info) ------------ Inline prag -------------- diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs index 2a6f9ecbca..a9bcdeecc6 100644 --- a/compiler/GHC/Iface/Tidy.hs +++ b/compiler/GHC/Iface/Tidy.hs @@ -792,7 +792,7 @@ addExternal omit_prags expose_all id where new_needed_ids = bndrFvsInOrder show_unfold id idinfo = idInfo id - unfolding = unfoldingInfo idinfo + unfolding = realUnfoldingInfo idinfo show_unfold = show_unfolding unfolding never_active = isNeverActive (inlinePragmaActivation (inlinePragInfo idinfo)) loop_breaker = isStrongLoopBreaker (occInfo idinfo) @@ -916,7 +916,7 @@ dffvLetBndr :: Bool -> Id -> DFFV () -- For top-level bindings (call from addExternal, via bndrFvsInOrder) -- we say "True" if we are exposing that unfolding dffvLetBndr vanilla_unfold id - = do { go_unf (unfoldingInfo idinfo) + = do { go_unf (realUnfoldingInfo idinfo) ; mapM_ go_rule (ruleInfoRules (ruleInfo idinfo)) } where idinfo = idInfo id @@ -1306,7 +1306,7 @@ tidyTopIdInfo uf_opts rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold Just (arity, _) -> not (appIsDeadEnd id_sig arity) --------- Unfolding ------------ - unf_info = unfoldingInfo idinfo + unf_info = realUnfoldingInfo idinfo unfold_info | isCompulsoryUnfolding unf_info || show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs diff --git a/compiler/GHC/Types/Id.hs b/compiler/GHC/Types/Id.hs index 8ac7fc214b..1c990cba9f 100644 --- a/compiler/GHC/Types/Id.hs +++ b/compiler/GHC/Types/Id.hs @@ -94,7 +94,7 @@ module GHC.Types.Id ( -- ** Reading 'IdInfo' fields idArity, idCallArity, idFunRepArity, - idUnfolding, realIdUnfolding, hasInlineUnfolding, + idUnfolding, realIdUnfolding, idSpecialisation, idCoreRules, idHasRules, idCafInfo, idLFInfo_maybe, idOneShotInfo, idStateHackOneShotInfo, @@ -124,8 +124,7 @@ module GHC.Types.Id ( import GHC.Prelude import GHC.Core ( CoreRule, isStableUnfolding, evaldUnfolding, - isCompulsoryUnfolding, isInlineUnfolding, - Unfolding( NoUnfolding ) ) + isCompulsoryUnfolding, Unfolding( NoUnfolding ) ) import GHC.Types.Id.Info import GHC.Types.Basic @@ -711,25 +710,19 @@ isStrictId id isStrUsedDmd (idDemandInfo id) -- Take the best of both strictnesses - old and new - --------------------------------- - -- UNFOLDING -idUnfolding :: Id -> Unfolding --- Do not expose the unfolding of a loop breaker! -idUnfolding id - | isStrongLoopBreaker (occInfo info) = NoUnfolding - | otherwise = unfoldingInfo info - where - info = idInfo id +--------------------------------- +-- UNFOLDING -hasInlineUnfolding :: Id -> Bool --- ^ True of a non-loop-breaker Id that has a /stable/ unfolding that is --- (a) always inlined; that is, with an `UnfWhen` guidance, or --- (b) a DFunUnfolding which never needs to be inlined -hasInlineUnfolding id = isInlineUnfolding (idUnfolding id) +-- | Returns the 'Id's unfolding, but does not expose the unfolding of a strong +-- loop breaker. See 'unfoldingInfo'. +-- +-- If you really want the unfolding of a strong loopbreaker, call 'realIdUnfolding'. +idUnfolding :: Id -> Unfolding +idUnfolding id = unfoldingInfo (idInfo id) realIdUnfolding :: Id -> Unfolding --- Expose the unfolding if there is one, including for loop breakers -realIdUnfolding id = unfoldingInfo (idInfo id) +-- ^ Expose the unfolding if there is one, including for loop breakers +realIdUnfolding id = realUnfoldingInfo (idInfo id) setIdUnfolding :: Id -> Unfolding -> Id setIdUnfolding id unfolding = modifyIdInfo (`setUnfoldingInfo` unfolding) id diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs index e0204330d9..7a6d321042 100644 --- a/compiler/GHC/Types/Id/Info.hs +++ b/compiler/GHC/Types/Id/Info.hs @@ -47,7 +47,7 @@ module GHC.Types.Id.Info ( demandInfo, setDemandInfo, pprStrictness, -- ** Unfolding Info - unfoldingInfo, setUnfoldingInfo, + realUnfoldingInfo, unfoldingInfo, setUnfoldingInfo, hasInlineUnfolding, -- ** The InlinePragInfo type InlinePragInfo, @@ -255,7 +255,7 @@ data IdInfo ruleInfo :: RuleInfo, -- ^ Specialisations of the 'Id's function which exist. -- See Note [Specialisations and RULES in IdInfo] - unfoldingInfo :: Unfolding, + realUnfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding inlinePragInfo :: InlinePragma, -- ^ Any inline pragma attached to the 'Id' @@ -377,13 +377,29 @@ setOccInfo :: IdInfo -> OccInfo -> IdInfo setOccInfo info oc = oc `seq` info { occInfo = oc } -- Try to avoid space leaks by seq'ing +-- | Essentially returns the 'realUnfoldingInfo' field, but does not expose the +-- unfolding of a strong loop breaker. +-- +-- This is the right thing to call if you plan to decide whether an unfolding +-- will inline. +unfoldingInfo :: IdInfo -> Unfolding +unfoldingInfo info + | isStrongLoopBreaker (occInfo info) = zapUnfolding $ realUnfoldingInfo info + | otherwise = realUnfoldingInfo info + setUnfoldingInfo :: IdInfo -> Unfolding -> IdInfo setUnfoldingInfo info uf = -- We don't seq the unfolding, as we generate intermediate -- unfoldings which are just thrown away, so evaluating them is a -- waste of time. -- seqUnfolding uf `seq` - info { unfoldingInfo = uf } + info { realUnfoldingInfo = uf } + +hasInlineUnfolding :: IdInfo -> Bool +-- ^ True of a /non-loop-breaker/ Id that has a /stable/ unfolding that is +-- (a) always inlined; that is, with an `UnfWhen` guidance, or +-- (b) a DFunUnfolding which never needs to be inlined +hasInlineUnfolding info = isInlineUnfolding (unfoldingInfo info) setArityInfo :: IdInfo -> ArityInfo -> IdInfo setArityInfo info ar = @@ -418,7 +434,7 @@ vanillaIdInfo :: IdInfo vanillaIdInfo = IdInfo { ruleInfo = emptyRuleInfo, - unfoldingInfo = noUnfolding, + realUnfoldingInfo = noUnfolding, inlinePragInfo = defaultInlinePragma, occInfo = noOccInfo, demandInfo = topDmd, @@ -659,7 +675,7 @@ zapUsedOnceInfo info zapFragileInfo :: IdInfo -> Maybe IdInfo -- ^ Zap info that depends on free variables -zapFragileInfo info@(IdInfo { occInfo = occ, unfoldingInfo = unf }) +zapFragileInfo info@(IdInfo { occInfo = occ, realUnfoldingInfo = unf }) = new_unf `seq` -- The unfolding field is not (currently) strict, so we -- force it here to avoid a (zapFragileUnfolding unf) thunk -- which might leak space |