2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 %************************************************************************
6 \section[OccurAnal]{Occurrence analysis pass}
8 %************************************************************************
10 The occurrence analyser re-typechecks a core expression, returning a new
11 core expression with (hopefully) improved usage information.
15 occurAnalyseBinds, occurAnalyseExpr, occurAnalyseGlobalExpr
18 #include "HsVersions.h"
21 import CmdLineOpts ( opt_D_dump_occur_anal, SimplifierSwitch(..) )
23 import Digraph ( stronglyConnCompR, SCC(..) )
24 import Id ( idWantsToBeINLINEd, addNoInlinePragma, nukeNoInlinePragma,
25 omitIfaceSigForId, isSpecPragmaId,
27 emptyIdSet, unionIdSets, mkIdSet,
31 IdEnv, nullIdEnv, unitIdEnv, combineIdEnvs,
32 delOneFromIdEnv, delManyFromIdEnv, isNullIdEnv,
33 mapIdEnv, lookupIdEnv, elemIdEnv, addOneToIdEnv
35 import Specialise ( idSpecVars )
36 import Name ( isExported, isLocallyDefined )
37 import Type ( splitFunTy_maybe, splitForAllTys )
38 import Maybes ( maybeToBool )
41 import UniqFM ( keysUFM )
42 import Util ( zipWithEqual )
47 %************************************************************************
49 \subsection[OccurAnal-main]{Counting occurrences: main function}
51 %************************************************************************
53 Here's the externally-callable interface:
57 :: [CoreBinding] -- input
58 -> (SimplifierSwitch -> Bool)
59 -> [SimplifiableCoreBinding] -- output
61 occurAnalyseBinds binds simplifier_sw_chkr
62 | opt_D_dump_occur_anal = pprTrace "OccurAnal:"
63 (pprGenericBindings binds')
67 (_, _, binds') = occAnalTop initial_env binds
69 initial_env = OccEnv (simplifier_sw_chkr IgnoreINLINEPragma)
70 (\id in_scope -> isLocallyDefined id) -- Anything local is interesting
71 emptyIdSet -- Not actually used
76 occurAnalyseExpr :: (Id -> Bool) -- Tells if a variable is interesting
78 -> (IdEnv BinderInfo, -- Occ info for interesting free vars
81 occurAnalyseExpr interesting expr
82 = occAnal initial_env expr
84 initial_env = OccEnv False {- Do not ignore INLINE Pragma -}
85 (\id locals -> interesting id || elementOfIdSet id locals)
88 occurAnalyseGlobalExpr :: CoreExpr -> SimplifiableCoreExpr
89 occurAnalyseGlobalExpr expr
90 = -- Top level expr, so no interesting free vars, and
91 -- discard occurence info returned
92 snd (occurAnalyseExpr (\_ -> False) expr)
96 %************************************************************************
98 \subsection{Top level stuff}
100 %************************************************************************
102 In @occAnalTop@ we do indirection-shorting. That is, if we have this:
108 where exp is exported, and loc is not, then we replace it with this:
114 Without this we never get rid of the exp = loc thing.
115 This save a gratuitous jump
116 (from \tr{x_exported} to \tr{x_local}), and makes strictness
117 information propagate better.
118 This used to happen in the final phase, but its tidier to do it here.
121 If more than one exported thing is equal to a local thing (i.e., the
122 local thing really is shared), then we do one only:
125 x_exported1 = x_local
126 x_exported2 = x_local
130 x_exported2 = x_exported1
133 We rely on prior eta reduction to simplify things like
135 x_exported = /\ tyvars -> x_local tyvars
139 Hence,there's a possibility of leaving unchanged something like this:
142 x_exported1 = x_local Int
144 By the time we've thrown away the types in STG land this
145 could be eliminated. But I don't think it's very common
146 and it's dangerous to do this fiddling in STG land
147 because we might elminate a binding that's mentioned in the
148 unfolding for something.
152 occAnalTop :: OccEnv -- What's in scope
154 -> (IdEnv BinderInfo, -- Occurrence info
155 IdEnv Id, -- Indirection elimination info
156 [SimplifiableCoreBinding]
159 occAnalTop env [] = (emptyDetails, nullIdEnv, [])
161 -- Special case for eliminating indirections
162 -- Note: it's a shortcoming that this only works for
163 -- non-recursive bindings. Elminating indirections
164 -- makes perfect sense for recursive bindings too, but
165 -- it's more complicated to implement, so I haven't done so
167 occAnalTop env (NonRec exported_id (Var local_id) : binds)
168 | isExported exported_id && -- Only if this is exported
170 isLocallyDefined local_id && -- Only if this one is defined in this
171 -- module, so that we *can* change its
172 -- binding to be the exported thing!
174 not (isExported local_id) && -- Only if this one is not itself exported,
175 -- since the transformation will nuke it
177 not (omitIfaceSigForId local_id) && -- Don't do the transformation if rhs_id is
178 -- something like a constructor, whose
179 -- definition is implicitly exported and
180 -- which must not vanish.
181 -- To illustrate the preceding check consider
185 -- Here, we'll make a local, non-exported, defn for MkT, and without the
186 -- above condition we'll transform it to:
189 -- This is bad because mkT will get the IdDetails of MkT, and won't
190 -- be exported. Also the code generator won't make a definition for
191 -- the MkT constructor.
192 -- Slightly gruesome, this.
195 not (maybeToBool (lookupIdEnv ind_env local_id))
196 -- Only if not already substituted for
198 = -- Aha! An indirection; let's eliminate it!
199 (scope_usage, ind_env', binds')
201 (scope_usage, ind_env, binds') = occAnalTop env binds
202 ind_env' = addOneToIdEnv ind_env local_id exported_id
205 occAnalTop env (bind : binds)
206 = (final_usage, ind_env, new_binds ++ binds')
208 new_env = env `addNewCands` (bindersOf bind)
209 (scope_usage, ind_env, binds') = occAnalTop new_env binds
210 (final_usage, new_binds) = occAnalBind env (zap_bind bind) scope_usage
212 -- Deal with any indirections
213 zap_bind (NonRec bndr rhs)
214 | bndr `elemIdEnv` ind_env = Rec (zap (bndr,rhs))
215 -- The Rec isn't strictly necessary, but it's convenient
217 | or [id `elemIdEnv` ind_env | (id,_) <- pairs] = Rec (concat (map zap pairs))
221 zap pair@(bndr,rhs) = case lookupIdEnv ind_env bndr of
223 Just exported_id -> [(bndr, Var exported_id),
228 %************************************************************************
230 \subsection[OccurAnal-main]{Counting occurrences: main function}
232 %************************************************************************
238 type Node details = (details, Int, [Int]) -- The Ints are gotten from the Unique,
239 -- which is gotten from the Id.
240 type Details1 = (Id, UsageDetails, SimplifiableCoreExpr)
241 type Details2 = ((Id, BinderInfo), SimplifiableCoreExpr)
244 occAnalBind :: OccEnv
246 -> UsageDetails -- Usage details of scope
247 -> (UsageDetails, -- Of the whole let(rec)
248 [SimplifiableCoreBinding])
250 occAnalBind env (NonRec binder rhs) body_usage
251 | isNeeded env body_usage binder -- It's mentioned in body
252 = (final_body_usage `combineUsageDetails` rhs_usage,
253 [NonRec tagged_binder rhs'])
255 | otherwise -- Not mentioned, so drop dead code
259 binder' = nukeNoInlinePragma binder
260 (rhs_usage, rhs') = occAnalRhs env binder' rhs
261 (final_body_usage, tagged_binder) = tagBinder body_usage binder'
264 Dropping dead code for recursive bindings is done in a very simple way:
266 the entire set of bindings is dropped if none of its binders are
267 mentioned in its body; otherwise none are.
269 This seems to miss an obvious improvement.
284 Now @f@ is unused. But dependency analysis will sort this out into a
285 @letrec@ for @g@ and a @let@ for @f@, and then @f@ will get dropped.
286 It isn't easy to do a perfect job in one blow. Consider
300 occAnalBind env (Rec pairs) body_usage
301 = foldr (_scc_ "occAnalBind.dofinal" do_final_bind) (body_usage, []) sccs
303 pp_item (_, bndr, _) = ppr bndr
305 binders = map fst pairs
306 new_env = env `addNewCands` binders
308 analysed_pairs :: [Details1]
309 analysed_pairs = [ (nukeNoInlinePragma bndr, rhs_usage, rhs')
310 | (bndr, rhs) <- pairs,
311 let (rhs_usage, rhs') = occAnalRhs new_env bndr rhs
314 sccs :: [SCC (Node Details1)]
315 sccs = _scc_ "occAnalBind.scc" stronglyConnCompR edges
318 ---- stuff for dependency analysis of binds -------------------------------
319 edges :: [Node Details1]
320 edges = _scc_ "occAnalBind.assoc"
321 [ (details, IBOX(u2i (idUnique id)), edges_from rhs_usage)
322 | details@(id, rhs_usage, rhs) <- analysed_pairs
325 -- (a -> b) means a mentions b
326 -- Given the usage details (a UFM that gives occ info for each free var of
327 -- the RHS) we can get the list of free vars -- or rather their Int keys --
328 -- by just extracting the keys from the finite map. Grimy, but fast.
329 -- Previously we had this:
330 -- [ bndr | bndr <- bndrs,
331 -- maybeToBool (lookupIdEnv rhs_usage bndr)]
332 -- which has n**2 cost, and this meant that edges_from alone
333 -- consumed 10% of total runtime!
334 edges_from :: UsageDetails -> [Int]
335 edges_from rhs_usage = _scc_ "occAnalBind.edges_from"
338 ---- stuff to "re-constitute" bindings from dependency-analysis info ------
341 do_final_bind (AcyclicSCC ((bndr, rhs_usage, rhs'), _, _)) (body_usage, binds_so_far)
342 | isNeeded env body_usage bndr
343 = (combined_usage, new_bind : binds_so_far)
345 = (body_usage, binds_so_far) -- Dead code
347 total_usage = combineUsageDetails body_usage rhs_usage
348 (combined_usage, tagged_bndr) = tagBinder total_usage bndr
349 new_bind = NonRec tagged_bndr rhs'
352 do_final_bind (CyclicSCC cycle) (body_usage, binds_so_far)
353 | any (isNeeded env body_usage) bndrs
354 = (combined_usage, final_bind:binds_so_far)
356 = (body_usage, binds_so_far) -- Dead code
358 details = [details | (details, _, _) <- cycle]
359 bndrs = [bndr | (bndr, _, _) <- details]
360 rhs_usages = [rhs_usage | (_, rhs_usage, _) <- details]
361 total_usage = foldr combineUsageDetails body_usage rhs_usages
362 (combined_usage, tagged_binders) = tagBinders total_usage bndrs
363 final_bind = Rec (reOrderRec env new_cycle)
365 new_cycle = CyclicSCC (zipWithEqual "occAnalBind" mk_new_bind tagged_binders cycle)
366 mk_new_bind (bndr, occ_info) ((_, _, rhs'), key, keys) = (((bndr, occ_info), rhs'), key, keys)
369 @reOrderRec@ is applied to the list of (binder,rhs) pairs for a cyclic
370 strongly connected component (there's guaranteed to be a cycle). It returns the
372 a) in a better order,
373 b) with some of the Ids having a IMustNotBeINLINEd pragma
375 The "no-inline" Ids are sufficient to break all cycles in the SCC. This means
376 that the simplifier can guarantee not to loop provided it never records an inlining
377 for these no-inline guys.
379 Furthermore, the order of the binds is such that if we neglect dependencies
380 on the no-inline Ids then the binds are topologically sorted. This means
381 that the simplifier will generally do a good job if it works from top bottom,
382 recording inlinings for any Ids which aren't marked as "no-inline" as it goes.
384 Here's a case that bit me:
392 Re-ordering doesn't change the order of bindings, but there was no loop-breaker.
394 My solution was to make a=b bindings record b as Many, rather like INLINE bindings.
395 Perhaps something cleverer would suffice.
397 You might think that you can prevent non-termination simply by making
398 sure that we simplify a recursive binding's RHS in an environment that
399 simply clones the recursive Id. But no. Consider
401 letrec f = \x -> let z = f x' in ...
408 We bind n to its *simplified* RHS, we then *re-simplify* it when
409 we inline n. Then we may well inline f; and then the same thing
412 I don't think it's possible to prevent non-termination by environment
413 manipulation in this way. Apart from anything else, successive
414 iterations of the simplifier may unroll recursive loops in cases like
415 that above. The idea of beaking every recursive loop with an
416 IMustNotBeINLINEd pragma is much much better.
422 -> SCC (Node Details2)
424 -- Sorted into a plausible order. Enough of the Ids have
425 -- dontINLINE pragmas that there are no loops left.
427 -- Non-recursive case
428 reOrderRec env (AcyclicSCC (bind, _, _)) = [bind]
430 -- Common case of simple self-recursion
431 reOrderRec env (CyclicSCC [bind])
432 = [((addNoInlinePragma bndr, occ_info), rhs)]
434 (((bndr, occ_info), rhs), _, _) = bind
436 reOrderRec env (CyclicSCC binds)
437 = -- Choose a loop breaker, mark it no-inline,
438 -- do SCC analysis on the rest, and recursively sort them out
439 concat (map (reOrderRec env) (stronglyConnCompR unchosen))
441 [((addNoInlinePragma bndr, occ_info), rhs)]
444 (chosen_pair, unchosen) = choose_loop_breaker binds
445 ((bndr,occ_info), rhs) = chosen_pair
447 -- Choosing the loop breaker; heursitic
448 choose_loop_breaker (bind@(details, _, _) : rest)
451 = (chosen, bind : unchosen) -- Don't pick it
452 | otherwise -- Pick it
455 (chosen, unchosen) = choose_loop_breaker rest
457 bad_choice ((bndr, occ_info), rhs)
458 = var_rhs rhs -- Dont pick var RHS
459 || inlineMe env bndr -- Dont pick INLINE thing
460 || isOneFunOcc occ_info -- Dont pick single-occ thing
461 || not_fun_ty (idType bndr) -- Dont pick data-ty thing
463 -- isOneFunOcc looks for one textual occurrence, whether inside lambda or whatever.
464 -- We stick to just FunOccs because if we're not going to be able
465 -- to inline the thing on this round it might be better to pick
466 -- this one as the loop breaker. Real example (the Enum Ordering instance
468 -- rec f = \ x -> case d of (p,q,r) -> p x
469 -- g = \ x -> case d of (p,q,r) -> q x
472 -- Here, f and g occur just once; but we can't inline them into d.
473 -- On the other hand we *could* simplify those case expressions if
474 -- we didn't stupidly choose d as the loop breaker.
476 not_fun_ty ty = not (maybeToBool (splitFunTy_maybe rho_ty))
478 (_, rho_ty) = splitForAllTys ty
481 var_rhs (Var v) = True
482 var_rhs other_rhs = False
485 @occAnalRhs@ deals with the question of bindings where the Id is marked
486 by an INLINE pragma. For these we record that anything which occurs
487 in its RHS occurs many times. This pessimistically assumes that ths
488 inlined binder also occurs many times in its scope, but if it doesn't
489 we'll catch it next time round. At worst this costs an extra simplifier pass.
490 ToDo: try using the occurrence info for the inline'd binder.
492 [March 97] We do the same for atomic RHSs. Reason: see notes with reOrderRec.
494 [March 98] A new wrinkle is that if the binder has specialisations inside
495 it then we count the specialised Ids as "extra rhs's". That way
496 the "parent" keeps the specialised "children" alive. If the parent
497 dies (because it isn't referenced any more), then the children will
498 die too unless they are already referenced directly.
502 -> Id -> CoreExpr -- Binder and rhs
503 -> (UsageDetails, SimplifiableCoreExpr)
505 occAnalRhs env id (Var v)
507 = (unitIdEnv v (markMany (funOccurrence 0)), Var v)
510 = (emptyDetails, Var v)
512 occAnalRhs env id rhs
514 = (mapIdEnv markMany total_usage, rhs')
517 = (total_usage, rhs')
520 (rhs_usage, rhs') = occAnal env rhs
521 total_usage = foldr add rhs_usage (idSpecVars id)
522 add v u = addOneOcc u v noBinderInfo -- Give a non-committal binder info
523 -- (i.e manyOcc) because many copies
524 -- of the specialised thing can appear
532 -> (UsageDetails, -- Gives info only about the "interesting" Ids
533 SimplifiableCoreExpr)
537 = (unitIdEnv v (funOccurrence 0), Var v)
540 = (emptyDetails, Var v)
542 occAnal env (Lit lit) = (emptyDetails, Lit lit)
543 occAnal env (Prim op args) = (occAnalArgs env args, Prim op args)
546 We regard variables that occur as constructor arguments as "dangerousToDup":
550 f x = let y = expensive x in
552 (case z of {(p,q)->q}, case z of {(p,q)->q})
555 We feel free to duplicate the WHNF (True,y), but that means
556 that y may be duplicated thereby.
558 If we aren't careful we duplicate the (expensive x) call!
559 Constructors are rather like lambdas in this way.
562 occAnal env (Con con args)
563 = (mapIdEnv markDangerousToDup (occAnalArgs env args),
566 occAnal env (Note note@(SCC cc) body)
567 = (mapIdEnv markInsideSCC usage, Note note body')
569 (usage, body') = occAnal env body
571 occAnal env (Note note body)
572 = (usage, Note note body')
574 (usage, body') = occAnal env body
576 occAnal env (App fun arg)
577 = (fun_usage `combineUsageDetails` arg_usage, App fun' arg)
579 (fun_usage, fun') = occAnal env fun
580 arg_usage = occAnalArg env arg
582 -- For value lambdas we do a special hack. Consider
584 -- If we did nothing, x is used inside the \y, so would be marked
585 -- as dangerous to dup. But in the common case where the abstraction
586 -- is applied to two arguments this is over-pessimistic.
587 -- So instead we don't take account of the \y when dealing with x's usage;
588 -- instead, the simplifier is careful when partially applying lambdas
590 occAnal env expr@(Lam (ValBinder binder) body)
591 = (mapIdEnv markDangerousToDup final_usage,
592 foldr ( \v b -> Lam (ValBinder v) b) body' tagged_binders)
594 (binders,body) = collectValBinders expr
595 (body_usage, body') = occAnal (env `addNewCands` binders) body
596 (final_usage, tagged_binders) = tagBinders body_usage binders
598 -- ANDY: WE MUST THINK ABOUT THIS! (ToDo)
599 occAnal env (Lam (TyBinder tyvar) body)
600 = case occAnal env body of { (body_usage, body') ->
601 (mapIdEnv markDangerousToDup body_usage,
602 Lam (TyBinder tyvar) body') }
604 -- (body_usage, body') = occAnal env body
606 occAnal env (Case scrut alts)
607 = case occAnalAlts env alts of { (alts_usage, alts') ->
608 case occAnal env scrut of { (scrut_usage, scrut') ->
610 det = scrut_usage `combineUsageDetails` alts_usage
612 if isNullIdEnv det then
613 (det, Case scrut' alts')
615 (det, Case scrut' alts') }}
617 (scrut_usage `combineUsageDetails` alts_usage,
620 (scrut_usage, scrut') = occAnal env scrut
621 (alts_usage, alts') = occAnalAlts env alts
624 occAnal env (Let bind body)
625 = case occAnal new_env body of { (body_usage, body') ->
626 case occAnalBind env bind body_usage of { (final_usage, new_binds) ->
627 (final_usage, foldr Let body' new_binds) }} -- mkCoLet* wants Core... (sigh)
629 new_env = env `addNewCands` (bindersOf bind)
630 -- (body_usage, body') = occAnal new_env body
631 -- (final_usage, new_binds) = occAnalBind env bind body_usage
637 occAnalAlts env (AlgAlts alts deflt)
638 = (foldr combineAltsUsageDetails deflt_usage alts_usage,
639 -- Note: combine*Alts*UsageDetails...
640 AlgAlts alts' deflt')
642 (alts_usage, alts') = unzip (map do_alt alts)
643 (deflt_usage, deflt') = occAnalDeflt env deflt
645 do_alt (con, args, rhs)
646 = (final_usage, (con, tagged_args, rhs'))
648 new_env = env `addNewCands` args
649 (rhs_usage, rhs') = occAnal new_env rhs
650 (final_usage, tagged_args) = tagBinders rhs_usage args
652 occAnalAlts env (PrimAlts alts deflt)
653 = (foldr combineAltsUsageDetails deflt_usage alts_usage,
654 -- Note: combine*Alts*UsageDetails...
655 PrimAlts alts' deflt')
657 (alts_usage, alts') = unzip (map do_alt alts)
658 (deflt_usage, deflt') = occAnalDeflt env deflt
661 = (rhs_usage, (lit, rhs'))
663 (rhs_usage, rhs') = occAnal env rhs
665 occAnalDeflt env NoDefault = (emptyDetails, NoDefault)
667 occAnalDeflt env (BindDefault binder rhs)
668 = (final_usage, BindDefault tagged_binder rhs')
670 new_env = env `addNewCand` binder
671 (rhs_usage, rhs') = occAnal new_env rhs
672 (final_usage, tagged_binder) = tagBinder rhs_usage binder
679 occAnalArgs :: OccEnv -> [CoreArg] -> UsageDetails
681 occAnalArgs env atoms
682 = foldr do_one_atom emptyDetails atoms
684 do_one_atom (VarArg v) usage
685 | isCandidate env v = addOneOcc usage v (argOccurrence 0)
687 do_one_atom other_arg usage = usage
690 occAnalArg :: OccEnv -> CoreArg -> UsageDetails
692 occAnalArg env (VarArg v)
693 | isCandidate env v = unitDetails v (argOccurrence 0)
694 | otherwise = emptyDetails
695 occAnalArg _ _ = emptyDetails
699 %************************************************************************
701 \subsection[OccurAnal-types]{Data types}
703 %************************************************************************
708 Bool -- IgnoreINLINEPragma flag
709 -- False <=> OK to use INLINEPragma information
710 -- True <=> ignore INLINEPragma information
712 (Id -> IdSet -> Bool) -- Tells whether an Id occurrence is interesting,
713 -- given the set of in-scope variables
715 IdSet -- In-scope Ids
718 addNewCands :: OccEnv -> [Id] -> OccEnv
719 addNewCands (OccEnv ip ifun cands) ids
720 = OccEnv ip ifun (cands `unionIdSets` mkIdSet ids)
722 addNewCand :: OccEnv -> Id -> OccEnv
723 addNewCand (OccEnv ip ifun cands) id
724 = OccEnv ip ifun (addOneToIdSet cands id)
726 isCandidate :: OccEnv -> Id -> Bool
727 isCandidate (OccEnv _ ifun cands) id = ifun id cands
729 inlineMe :: OccEnv -> Id -> Bool
731 = {- See comments with simplIdWantsToBeINLINEd in SimplUtils.lhs
732 not ignore_inline_prag &&
734 idWantsToBeINLINEd id
737 type UsageDetails = IdEnv BinderInfo -- A finite map from ids to their usage
739 combineUsageDetails, combineAltsUsageDetails
740 :: UsageDetails -> UsageDetails -> UsageDetails
742 combineUsageDetails usage1 usage2
743 = combineIdEnvs addBinderInfo usage1 usage2
745 combineAltsUsageDetails usage1 usage2
746 = combineIdEnvs orBinderInfo usage1 usage2
748 addOneOcc :: UsageDetails -> Id -> BinderInfo -> UsageDetails
749 addOneOcc usage id info
750 = combineIdEnvs addBinderInfo usage (unitIdEnv id info)
751 -- ToDo: make this more efficient
753 emptyDetails = (nullIdEnv :: UsageDetails)
755 unitDetails id info = (unitIdEnv id info :: UsageDetails)
757 tagBinders :: UsageDetails -- Of scope
759 -> (UsageDetails, -- Details with binders removed
760 [(Id,BinderInfo)]) -- Tagged binders
762 tagBinders usage binders =
764 usage' = usage `delManyFromIdEnv` binders
765 uss = [ (binder, usage_of usage binder) | binder <- binders ]
767 if isNullIdEnv usage' then
772 = (usage `delManyFromIdEnv` binders,
773 [ (binder, usage_of usage binder) | binder <- binders ]
776 tagBinder :: UsageDetails -- Of scope
778 -> (UsageDetails, -- Details with binders removed
779 (Id,BinderInfo)) -- Tagged binders
781 tagBinder usage binder =
783 usage' = usage `delOneFromIdEnv` binder
784 us = usage_of usage binder
786 if isNullIdEnv usage' then -- Bogus test to force evaluation.
787 (usage', (binder, us))
789 (usage', (binder, us))
791 if isDeadOcc us then -- Ditto
797 usage_of usage binder
798 | isExported binder || isSpecPragmaId binder
799 = noBinderInfo -- Visible-elsewhere things count as many
801 = case (lookupIdEnv usage binder) of
802 Nothing -> deadOccurrence
805 isNeeded env usage binder = not (isDeadOcc (usage_of usage binder))