From: simonpj <unknown>
Date: Tue, 16 Jun 1998 16:44:27 +0000 (+0000)
Subject: [project @ 1998-06-16 16:44:27 by simonpj]
X-Git-Tag: Approx_2487_patches~570
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=db4486e51bcbaf37e46ca045359ac736a8bec436;p=ghc-hetmet.git

[project @ 1998-06-16 16:44:27 by simonpj]
alleged fix to SetLevels
---

diff --git a/ghc/compiler/simplCore/SetLevels.lhs b/ghc/compiler/simplCore/SetLevels.lhs
index 165cf95..a99bcfd 100644
--- a/ghc/compiler/simplCore/SetLevels.lhs
+++ b/ghc/compiler/simplCore/SetLevels.lhs
@@ -23,13 +23,13 @@ module SetLevels (
 import AnnCoreSyn
 import CoreSyn
 
-import CoreUtils	( coreExprType )
+import CoreUtils	( coreExprType, idSpecVars )
 import CoreUnfold	( FormSummary, whnfOrBottom, mkFormSummary )
 import FreeVars		-- all of it
 import MkId		( mkSysLocal )
 import Id		( idType,
 			  nullIdEnv, addOneToIdEnv, growIdEnvList,
-			  unionManyIdSets, minusIdSet, mkIdSet,
+			  unionManyIdSets, unionIdSets, minusIdSet, mkIdSet,
 			  idSetToList, Id,
 			  lookupIdEnv, IdEnv
 			)
@@ -643,7 +643,9 @@ decideRecFloatLevel ctxt_lvl envs@(venv, tenv) ids rhss
   where
     tys  = map idType ids
 
-    fvs  = unionManyIdSets [freeVarsOf   rhs | rhs <- rhss] `minusIdSet` mkIdSet ids
+    fvs  = (unionManyIdSets [freeVarsOf   rhs | rhs <- rhss] `unionIdSets`
+	    mkIdSet (concat (map idSpecVars ids)))
+	   `minusIdSet` mkIdSet ids
     tfvs = unionManyTyVarSets [freeTyVarsOf rhs | rhs <- rhss]
 	   `unionTyVarSets`
 	   tyVarsOfTypes tys