From: sof <unknown>
Date: Tue, 9 Sep 1997 17:50:33 +0000 (+0000)
Subject: [project @ 1997-09-09 17:50:33 by sof]
X-Git-Tag: Approx_2487_patches~1508
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=9abe8b82ee4ae2363a8895dc6732a0e7ff091526;p=ghc-hetmet.git

[project @ 1997-09-09 17:50:33 by sof]
Doc update for simplRecursiveGroup
---

diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs
index 242bd4b..9b527a7 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}