-calcU%
+%
% (c) The University of Glasgow 2006
% (c) The AQUA Project, Glasgow University, 1994-1998
%
%************************************************************************
\begin{code}
-mkTopUnfolding :: CoreExpr -> Unfolding
-mkTopUnfolding expr = mkUnfolding True {- Top level -} expr
+mkTopUnfolding :: Bool -> CoreExpr -> Unfolding
+mkTopUnfolding is_bottoming expr
+ = mkUnfolding True {- Top level -} is_bottoming expr
mkImplicitUnfolding :: CoreExpr -> Unfolding
-- For implicit Ids, do a tiny bit of optimising first
-mkImplicitUnfolding expr = mkTopUnfolding (simpleOptExpr expr)
+mkImplicitUnfolding expr = mkTopUnfolding False (simpleOptExpr expr)
-- Note [Top-level flag on inline rules]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- top-level flag to True. It gets set more accurately by the simplifier
-- Simplify.simplUnfolding.
-mkUnfolding :: Bool -> CoreExpr -> Unfolding
-mkUnfolding top_lvl expr
+mkUnfolding :: Bool -> Bool -> CoreExpr -> Unfolding
+mkUnfolding top_lvl is_bottoming expr
= CoreUnfolding { uf_tmpl = occurAnalyseExpr expr,
uf_src = InlineRhs,
uf_arity = arity,
uf_guidance = guidance }
where
is_cheap = exprIsCheap expr
- (arity, guidance) = calcUnfoldingGuidance is_cheap opt_UF_CreationThreshold expr
+ (arity, guidance) = calcUnfoldingGuidance is_cheap (top_lvl && is_bottoming)
+ opt_UF_CreationThreshold expr
-- Sometimes during simplification, there's a large let-bound thing
-- which has been substituted, and so is now dead; so 'expr' contains
-- two copies of the thing while the occurrence-analysed expression doesn't
where
expr' = simpleOptExpr expr
boring_ok = case calcUnfoldingGuidance True -- Treat as cheap
+ False -- But not bottoming
(arity+1) expr' of
(_, UnfWhen _ boring_ok) -> boring_ok
_other -> boringCxtNotOk
calcUnfoldingGuidance
:: Bool -- True <=> the rhs is cheap, or we want to treat it
-- as cheap (INLINE things)
+ -> Bool -- True <=> this is a top-level unfolding for a
+ -- diverging function; don't inline this
-> Int -- Bomb out if size gets bigger than this
-> CoreExpr -- Expression to look at
-> (Arity, UnfoldingGuidance)
-calcUnfoldingGuidance expr_is_cheap bOMB_OUT_SIZE expr
+calcUnfoldingGuidance expr_is_cheap top_bot bOMB_OUT_SIZE expr
= case collectBinders expr of { (bndrs, body) ->
let
val_bndrs = filter isId bndrs
| uncondInline n_val_bndrs (iBox size) && expr_is_cheap
-> UnfWhen needSaturated boringCxtOk
+ | top_bot -- See Note [Do not inline top-level bottoming functions]
+ -> UnfNever
+
| otherwise
-> UnfIfGoodArgs { ug_args = map (discount cased_bndrs) val_bndrs
, ug_size = iBox size
a function call to account for. Notice also that constructor applications
are very cheap, because exposing them to a caller is so valuable.
+
+Note [Do not inline top-level bottoming functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The FloatOut pass has gone to some trouble to float out calls to 'error'
+and similar friends. See Note [Bottoming floats] in SetLevels.
+Do not re-inline them! But we *do* still inline if they are very small
+(the uncondInline stuff).
+
+
Note [Unconditional inlining]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We inline *unconditionally* if inlined thing is smaller (using sizeExpr)
\begin{code}
couldBeSmallEnoughToInline :: Int -> CoreExpr -> Bool
couldBeSmallEnoughToInline threshold rhs
- = case calcUnfoldingGuidance False threshold rhs of
+ = case calcUnfoldingGuidance False False threshold rhs of
(_, UnfNever) -> False
_ -> True
toIfaceIdInfo id_info
= catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
inline_hsinfo, unfold_hsinfo]
+ -- NB: strictness must be before unfolding
+ -- See TcIface.tcUnfolding
where
------------ Arity --------------
arity_info = arityInfo id_info
import Name
import NameEnv
import OccurAnal ( occurAnalyseExpr )
+import Demand ( isBottomingSig )
import Module
import LazyUniqFM
import UniqSupply
\begin{code}
tcUnfolding :: Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding
-tcUnfolding name _ _ (IfCoreUnfold if_expr)
+tcUnfolding name _ info (IfCoreUnfold if_expr)
= do { mb_expr <- tcPragExpr name if_expr
; return (case mb_expr of
Nothing -> NoUnfolding
- Just expr -> mkTopUnfolding expr) }
+ Just expr -> mkTopUnfolding is_bottoming expr) }
+ where
+ -- Strictness should occur before unfolding!
+ is_bottoming = case strictnessInfo info of
+ Just sig -> isBottomingSig sig
+ Nothing -> False
tcUnfolding name _ _ (IfInlineRule arity unsat_ok if_expr)
= do { mb_expr <- tcPragExpr name if_expr
(initUs_ us (mkWrapper ty strict_sig) wkr_id)
arity
- -- We are relying here on strictness info always appearing
- -- before worker info, fingers crossed ....
+ -- Again we rely here on strictness info always appearing
+ -- before unfolding
strict_sig = case strictnessInfo info of
Just sig -> sig
Nothing -> pprPanic "Worker info but no strictness for" (ppr wkr)
-- the RHS is bottom, it should jolly well be exposed
_bottom_exposed = case exprBotStrictness_maybe rhs of
Nothing -> True
- Just (arity, _) -> appIsBottom str arity
+ Just (arity, _) -> appIsBottom str_sig arity
where
- str = strictnessInfo idinfo `orElse` topSig
-
- bndr1 = mkGlobalId details name' ty' idinfo'
- details = idDetails bndr -- Preserve the IdDetails
- ty' = tidyTopType (idType bndr)
- rhs1 = tidyExpr rhs_tidy_env rhs
- idinfo = idInfo bndr
- idinfo' = tidyTopIdInfo (isExternalName name')
+
+
+ bndr1 = mkGlobalId details name' ty' idinfo'
+ details = idDetails bndr -- Preserve the IdDetails
+ ty' = tidyTopType (idType bndr)
+ rhs1 = tidyExpr rhs_tidy_env rhs
+ idinfo = idInfo bndr
+ unf_info = unfoldingInfo idinfo
+ str_sig = strictnessInfo idinfo `orElse` topSig
+ is_bot = isBottomingSig str_sig
+ idinfo' = tidyTopIdInfo (isExternalName name')
idinfo unfold_info
arity caf_info
(occInfo idinfo)
- unfold_info | show_unfold = tidyUnfolding rhs_tidy_env rhs1 (unfoldingInfo idinfo)
+ unfold_info | show_unfold = tidyUnfolding rhs_tidy_env rhs1 is_bot unf_info
| otherwise = noUnfolding
-- NB: do *not* expose the worker if show_unfold is off,
-- because that means this thing is a loop breaker or
------------ Unfolding --------------
-tidyUnfolding :: TidyEnv -> CoreExpr -> Unfolding -> Unfolding
-tidyUnfolding tidy_env _ (DFunUnfolding con ids)
+tidyUnfolding :: TidyEnv -> CoreExpr -> Bool -> Unfolding -> Unfolding
+tidyUnfolding tidy_env _ _ (DFunUnfolding con ids)
= DFunUnfolding con (map (tidyExpr tidy_env) ids)
-tidyUnfolding tidy_env tidy_rhs unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
+tidyUnfolding tidy_env tidy_rhs is_bottoming
+ unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
| isInlineRuleSource src
= unf { uf_tmpl = tidyExpr tidy_env unf_rhs, -- Preserves OccInfo
uf_src = tidyInl tidy_env src }
| otherwise
- = mkTopUnfolding tidy_rhs
-tidyUnfolding _ _ unf = unf
+ = mkTopUnfolding is_bottoming tidy_rhs
+tidyUnfolding _ _ _ unf = unf
tidyInl :: TidyEnv -> UnfoldingSource -> UnfoldingSource
tidyInl tidy_env (InlineWrapper w) = InlineWrapper (tidyVarOcc tidy_env w)
import CoreSyn
import CoreUtils
+import CoreArity ( etaExpand )
import DynFlags ( DynFlags, DynFlag(..), FloatOutSwitches(..) )
import ErrUtils ( dumpIfSet_dyn )
import CostCentre ( dupifyCC, CostCentre )
-import Id ( Id, idType )
+import Id ( Id, idType, idArity, isBottomingId )
import Type ( isUnLiftedType )
import SetLevels ( Level(..), LevelledExpr, LevelledBind,
setLevels, isTopLvl, tOP_LEVEL )
%* *
%************************************************************************
-
\begin{code}
floatBind :: LevelledBind -> (FloatStats, FloatBinds)
-floatBind (NonRec (TB name level) rhs)
+floatBind (NonRec (TB var level) rhs)
= case (floatRhs level rhs) of { (fs, rhs_floats, rhs') ->
- (fs, rhs_floats `plusFloats` unitFloat level (NonRec name rhs')) }
+
+ -- A tiresome hack:
+ -- see Note [Bottoming floats: eta expansion] in SetLevels
+ let rhs'' | isBottomingId var = etaExpand (idArity var) rhs'
+ | otherwise = rhs'
+
+ in (fs, rhs_floats `plusFloats` unitFloat level (NonRec var rhs'')) }
floatBind bind@(Rec pairs)
= case (unzip3 (map do_pair pairs)) of { (fss, rhss_floats, new_pairs) ->
(fs, floating_defns, Cast expr' co) }
floatExpr lvl (Let (NonRec (TB bndr bndr_lvl) rhs) body)
- | isUnLiftedType (idType bndr) -- Treat unlifted lets just like a case
- -- I.e. floatExpr for rhs, floatCaseAlt for body
+ | isUnLiftedType (idType bndr) -- Treat unlifted lets just like a case
+ -- I.e. floatExpr for rhs, floatCaseAlt for body
= case floatExpr lvl rhs of { (_, rhs_floats, rhs') ->
case floatCaseAlt bndr_lvl body of { (fs, body_floats, body') ->
(fs, rhs_floats `plusFloats` body_floats, Let (NonRec bndr rhs') body') }}
import CoreSyn
import DynFlags ( FloatOutSwitches(..) )
-import CoreUtils ( exprType, exprIsTrivial, mkPiTypes )
+import CoreUtils ( exprType, mkPiTypes )
import CoreArity ( exprBotStrictness_maybe )
import CoreFVs -- all of it
import CoreSubst ( Subst, emptySubst, extendInScope, extendInScopeList,
extendIdSubst, cloneIdBndr, cloneRecIdBndrs )
-import Id ( idType, mkSysLocal, isOneShotLambda,
+import Id ( idType, mkLocalIdWithInfo, mkSysLocal, isOneShotLambda,
zapDemandIdInfo, transferPolyIdInfo,
idSpecialisation, idUnfolding, setIdInfo,
setIdStrictness, setIdArity
import Var
import VarSet
import VarEnv
-import Name ( getOccName )
+import Demand ( StrictSig, increaseStrictSigArity )
+import Name ( getOccName, mkSystemVarName )
import OccName ( occNameString )
import Type ( isUnLiftedType, Type )
-import BasicTypes ( TopLevelFlag(..) )
+import BasicTypes ( TopLevelFlag(..), Arity )
import UniqSupply
import Util ( sortLe, isSingleton, count )
import Outputable
we'd like to float the call to error, to get
lvl = error "urk"
f = \x. g lvl
-But, it's very helpful for lvl to get a strictness signature, so that,
-for example, its unfolding is not exposed in interface files (unnecessary).
-But this float-out might occur after strictness analysis. So we use the
-cheap-and-cheerful exprBotStrictness_maybe function.
+Furthermore, we want to float a bottoming expression even if it has free
+variables:
+ f = \x. g (let v = h x in error ("urk" ++ v))
+Then we'd like to abstact over 'x' can float the whole arg of g:
+ lvl = \x. let v = h x in error ("urk" ++ v)
+ f = \x. g (lvl x)
+See Maessen's paper 1999 "Bottom extraction: factoring error handling out
+of functional programs" (unpublished I think).
+
+When we do this, we set the strictness and arity of the new bottoming
+Id, so that it's properly exposed as such in the interface file, even if
+this is all happening after strictness analysis.
+
+Note [Bottoming floats: eta expansion] c.f Note [Bottoming floats]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Tiresomely, though, the simplifier has an invariant that the manifest
+arity of the RHS should be the same as the arity; but we can't call
+etaExpand during SetLevels because it works over a decorated form of
+CoreExpr. So we do the eta expansion later, in FloatOut.
Note [Case MFEs]
~~~~~~~~~~~~~~~~
lvlMFE strict_ctxt ctxt_lvl env ann_expr@(fvs, _)
| isUnLiftedType ty -- Can't let-bind it; see Note [Unlifted MFEs]
- || exprIsTrivial expr -- Never float if it's trivial
+ || notWorthFloating ann_expr abs_vars
|| not good_destination
= -- Don't float it out
lvlExpr ctxt_lvl env ann_expr
| otherwise -- Float it out!
= do expr' <- lvlFloatRhs abs_vars dest_lvl env ann_expr
- var <- newLvlVar "lvl" abs_vars ty
- -- Note [Bottoming floats]
- let var_w_str = case exprBotStrictness_maybe expr of
- Just (arity,str) -> var `setIdArity` arity
- `setIdStrictness` str
- Nothing -> var
- return (Let (NonRec (TB var_w_str dest_lvl) expr')
- (mkVarApps (Var var_w_str) abs_vars))
+ var <- newLvlVar abs_vars ty mb_bot
+ return (Let (NonRec (TB var dest_lvl) expr')
+ (mkVarApps (Var var) abs_vars))
where
expr = deAnnotate ann_expr
ty = exprType expr
- dest_lvl = destLevel env fvs (isFunction ann_expr)
+ mb_bot = exprBotStrictness_maybe expr
+ dest_lvl = destLevel env fvs (isFunction ann_expr) mb_bot
abs_vars = abstractVars dest_lvl env fvs
-- A decision to float entails let-binding this thing, and we only do
-- concat = /\ a -> lvl a
-- lvl = /\ a -> foldr ..a.. (++) []
-- which is pretty stupid. Hence the strict_ctxt test
+
+annotateBotStr :: Id -> Maybe (Arity, StrictSig) -> Id
+annotateBotStr id Nothing = id
+annotateBotStr id (Just (arity,sig)) = id `setIdArity` arity
+ `setIdStrictness` sig
+
+notWorthFloating :: CoreExprWithFVs -> [Var] -> Bool
+-- Returns True if the expression would be replaced by
+-- something bigger than it is now. For example:
+-- abs_vars = tvars only: return True if e is trivial,
+-- but False for anything bigger
+-- abs_vars = [x] (an Id): return True for trivial, or an application (f x)
+-- but False for (f x x)
+--
+-- One big goal is that floating should be idempotent. Eg if
+-- we replace e with (lvl79 x y) and then run FloatOut again, don't want
+-- to replace (lvl79 x y) with (lvl83 x y)!
+
+notWorthFloating e abs_vars
+ = go e (count isId abs_vars)
+ where
+ go (_, AnnVar {}) n = n == 0
+ go (_, AnnLit {}) n = n == 0
+ go (_, AnnCast e _) n = go e n
+ go (_, AnnApp e arg) n
+ | (_, AnnType {}) <- arg = go e n
+ | n==0 = False
+ | is_triv arg = go e (n-1)
+ | otherwise = False
+ go _ _ = False
+
+ is_triv (_, AnnLit {}) = True -- Treat all literals as trivial
+ is_triv (_, AnnVar {}) = True -- (ie not worth floating)
+ is_triv (_, AnnCast e _) = is_triv e
+ is_triv (_, AnnApp e (_, AnnType {})) = is_triv e
+ is_triv _ = False
\end{code}
Note [Escaping a value lambda]
| otherwise
= do -- Yes, type abstraction; create a new binder, extend substitution, etc
rhs' <- lvlFloatRhs abs_vars dest_lvl env rhs
- (env', [bndr']) <- newPolyBndrs dest_lvl env abs_vars [bndr]
+ (env', [bndr']) <- newPolyBndrs dest_lvl env abs_vars [bndr_w_str]
return (NonRec (TB bndr' dest_lvl) rhs', env')
where
- bind_fvs = rhs_fvs `unionVarSet` idFreeVars bndr
- abs_vars = abstractVars dest_lvl env bind_fvs
- dest_lvl = destLevel env bind_fvs (isFunction rhs)
+ bind_fvs = rhs_fvs `unionVarSet` idFreeVars bndr
+ abs_vars = abstractVars dest_lvl env bind_fvs
+ dest_lvl = destLevel env bind_fvs (isFunction rhs) mb_bot
+ mb_bot = exprBotStrictness_maybe (deAnnotate rhs)
+ bndr_w_str = annotateBotStr bndr mb_bot
\end{code}
`minusVarSet`
mkVarSet bndrs
- dest_lvl = destLevel env bind_fvs (all isFunction rhss)
+ dest_lvl = destLevel env bind_fvs (all isFunction rhss) Nothing
abs_vars = abstractVars dest_lvl env bind_fvs
----------------------------------------------------
\begin{code}
-- Destintion level is the max Id level of the expression
-- (We'll abstract the type variables, if any.)
-destLevel :: LevelEnv -> VarSet -> Bool -> Level
-destLevel env fvs is_function
+destLevel :: LevelEnv -> VarSet -> Bool -> Maybe (Arity, StrictSig) -> Level
+destLevel env fvs is_function mb_bot
+ | Just {} <- mb_bot = tOP_LEVEL -- Send bottoming bindings to the top
+ -- regardless; see Note [Bottoming floats]
| floatLams env
- && is_function = tOP_LEVEL -- Send functions to top level; see
+ && is_function = tOP_LEVEL -- Send functions to top level; see
-- the comments with isFunction
- | otherwise = maxIdLevel env fvs
+ | otherwise = maxIdLevel env fvs
isFunction :: CoreExprWithFVs -> Bool
-- The idea here is that we want to float *functions* to
str = "poly_" ++ occNameString (getOccName bndr)
poly_ty = mkPiTypes abs_vars (idType bndr)
-newLvlVar :: String
- -> [CoreBndr] -> Type -- Abstract wrt these bndrs
+newLvlVar :: [CoreBndr] -> Type -- Abstract wrt these bndrs
+ -> Maybe (Arity, StrictSig) -- Note [Bottoming floats]
-> LvlM Id
-newLvlVar str vars body_ty = do
- uniq <- getUniqueM
- return (mkSysLocal (mkFastString str) uniq (mkPiTypes vars body_ty))
+newLvlVar vars body_ty mb_bot
+ = do { uniq <- getUniqueM
+ ; return (mkLocalIdWithInfo (mk_name uniq) (mkPiTypes vars body_ty) info) }
+ where
+ mk_name uniq = mkSystemVarName uniq (mkFastString "lvl")
+ arity = count isId vars
+ info = case mb_bot of
+ Nothing -> vanillaIdInfo
+ Just (bot_arity, sig) -> vanillaIdInfo
+ `setArityInfo` (arity + bot_arity)
+ `setStrictnessInfo` Just (increaseStrictSigArity arity sig)
-- The deeply tiresome thing is that we have to apply the substitution
-- to the rules inside each Id. Grr. But it matters.
However, as usual for Gentle mode, do not inline things that are
inactive in the intial stages. See Note [Gentle mode].
+Note [Top-level botomming Ids]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Don't inline top-level Ids that are bottoming, even if they are used just
+once, because FloatOut has gone to some trouble to extract them out.
+Inlining them won't make the program run faster!
+
\begin{code}
preInlineUnconditionally :: SimplEnv -> TopLevelFlag -> InId -> InExpr -> Bool
preInlineUnconditionally env top_lvl bndr rhs
- | not active = False
- | opt_SimplNoPreInlining = False
+ | not active = False
+ | isTopLevel top_lvl && isBottomingId bndr = False -- Note [Top-level bottoming Ids]
+ | opt_SimplNoPreInlining = False
| otherwise = case idOccInfo bndr of
IAmDead -> True -- Happens in ((\x.1) v)
OneOcc in_lam True int_cxt -> try_once in_lam int_cxt
-- See Note [pre/postInlineUnconditionally in gentle mode]
SimplPhase n _ -> isActive n act
act = idInlineActivation bndr
-
try_once in_lam int_cxt -- There's one textual occurrence
| not in_lam = isNotTopLevel top_lvl || early_phase
| otherwise = int_cxt && canInlineInLam rhs
--- Be very careful before inlining inside a lambda, becuase (a) we must not
+-- Be very careful before inlining inside a lambda, because (a) we must not
-- invalidate occurrence information, and (b) we want to avoid pushing a
-- single allocation (here) into multiple allocations (inside lambda).
-- Inlining a *function* with a single *saturated* call would be ok, mind you.
| isExportedId bndr = False
| isStableUnfolding unfolding = False -- Note [InlineRule and postInlineUnconditionally]
| exprIsTrivial rhs = True
+ | isTopLevel top_lvl = False -- Note [Top level and postInlineUnconditionally]
| otherwise
= case occ_info of
-- The point of examining occ_info here is that for *non-values*
-- PRINCIPLE: when we've already simplified an expression once,
-- make sure that we only inline it if it's reasonably small.
- && ((isNotTopLevel top_lvl && not in_lam) ||
- -- But outside a lambda, we want to be reasonably aggressive
+ && (not in_lam ||
+ -- Outside a lambda, we want to be reasonably aggressive
-- about inlining into multiple branches of case
-- e.g. let x = <non-value>
-- in case y of { C1 -> ..x..; C2 -> ..x..; C3 -> ... }
SimplPhase n _ -> Just (isActive n)
\end{code}
+Note [Top level and postInlineUnconditionally]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We don't do postInlineUnconditionally for top-level things (except
+ones that are trivial). There is no point, because the main goal is
+to get rid of local bindings used in multiple case branches. And
+doing so risks replacing a single global allocation with local allocations.
+
+
Note [InlineRule and postInlineUnconditionally]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Do not do postInlineUnconditionally if the Id has an InlineRule, otherwise
------------------------------
simplUnfolding :: SimplEnv-> TopLevelFlag
- -> Id -- Debug output only
+ -> Id
-> OccInfo -> OutExpr
-> Unfolding -> SimplM Unfolding
-- Note [Setting the new unfolding]
; return (mkCoreUnfolding (isTopLevel top_lvl) src' expr' arity guide) }
-- See Note [Top-level flag on inline rules] in CoreUnfold
-simplUnfolding _ top_lvl _ _occ_info new_rhs _
- = return (mkUnfolding (isTopLevel top_lvl) new_rhs)
+simplUnfolding _ top_lvl id _occ_info new_rhs _
+ = return (mkUnfolding (isTopLevel top_lvl) (isBottomingId id) new_rhs)
-- We make an unfolding *even for loop-breakers*.
-- Reason: (a) It might be useful to know that they are WHNF
-- (b) In TidyPgm we currently assume that, if we want to
addBinderUnfolding :: SimplEnv -> Id -> CoreExpr -> SimplEnv
addBinderUnfolding env bndr rhs
- = modifyInScope env (bndr `setIdUnfolding` mkUnfolding False rhs)
+ = modifyInScope env (bndr `setIdUnfolding` mkUnfolding False False rhs)
addBinderOtherCon :: SimplEnv -> Id -> [AltCon] -> SimplEnv
addBinderOtherCon env bndr cons
-- No auxiliary binding necessary
| otherwise = go subst_w_unf (NonRec dx_id dx : binds) pairs
where
- dx_id1 = dx_id `setIdUnfolding` mkUnfolding False dx
+ dx_id1 = dx_id `setIdUnfolding` mkUnfolding False False dx
subst_w_unf = extendIdSubst subst d (Var dx_id1)
-- Important! We're going to substitute dx_id1 for d
-- and we want it to look "interesting", else we won't gather *any*