X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSetLevels.lhs;h=8be8dd65e29c3714483f845fc324d4890ec9b983;hb=478b939d1bd08c37ba3e334296eeb448c78491d2;hp=705d54591fbdab28d192d49d0a96c82ee0f214bc;hpb=e2cf518a3dcccdddd609188ddba6fb121c2e25fe;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SetLevels.lhs b/compiler/simplCore/SetLevels.lhs
index 705d545..8be8dd6 100644
--- a/compiler/simplCore/SetLevels.lhs
+++ b/compiler/simplCore/SetLevels.lhs
@@ -669,8 +669,8 @@ type LevelEnv = (FloatOutSwitches,
 	-- We also use these envs when making a variable polymorphic
 	-- because we want to float it out past a big lambda.
 	--
-	-- The SubstEnv and IdEnv always implement the same mapping, but the
-	-- SubstEnv maps to CoreExpr and the IdEnv to LevelledExpr
+	-- The Subst and IdEnv always implement the same mapping, but the
+	-- Subst maps to CoreExpr and the IdEnv to LevelledExpr
 	-- Since the range is always a variable or type application,
 	-- there is never any difference between the two, but sadly
 	-- the types differ.  The SubstEnv is used when substituting in
@@ -773,9 +773,12 @@ abstractVars :: Level -> LevelEnv -> VarSet -> [Var]
 	-- whose level is greater than the destination level
 	-- These are the ones we are going to abstract out
 abstractVars dest_lvl (_, lvl_env, _, id_env) fvs
-  = uniq (sortLe le [var | fv <- varSetElems fvs
-			 , var <- absVarsOf id_env fv
-			 , abstract_me var])
+  = map zap $ uniq $ sortLe le 
+	[var | fv <- varSetElems fvs
+	     , var <- absVarsOf id_env fv
+	     , abstract_me var ]
+	-- NB: it's important to call abstract_me only on the OutIds the
+	-- come from absVarsOf (not on fv, which is an InId)
   where
 	-- Sort the variables so the true type variables come first;
 	-- the tyvars scope over Ids and coercion vars
@@ -796,13 +799,25 @@ abstractVars dest_lvl (_, lvl_env, _, id_env) fvs
 			Just lvl -> dest_lvl `ltLvl` lvl
 			Nothing  -> False
 
+	-- We are going to lambda-abstract, so nuke any IdInfo,
+	-- and add the tyvars of the Id (if necessary)
+    zap v | isId v = WARN( workerExists (idWorkerInfo v) ||
+		           not (isEmptySpecInfo (idSpecialisation v)),
+		           text "absVarsOf: discarding info on" <+> ppr v )
+		     setIdInfo v vanillaIdInfo
+	  | otherwise = v
+
 absVarsOf :: IdEnv ([Var], LevelledExpr) -> Var -> [Var]
 	-- If f is free in the expression, and f maps to poly_f a b c in the
 	-- current substitution, then we must report a b c as candidate type
 	-- variables
+	--
+	-- Also, if x::a is an abstracted variable, then so is a; that is,
+	--	we must look in x's type
+	-- And similarly if x is a coercion variable.
 absVarsOf id_env v 
-  | isId v    = [zap av2 | av1 <- lookup_avs v
-			 , av2 <- add_tyvars av1]
+  | isId v    = [av2 | av1 <- lookup_avs v
+		     , av2 <- add_tyvars av1]
   | isCoVar v = add_tyvars v
   | otherwise = [v]
 
@@ -812,14 +827,6 @@ absVarsOf id_env v
 			Nothing	           -> [v]
 
     add_tyvars v = v : varSetElems (varTypeTyVars v)
-
-	-- We are going to lambda-abstract, so nuke any IdInfo,
-	-- and add the tyvars of the Id (if necessary)
-    zap v | isId v = WARN( workerExists (idWorkerInfo v) ||
-		           not (isEmptySpecInfo (idSpecialisation v)),
-		           text "absVarsOf: discarding info on" <+> ppr v )
-		     setIdInfo v vanillaIdInfo
-	  | otherwise = v
 \end{code}
 
 \begin{code}