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 CoreUtils ( idSpecVars )
24 import Digraph ( stronglyConnCompR, SCC(..) )
25 import Id ( idWantsToBeINLINEd, addNoInlinePragma, nukeNoInlinePragma,
26 omitIfaceSigForId, isSpecPragmaId, getIdSpecialisation,
28 emptyIdSet, unionIdSets, mkIdSet,
32 IdEnv, nullIdEnv, unitIdEnv, combineIdEnvs,
33 delOneFromIdEnv, delManyFromIdEnv, isNullIdEnv,
34 mapIdEnv, lookupIdEnv, elemIdEnv, addOneToIdEnv
36 import SpecEnv ( isEmptySpecEnv )
37 import Name ( isExported, isLocallyDefined )
38 import Type ( splitFunTy_maybe, splitForAllTys )
39 import Maybes ( maybeToBool )
42 import UniqFM ( keysUFM )
43 import Util ( zipWithEqual )
48 %************************************************************************
50 \subsection[OccurAnal-main]{Counting occurrences: main function}
52 %************************************************************************
54 Here's the externally-callable interface:
58 :: [CoreBinding] -- input
59 -> (SimplifierSwitch -> Bool)
60 -> [SimplifiableCoreBinding] -- output
62 occurAnalyseBinds binds simplifier_sw_chkr
63 | opt_D_dump_occur_anal = pprTrace "OccurAnal:"
64 (pprGenericBindings new_binds)
66 | otherwise = new_binds
68 new_binds = concat binds'
69 (_, _, binds') = occAnalTop initial_env binds
71 initial_env = OccEnv (simplifier_sw_chkr IgnoreINLINEPragma)
72 (\id in_scope -> isLocallyDefined id) -- Anything local is interesting
73 emptyIdSet -- Not actually used
78 occurAnalyseExpr :: (Id -> Bool) -- Tells if a variable is interesting
80 -> (IdEnv BinderInfo, -- Occ info for interesting free vars
83 occurAnalyseExpr interesting expr
84 = occAnal initial_env expr
86 initial_env = OccEnv False {- Do not ignore INLINE Pragma -}
87 (\id locals -> interesting id || elementOfIdSet id locals)
90 occurAnalyseGlobalExpr :: CoreExpr -> SimplifiableCoreExpr
91 occurAnalyseGlobalExpr expr
92 = -- Top level expr, so no interesting free vars, and
93 -- discard occurence info returned
94 snd (occurAnalyseExpr (\_ -> False) expr)
98 %************************************************************************
100 \subsection{Top level stuff}
102 %************************************************************************
104 In @occAnalTop@ we do indirection-shorting. That is, if we have this:
110 where exp is exported, and loc is not, then we replace it with this:
116 Without this we never get rid of the exp = loc thing.
117 This save a gratuitous jump
118 (from \tr{x_exported} to \tr{x_local}), and makes strictness
119 information propagate better.
120 This used to happen in the final phase, but its tidier to do it here.
123 If more than one exported thing is equal to a local thing (i.e., the
124 local thing really is shared), then we do one only:
127 x_exported1 = x_local
128 x_exported2 = x_local
132 x_exported2 = x_exported1
135 We rely on prior eta reduction to simplify things like
137 x_exported = /\ tyvars -> x_local tyvars
141 Hence,there's a possibility of leaving unchanged something like this:
144 x_exported1 = x_local Int
146 By the time we've thrown away the types in STG land this
147 could be eliminated. But I don't think it's very common
148 and it's dangerous to do this fiddling in STG land
149 because we might elminate a binding that's mentioned in the
150 unfolding for something.
154 occAnalTop :: OccEnv -- What's in scope
156 -> (IdEnv BinderInfo, -- Occurrence info
157 IdEnv Id, -- Indirection elimination info
158 [[SimplifiableCoreBinding]]
160 occAnalTop env [] = (emptyDetails, nullIdEnv, [])
161 occAnalTop env (bind : binds)
163 NonRec exported_id (Var local_id)
164 | isExported exported_id && -- Only if this is exported
166 isLocallyDefined local_id && -- Only if this one is defined in this
167 -- module, so that we *can* change its
168 -- binding to be the exported thing!
170 not (isExported local_id) && -- Only if this one is not itself exported,
171 -- since the transformation will nuke it
173 not (omitIfaceSigForId local_id) && -- Don't do the transformation if rhs_id is
174 -- something like a constructor, whose
175 -- definition is implicitly exported and
176 -- which must not vanish.
178 -- To illustrate the preceding check consider
182 -- Here, we'll make a local, non-exported, defn for MkT, and without the
183 -- above condition we'll transform it to:
186 -- This is bad because mkT will get the IdDetails of MkT, and won't
187 -- be exported. Also the code generator won't make a definition for
188 -- the MkT constructor.
189 -- Slightly gruesome, this.
191 not (maybeToBool (lookupIdEnv ind_env local_id))
192 -- Only if not already substituted for
193 -> -- Aha! An indirection; let's eliminate it!
194 (scope_usage, ind_env', binds')
196 ind_env' = addOneToIdEnv ind_env local_id exported_id
199 -> -- The normal case
200 (final_usage, ind_env, (new_binds : binds'))
202 (final_usage, new_binds) = occAnalBind env (zap_bind bind) scope_usage
204 new_env = env `addNewCands` (bindersOf bind)
205 (scope_usage, ind_env, binds') = occAnalTop new_env binds
207 -- Deal with any indirections
208 zap_bind (NonRec bndr rhs)
209 | bndr `elemIdEnv` ind_env = Rec (zap (bndr,rhs))
210 -- The Rec isn't strictly necessary, but it's convenient
212 | or [id `elemIdEnv` ind_env | (id,_) <- pairs] = Rec (concat (map zap pairs))
216 zap pair@(bndr,rhs) = case lookupIdEnv ind_env bndr of
218 Just exported_id -> [(bndr, Var exported_id),
224 %************************************************************************
226 \subsection[OccurAnal-main]{Counting occurrences: main function}
228 %************************************************************************
234 type Node details = (details, Int, [Int]) -- The Ints are gotten from the Unique,
235 -- which is gotten from the Id.
236 type Details1 = (Id, UsageDetails, SimplifiableCoreExpr)
237 type Details2 = ((Id, BinderInfo), SimplifiableCoreExpr)
240 occAnalBind :: OccEnv
242 -> UsageDetails -- Usage details of scope
243 -> (UsageDetails, -- Of the whole let(rec)
244 [SimplifiableCoreBinding])
246 occAnalBind env (NonRec binder rhs) body_usage
247 | isNeeded env body_usage binder -- It's mentioned in body
248 = (final_body_usage `combineUsageDetails` rhs_usage,
249 [NonRec tagged_binder rhs'])
251 | otherwise -- Not mentioned, so drop dead code
255 binder' = nukeNoInlinePragma binder
256 (rhs_usage, rhs') = occAnalRhs env binder' rhs
257 (final_body_usage, tagged_binder) = tagBinder body_usage binder'
260 Dropping dead code for recursive bindings is done in a very simple way:
262 the entire set of bindings is dropped if none of its binders are
263 mentioned in its body; otherwise none are.
265 This seems to miss an obvious improvement.
280 Now @f@ is unused. But dependency analysis will sort this out into a
281 @letrec@ for @g@ and a @let@ for @f@, and then @f@ will get dropped.
282 It isn't easy to do a perfect job in one blow. Consider
296 occAnalBind env (Rec pairs) body_usage
297 = foldr (_scc_ "occAnalBind.dofinal" do_final_bind) (body_usage, []) sccs
299 pp_item (_, bndr, _) = ppr bndr
301 binders = map fst pairs
302 new_env = env `addNewCands` binders
304 analysed_pairs :: [Details1]
305 analysed_pairs = [ (nukeNoInlinePragma bndr, rhs_usage, rhs')
306 | (bndr, rhs) <- pairs,
307 let (rhs_usage, rhs') = occAnalRhs new_env bndr rhs
310 sccs :: [SCC (Node Details1)]
311 sccs = _scc_ "occAnalBind.scc" stronglyConnCompR edges
314 ---- stuff for dependency analysis of binds -------------------------------
315 edges :: [Node Details1]
316 edges = _scc_ "occAnalBind.assoc"
317 [ (details, IBOX(u2i (idUnique id)), edges_from rhs_usage)
318 | details@(id, rhs_usage, rhs) <- analysed_pairs
321 -- (a -> b) means a mentions b
322 -- Given the usage details (a UFM that gives occ info for each free var of
323 -- the RHS) we can get the list of free vars -- or rather their Int keys --
324 -- by just extracting the keys from the finite map. Grimy, but fast.
325 -- Previously we had this:
326 -- [ bndr | bndr <- bndrs,
327 -- maybeToBool (lookupIdEnv rhs_usage bndr)]
328 -- which has n**2 cost, and this meant that edges_from alone
329 -- consumed 10% of total runtime!
330 edges_from :: UsageDetails -> [Int]
331 edges_from rhs_usage = _scc_ "occAnalBind.edges_from"
334 ---- stuff to "re-constitute" bindings from dependency-analysis info ------
337 do_final_bind (AcyclicSCC ((bndr, rhs_usage, rhs'), _, _)) (body_usage, binds_so_far)
338 | isNeeded env body_usage bndr
339 = (combined_usage, new_bind : binds_so_far)
341 = (body_usage, binds_so_far) -- Dead code
343 total_usage = combineUsageDetails body_usage rhs_usage
344 (combined_usage, tagged_bndr) = tagBinder total_usage bndr
345 new_bind = NonRec tagged_bndr rhs'
348 do_final_bind (CyclicSCC cycle) (body_usage, binds_so_far)
349 | any (isNeeded env body_usage) bndrs
350 = (combined_usage, final_bind:binds_so_far)
352 = (body_usage, binds_so_far) -- Dead code
354 details = [details | (details, _, _) <- cycle]
355 bndrs = [bndr | (bndr, _, _) <- details]
356 rhs_usages = [rhs_usage | (_, rhs_usage, _) <- details]
357 total_usage = foldr combineUsageDetails body_usage rhs_usages
358 (combined_usage, tagged_binders) = tagBinders total_usage bndrs
359 final_bind = Rec (reOrderRec env new_cycle)
361 new_cycle = CyclicSCC (zipWithEqual "occAnalBind" mk_new_bind tagged_binders cycle)
362 mk_new_bind (bndr, occ_info) ((_, _, rhs'), key, keys) = (((bndr, occ_info), rhs'), key, keys)
365 @reOrderRec@ is applied to the list of (binder,rhs) pairs for a cyclic
366 strongly connected component (there's guaranteed to be a cycle). It returns the
368 a) in a better order,
369 b) with some of the Ids having a IMustNotBeINLINEd pragma
371 The "no-inline" Ids are sufficient to break all cycles in the SCC. This means
372 that the simplifier can guarantee not to loop provided it never records an inlining
373 for these no-inline guys.
375 Furthermore, the order of the binds is such that if we neglect dependencies
376 on the no-inline Ids then the binds are topologically sorted. This means
377 that the simplifier will generally do a good job if it works from top bottom,
378 recording inlinings for any Ids which aren't marked as "no-inline" as it goes.
380 Here's a case that bit me:
388 Re-ordering doesn't change the order of bindings, but there was no loop-breaker.
390 My solution was to make a=b bindings record b as Many, rather like INLINE bindings.
391 Perhaps something cleverer would suffice.
393 You might think that you can prevent non-termination simply by making
394 sure that we simplify a recursive binding's RHS in an environment that
395 simply clones the recursive Id. But no. Consider
397 letrec f = \x -> let z = f x' in ...
404 We bind n to its *simplified* RHS, we then *re-simplify* it when
405 we inline n. Then we may well inline f; and then the same thing
408 I don't think it's possible to prevent non-termination by environment
409 manipulation in this way. Apart from anything else, successive
410 iterations of the simplifier may unroll recursive loops in cases like
411 that above. The idea of beaking every recursive loop with an
412 IMustNotBeINLINEd pragma is much much better.
418 -> SCC (Node Details2)
420 -- Sorted into a plausible order. Enough of the Ids have
421 -- dontINLINE pragmas that there are no loops left.
423 -- Non-recursive case
424 reOrderRec env (AcyclicSCC (bind, _, _)) = [bind]
426 -- Common case of simple self-recursion
427 reOrderRec env (CyclicSCC [bind])
428 = [((addNoInlinePragma bndr, occ_info), rhs)]
430 (((bndr, occ_info), rhs), _, _) = bind
432 reOrderRec env (CyclicSCC binds)
433 = -- Choose a loop breaker, mark it no-inline,
434 -- do SCC analysis on the rest, and recursively sort them out
435 concat (map (reOrderRec env) (stronglyConnCompR unchosen))
437 [((addNoInlinePragma bndr, occ_info), rhs)]
440 (chosen_pair, unchosen) = choose_loop_breaker binds
441 ((bndr,occ_info), rhs) = chosen_pair
443 -- Choosing the loop breaker; heursitic
444 choose_loop_breaker (bind@(details, _, _) : rest)
447 = (chosen, bind : unchosen) -- Don't pick it
448 | otherwise -- Pick it
451 (chosen, unchosen) = choose_loop_breaker rest
453 bad_choice ((bndr, occ_info), rhs)
454 = var_rhs rhs -- Dont pick var RHS
455 || inlineMe env bndr -- Dont pick INLINE thing
456 || isOneFunOcc occ_info -- Dont pick single-occ thing
457 || not_fun_ty (idType bndr) -- Dont pick data-ty thing
458 || not (isEmptySpecEnv (getIdSpecialisation bndr))
459 -- Avoid things with a SpecEnv; we'd like
460 -- to take advantage of the SpecEnv in the subsuequent bindings
462 -- isOneFunOcc looks for one textual occurrence, whether inside lambda or whatever.
463 -- We stick to just FunOccs because if we're not going to be able
464 -- to inline the thing on this round it might be better to pick
465 -- this one as the loop breaker. Real example (the Enum Ordering instance
467 -- rec f = \ x -> case d of (p,q,r) -> p x
468 -- g = \ x -> case d of (p,q,r) -> q x
471 -- Here, f and g occur just once; but we can't inline them into d.
472 -- On the other hand we *could* simplify those case expressions if
473 -- we didn't stupidly choose d as the loop breaker.
475 not_fun_ty ty = not (maybeToBool (splitFunTy_maybe rho_ty))
477 (_, rho_ty) = splitForAllTys ty
480 var_rhs (Var v) = True
481 var_rhs other_rhs = False
484 @occAnalRhs@ deals with the question of bindings where the Id is marked
485 by an INLINE pragma. For these we record that anything which occurs
486 in its RHS occurs many times. This pessimistically assumes that ths
487 inlined binder also occurs many times in its scope, but if it doesn't
488 we'll catch it next time round. At worst this costs an extra simplifier pass.
489 ToDo: try using the occurrence info for the inline'd binder.
491 [March 97] We do the same for atomic RHSs. Reason: see notes with reOrderRec.
493 [March 98] A new wrinkle is that if the binder has specialisations inside
494 it then we count the specialised Ids as "extra rhs's". That way
495 the "parent" keeps the specialised "children" alive. If the parent
496 dies (because it isn't referenced any more), then the children will
497 die too unless they are already referenced directly.
501 -> Id -> CoreExpr -- Binder and rhs
502 -> (UsageDetails, SimplifiableCoreExpr)
504 occAnalRhs env id (Var v)
506 = (unitIdEnv v (markMany (funOccurrence 0)), Var v)
509 = (emptyDetails, Var v)
511 occAnalRhs env id rhs
513 = (mapIdEnv markMany total_usage, rhs')
516 = (total_usage, rhs')
519 (rhs_usage, rhs') = occAnal env rhs
520 total_usage = foldr add rhs_usage (idSpecVars id)
521 add v u = addOneOcc u v noBinderInfo -- Give a non-committal binder info
522 -- (i.e manyOcc) because many copies
523 -- of the specialised thing can appear
531 -> (UsageDetails, -- Gives info only about the "interesting" Ids
532 SimplifiableCoreExpr)
536 = (unitIdEnv v (funOccurrence 0), Var v)
539 = (emptyDetails, Var v)
541 occAnal env (Lit lit) = (emptyDetails, Lit lit)
542 occAnal env (Prim op args) = (occAnalArgs env args, Prim op args)
545 We regard variables that occur as constructor arguments as "dangerousToDup":
549 f x = let y = expensive x in
551 (case z of {(p,q)->q}, case z of {(p,q)->q})
554 We feel free to duplicate the WHNF (True,y), but that means
555 that y may be duplicated thereby.
557 If we aren't careful we duplicate the (expensive x) call!
558 Constructors are rather like lambdas in this way.
561 occAnal env (Con con args)
562 = (mapIdEnv markDangerousToDup (occAnalArgs env args),
565 occAnal env (Note note@(SCC cc) body)
566 = (mapIdEnv markInsideSCC usage, Note note body')
568 (usage, body') = occAnal env body
570 occAnal env (Note note body)
571 = (usage, Note note body')
573 (usage, body') = occAnal env body
575 occAnal env (App fun arg)
576 = (fun_usage `combineUsageDetails` arg_usage, App fun' arg)
578 (fun_usage, fun') = occAnal env fun
579 arg_usage = occAnalArg env arg
581 -- For value lambdas we do a special hack. Consider
583 -- If we did nothing, x is used inside the \y, so would be marked
584 -- as dangerous to dup. But in the common case where the abstraction
585 -- is applied to two arguments this is over-pessimistic.
586 -- So instead we don't take account of the \y when dealing with x's usage;
587 -- instead, the simplifier is careful when partially applying lambdas
589 occAnal env expr@(Lam (ValBinder binder) body)
590 = (mapIdEnv markDangerousToDup final_usage,
591 foldr ( \v b -> Lam (ValBinder v) b) body' tagged_binders)
593 (binders,body) = collectValBinders expr
594 (body_usage, body') = occAnal (env `addNewCands` binders) body
595 (final_usage, tagged_binders) = tagBinders body_usage binders
597 -- ANDY: WE MUST THINK ABOUT THIS! (ToDo)
598 occAnal env (Lam (TyBinder tyvar) body)
599 = case occAnal env body of { (body_usage, body') ->
600 (mapIdEnv markDangerousToDup body_usage,
601 Lam (TyBinder tyvar) body') }
603 -- (body_usage, body') = occAnal env body
605 occAnal env (Case scrut alts)
606 = case occAnalAlts env alts of { (alts_usage, alts') ->
607 case occAnal env scrut of { (scrut_usage, scrut') ->
609 det = scrut_usage `combineUsageDetails` alts_usage
611 if isNullIdEnv det then
612 (det, Case scrut' alts')
614 (det, Case scrut' alts') }}
616 (scrut_usage `combineUsageDetails` alts_usage,
619 (scrut_usage, scrut') = occAnal env scrut
620 (alts_usage, alts') = occAnalAlts env alts
623 occAnal env (Let bind body)
624 = case occAnal new_env body of { (body_usage, body') ->
625 case occAnalBind env bind body_usage of { (final_usage, new_binds) ->
626 (final_usage, foldr Let body' new_binds) }} -- mkCoLet* wants Core... (sigh)
628 new_env = env `addNewCands` (bindersOf bind)
629 -- (body_usage, body') = occAnal new_env body
630 -- (final_usage, new_binds) = occAnalBind env bind body_usage
636 occAnalAlts env (AlgAlts alts deflt)
637 = (foldr combineAltsUsageDetails deflt_usage alts_usage,
638 -- Note: combine*Alts*UsageDetails...
639 AlgAlts alts' deflt')
641 (alts_usage, alts') = unzip (map do_alt alts)
642 (deflt_usage, deflt') = occAnalDeflt env deflt
644 do_alt (con, args, rhs)
645 = (final_usage, (con, tagged_args, rhs'))
647 new_env = env `addNewCands` args
648 (rhs_usage, rhs') = occAnal new_env rhs
649 (final_usage, tagged_args) = tagBinders rhs_usage args
651 occAnalAlts env (PrimAlts alts deflt)
652 = (foldr combineAltsUsageDetails deflt_usage alts_usage,
653 -- Note: combine*Alts*UsageDetails...
654 PrimAlts alts' deflt')
656 (alts_usage, alts') = unzip (map do_alt alts)
657 (deflt_usage, deflt') = occAnalDeflt env deflt
660 = (rhs_usage, (lit, rhs'))
662 (rhs_usage, rhs') = occAnal env rhs
664 occAnalDeflt env NoDefault = (emptyDetails, NoDefault)
666 occAnalDeflt env (BindDefault binder rhs)
667 = (final_usage, BindDefault tagged_binder rhs')
669 new_env = env `addNewCand` binder
670 (rhs_usage, rhs') = occAnal new_env rhs
671 (final_usage, tagged_binder) = tagBinder rhs_usage binder
678 occAnalArgs :: OccEnv -> [CoreArg] -> UsageDetails
680 occAnalArgs env atoms
681 = foldr do_one_atom emptyDetails atoms
683 do_one_atom (VarArg v) usage
684 | isCandidate env v = addOneOcc usage v (argOccurrence 0)
686 do_one_atom other_arg usage = usage
689 occAnalArg :: OccEnv -> CoreArg -> UsageDetails
691 occAnalArg env (VarArg v)
692 | isCandidate env v = unitDetails v (argOccurrence 0)
693 | otherwise = emptyDetails
694 occAnalArg _ _ = emptyDetails
698 %************************************************************************
700 \subsection[OccurAnal-types]{Data types}
702 %************************************************************************
707 Bool -- IgnoreINLINEPragma flag
708 -- False <=> OK to use INLINEPragma information
709 -- True <=> ignore INLINEPragma information
711 (Id -> IdSet -> Bool) -- Tells whether an Id occurrence is interesting,
712 -- given the set of in-scope variables
714 IdSet -- In-scope Ids
717 addNewCands :: OccEnv -> [Id] -> OccEnv
718 addNewCands (OccEnv ip ifun cands) ids
719 = OccEnv ip ifun (cands `unionIdSets` mkIdSet ids)
721 addNewCand :: OccEnv -> Id -> OccEnv
722 addNewCand (OccEnv ip ifun cands) id
723 = OccEnv ip ifun (addOneToIdSet cands id)
725 isCandidate :: OccEnv -> Id -> Bool
726 isCandidate (OccEnv _ ifun cands) id = ifun id cands
728 inlineMe :: OccEnv -> Id -> Bool
730 = {- See comments with simplIdWantsToBeINLINEd in SimplUtils.lhs
731 not ignore_inline_prag &&
733 idWantsToBeINLINEd id
736 type UsageDetails = IdEnv BinderInfo -- A finite map from ids to their usage
738 combineUsageDetails, combineAltsUsageDetails
739 :: UsageDetails -> UsageDetails -> UsageDetails
741 combineUsageDetails usage1 usage2
742 = combineIdEnvs addBinderInfo usage1 usage2
744 combineAltsUsageDetails usage1 usage2
745 = combineIdEnvs orBinderInfo usage1 usage2
747 addOneOcc :: UsageDetails -> Id -> BinderInfo -> UsageDetails
748 addOneOcc usage id info
749 = combineIdEnvs addBinderInfo usage (unitIdEnv id info)
750 -- ToDo: make this more efficient
752 emptyDetails = (nullIdEnv :: UsageDetails)
754 unitDetails id info = (unitIdEnv id info :: UsageDetails)
756 tagBinders :: UsageDetails -- Of scope
758 -> (UsageDetails, -- Details with binders removed
759 [(Id,BinderInfo)]) -- Tagged binders
761 tagBinders usage binders =
763 usage' = usage `delManyFromIdEnv` binders
764 uss = [ (binder, usage_of usage binder) | binder <- binders ]
766 if isNullIdEnv usage' then
771 = (usage `delManyFromIdEnv` binders,
772 [ (binder, usage_of usage binder) | binder <- binders ]
775 tagBinder :: UsageDetails -- Of scope
777 -> (UsageDetails, -- Details with binders removed
778 (Id,BinderInfo)) -- Tagged binders
780 tagBinder usage binder =
782 usage' = usage `delOneFromIdEnv` binder
783 us = usage_of usage binder
785 if isNullIdEnv usage' then -- Bogus test to force evaluation.
786 (usage', (binder, us))
788 (usage', (binder, us))
790 if isDeadOcc us then -- Ditto
796 usage_of usage binder
797 | isExported binder || isSpecPragmaId binder
798 = noBinderInfo -- Visible-elsewhere things count as many
800 = case (lookupIdEnv usage binder) of
801 Nothing -> deadOccurrence
804 isNeeded env usage binder = not (isDeadOcc (usage_of usage binder))