From: simonpj <unknown>
Date: Wed, 9 May 2001 13:46:29 +0000 (+0000)
Subject: [project @ 2001-05-09 13:46:29 by simonpj]
X-Git-Tag: Approximately_9120_patches~1964
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=dda636ede142f7f2c82090479cc1b44bb8a6871f;p=ghc-hetmet.git

[project @ 2001-05-09 13:46:29 by simonpj]
Fix bug in spec-constr rule generation [Sergei2]
---

diff --git a/ghc/compiler/specialise/SpecConstr.lhs b/ghc/compiler/specialise/SpecConstr.lhs
index dfea0cb..88d32f5 100644
--- a/ghc/compiler/specialise/SpecConstr.lhs
+++ b/ghc/compiler/specialise/SpecConstr.lhs
@@ -468,18 +468,17 @@ spec_one :: ScEnv
   Example
   
      In-scope: a, x::a   
-     f = /\b \y::[(a,b)] -> ....f (b,c) ((:) (a,(b,c)) v (h v))...
-	  [c is presumably bound by the (...) part]
+     f = /\b \y::[(a,b)] -> ....f (b,c) ((:) (a,(b,c)) (x,v) (h w))...
+	  [c::*, v::(b,c) are presumably bound by the (...) part]
   ==>
-     f_spec = /\ b c \ v::(a,(b,c)) -> 
-		  (...entire RHS of f...) (b,c) ((:) (a,(b,c)) v (h v))
+     f_spec = /\ b c \ v::(b,c) hw::[(a,(b,c))] ->
+		  (...entire RHS of f...) (b,c) ((:) (a,(b,c)) (x,v) hw)
   
-     RULE:  forall b c,
-		   y::[(a,(b,c))], 
-		   v::(a,(b,c)), 
-		   h::(a,(b,c))->[(a,(b,c))] .
+     RULE:  forall b::* c::*,		-- Note, *not* forall a, x
+		   v::(b,c),
+		   hw::[(a,(b,c))] .
   
-	    f (b,c) ((:) (a,(b,c)) v (h v)) = f_spec b c v
+	    f (b,c) ((:) (a,(b,c)) (x,v) hw) = f_spec b c v hw
 -}
 
 spec_one env fn rhs (pats, n)
@@ -491,14 +490,15 @@ spec_one env fn rhs (pats, n)
 	pat_fvs	     = varSetElems (exprsFreeVars pats)
 	vars_to_bind = filter not_avail pat_fvs
 	not_avail v  = not (v `elemVarEnv` scope env)
-		-- Put the type variables first just for tidiness
+		-- Put the type variables first; the type of a term
+		-- variable may mention a type variable
 	(tvs, ids)   = partition isTyVar vars_to_bind
 	bndrs  	     = tvs ++ ids
 	
 	rule_name = _PK_ ("SC:" ++ showSDoc (ppr fn <> int n))
 	spec_rhs  = mkLams bndrs (mkApps rhs pats)
 	spec_id   = mkUserLocal spec_occ spec_uniq (exprType spec_rhs) fn_loc
-	rule      = Rule rule_name pat_fvs pats (mkVarApps (Var spec_id) bndrs)
+	rule      = Rule rule_name bndrs pats (mkVarApps (Var spec_id) bndrs)
     in
     returnUs (rule, (spec_id, spec_rhs))
 \end{code}