From 9abe8b82ee4ae2363a8895dc6732a0e7ff091526 Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Tue, 9 Sep 1997 17:50:33 +0000
Subject: [PATCH] [project @ 1997-09-09 17:50:33 by sof] Doc update for
simplRecursiveGroup
---
ghc/compiler/simplCore/Simplify.lhs | 20 +++++++++++++++-----
1 file changed, 15 insertions(+), 5 deletions(-)
diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 242bd4b38902..9b527a7825d9 100644
--- a/ghc/compiler/simplCore/Simplify.lhs
+++ b/ghc/compiler/simplCore/Simplify.lhs
@@ -18,7 +18,10 @@ IMPORT_DELOOPER(SmplLoop) -- paranoia checking
import BinderInfo
import CmdLineOpts ( SimplifierSwitch(..) )
import ConFold ( completePrim )
-import CoreUnfold ( Unfolding, SimpleUnfolding, mkFormSummary, exprIsTrivial, whnfOrBottom, FormSummary(..) )
+import CoreUnfold ( Unfolding, SimpleUnfolding, mkFormSummary,
+ exprIsTrivial, whnfOrBottom, inlineUnconditionally,
+ FormSummary(..)
+ )
import CostCentre ( isSccCountCostCentre, cmpCostCentre, costsAreSubsumed, useCurrentCostCentre )
import CoreSyn
import CoreUtils ( coreExprType, nonErrorRHSs, maybeErrorApp,
@@ -888,7 +891,7 @@ Notice that let to case occurs only if x is used strictly in its body
-- Dead code is now discarded by the occurrence analyser,
simplNonRec env binder@(id,occ_info) rhs body_c body_ty
- | inlineUnconditionally ok_to_dup occ_info
+ | inlineUnconditionally ok_to_dup id occ_info
= -- The binder is used in definitely-inline way in the body
-- So add it to the environment, drop the binding, and continue
body_c (extendEnvGivenInlining env id occ_info rhs)
@@ -1150,9 +1153,16 @@ simplRec env pairs body_c body_ty
simplRecursiveGroup env new_ids []
= returnSmpl ([], env)
-simplRecursiveGroup env (new_id : new_ids) ((binder@(_, occ_info), rhs) : pairs)
- | inlineUnconditionally ok_to_dup occ_info
+simplRecursiveGroup env (new_id : new_ids) ((binder@(id, occ_info), rhs) : pairs)
+ | inlineUnconditionally ok_to_dup id occ_info
= -- Single occurrence, so drop binding and extend env with the inlining
+ -- This is a little delicate, because what if the unique occurrence
+ -- is *before* this binding? This'll never happen, because
+ -- either it'll be marked "never inline" or else its occurrence will
+ -- occur after its binding in the group.
+ --
+ -- If these claims aren't right Core Lint will spot an unbound
+ -- variable. A quick fix is to delete this clause for simplRecursiveGroup
let
new_env = extendEnvGivenInlining env new_id occ_info rhs
in
@@ -1274,7 +1284,7 @@ floatBind env top_level bind
leakFree (id,_) rhs = case getIdArity id of
ArityAtLeast n | n > 0 -> True
ArityExactly n | n > 0 -> True
- other -> whnfOrBottom rhs
+ other -> whnfOrBottom (mkFormSummary rhs)
\end{code}
--
GitLab