Skip to content
Snippets Groups Projects
Commit 33c0b416 authored by sof's avatar sof
Browse files

[project @ 1997-09-09 18:04:55 by sof]

tidied up, use BinderInfo.isOneFunOcc etc.
parent 375001f6
No related merge requests found
...@@ -163,27 +163,29 @@ tagBinder usage binder = ...@@ -163,27 +163,29 @@ tagBinder usage binder =
usage' = usage `delOneFromIdEnv` binder usage' = usage `delOneFromIdEnv` binder
us = usage_of usage binder us = usage_of usage binder
cont = cont =
if isNullIdEnv usage' then -- bogus test to force evaluation. if isNullIdEnv usage' then -- Bogus test to force evaluation.
(usage', (binder, us)) (usage', (binder, us))
else else
(usage', (binder, us)) (usage', (binder, us))
in in
case us of { DeadCode -> cont; _ -> cont } if isDeadOcc us then -- Ditto
cont
-- (binder, usage_of usage binder) else
cont
usage_of usage binder usage_of usage binder
| isExported binder = ManyOcc 0 -- Visible-elsewhere things count as many | isExported binder = noBinderInfo -- Visible-elsewhere things count as many
| otherwise | otherwise
= case (lookupIdEnv usage binder) of = case (lookupIdEnv usage binder) of
Nothing -> DeadCode Nothing -> deadOccurrence
Just info -> info Just info -> info
isNeeded env usage binder isNeeded env usage binder
= case (usage_of usage binder) of = if isDeadOcc (usage_of usage binder) then
DeadCode -> keepUnusedBinding env binder -- Maybe keep it anyway keepUnusedBinding env binder -- Maybe keep it anyway
other -> True else
True
\end{code} \end{code}
...@@ -492,18 +494,10 @@ reOrderRec env (CyclicSCC binds) ...@@ -492,18 +494,10 @@ reOrderRec env (CyclicSCC binds)
bad_choice ((bndr, occ_info), rhs) bad_choice ((bndr, occ_info), rhs)
= var_rhs rhs -- Dont pick var RHS = var_rhs rhs -- Dont pick var RHS
|| inlineMe env bndr -- Dont pick INLINE thing || inlineMe env bndr -- Dont pick INLINE thing
|| one_occ occ_info -- Dont pick single-occ thing || isOneFunOcc occ_info -- Dont pick single-occ thing
|| not_fun_ty (idType bndr) -- Dont pick data-ty thing || not_fun_ty (idType bndr) -- Dont pick data-ty thing
not_fun_ty ty = not (maybeToBool (getFunTy_maybe rho_ty)) -- isOneFunOcc looks for one textual occurrence, whether inside lambda or whatever.
where
(_, rho_ty) = splitForAllTy ty
-- A variable RHS
var_rhs (Var v) = True
var_rhs other_rhs = False
-- One textual occurrence, whether inside lambda or whatever
-- We stick to just FunOccs because if we're not going to be able -- We stick to just FunOccs because if we're not going to be able
-- to inline the thing on this round it might be better to pick -- to inline the thing on this round it might be better to pick
-- this one as the loop breaker. Real example (the Enum Ordering instance -- this one as the loop breaker. Real example (the Enum Ordering instance
...@@ -516,8 +510,13 @@ reOrderRec env (CyclicSCC binds) ...@@ -516,8 +510,13 @@ reOrderRec env (CyclicSCC binds)
-- On the other hand we *could* simplify those case expressions if -- On the other hand we *could* simplify those case expressions if
-- we didn't stupidly choose d as the loop breaker. -- we didn't stupidly choose d as the loop breaker.
one_occ (OneOcc fun_or_arg _ _ _ _) = isFun fun_or_arg not_fun_ty ty = not (maybeToBool (getFunTy_maybe rho_ty))
one_occ other_bind = False where
(_, rho_ty) = splitForAllTy ty
-- A variable RHS
var_rhs (Var v) = True
var_rhs other_rhs = False
\end{code} \end{code}
@occAnalRhs@ deals with the question of bindings where the Id is marked @occAnalRhs@ deals with the question of bindings where the Id is marked
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment