From db4486e51bcbaf37e46ca045359ac736a8bec436 Mon Sep 17 00:00:00 2001 From: simonpj Date: Tue, 16 Jun 1998 16:44:27 +0000 Subject: [PATCH] [project @ 1998-06-16 16:44:27 by simonpj] alleged fix to SetLevels --- ghc/compiler/simplCore/SetLevels.lhs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) 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 -- 1.7.10.4