From 33c0b416327d85d06763e91cbc1de937e742d0e5 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Tue, 9 Sep 1997 18:04:55 +0000
Subject: [PATCH] [project @ 1997-09-09 18:04:55 by sof] tidied up, use
BinderInfo.isOneFunOcc etc.
---
ghc/compiler/simplCore/OccurAnal.lhs | 41 ++++++++++++++--------------
1 file changed, 20 insertions(+), 21 deletions(-)
diff --git a/ghc/compiler/simplCore/OccurAnal.lhs b/ghc/compiler/simplCore/OccurAnal.lhs
index 622430d088e2..5796cd4e9676 100644
--- a/ghc/compiler/simplCore/OccurAnal.lhs
+++ b/ghc/compiler/simplCore/OccurAnal.lhs
@@ -163,27 +163,29 @@ tagBinder usage binder =
usage' = usage `delOneFromIdEnv` binder
us = usage_of usage binder
cont =
- if isNullIdEnv usage' then -- bogus test to force evaluation.
+ if isNullIdEnv usage' then -- Bogus test to force evaluation.
(usage', (binder, us))
else
(usage', (binder, us))
in
- case us of { DeadCode -> cont; _ -> cont }
-
--- (binder, usage_of usage binder)
+ if isDeadOcc us then -- Ditto
+ cont
+ else
+ cont
usage_of usage binder
- | isExported binder = ManyOcc 0 -- Visible-elsewhere things count as many
+ | isExported binder = noBinderInfo -- Visible-elsewhere things count as many
| otherwise
= case (lookupIdEnv usage binder) of
- Nothing -> DeadCode
+ Nothing -> deadOccurrence
Just info -> info
isNeeded env usage binder
- = case (usage_of usage binder) of
- DeadCode -> keepUnusedBinding env binder -- Maybe keep it anyway
- other -> True
+ = if isDeadOcc (usage_of usage binder) then
+ keepUnusedBinding env binder -- Maybe keep it anyway
+ else
+ True
\end{code}
@@ -492,18 +494,10 @@ reOrderRec env (CyclicSCC binds)
bad_choice ((bndr, occ_info), rhs)
= var_rhs rhs -- Dont pick var RHS
|| 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 ty = not (maybeToBool (getFunTy_maybe rho_ty))
- 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
+ -- isOneFunOcc looks for one textual occurrence, whether inside lambda or whatever.
-- 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
-- this one as the loop breaker. Real example (the Enum Ordering instance
@@ -516,8 +510,13 @@ reOrderRec env (CyclicSCC binds)
-- On the other hand we *could* simplify those case expressions if
-- we didn't stupidly choose d as the loop breaker.
- one_occ (OneOcc fun_or_arg _ _ _ _) = isFun fun_or_arg
- one_occ other_bind = False
+ not_fun_ty ty = not (maybeToBool (getFunTy_maybe rho_ty))
+ where
+ (_, rho_ty) = splitForAllTy ty
+
+ -- A variable RHS
+ var_rhs (Var v) = True
+ var_rhs other_rhs = False
\end{code}
@occAnalRhs@ deals with the question of bindings where the Id is marked
--
GitLab