[commit: ghc] : Correct the form of implicit datacon workers: only apply existential TVs (4d50df6)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/4d50df6d898d18908a25815c3809a0b3b72cf1bb

>---------------------------------------------------------------

commit 4d50df6d898d18908a25815c3809a0b3b72cf1bb
Author: Max Bolingbroke <[email protected]>
Date:   Mon Aug 1 10:45:08 2011 +0100

    Correct the form of implicit datacon workers: only apply existential TVs

>---------------------------------------------------------------

 compiler/supercompile/Supercompile.hs |    7 ++++---
 1 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/compiler/supercompile/Supercompile.hs b/compiler/supercompile/Supercompile.hs
index 792583a..8c73380 100644
--- a/compiler/supercompile/Supercompile.hs
+++ b/compiler/supercompile/Supercompile.hs
@@ -11,7 +11,7 @@ import CoreSyn
 import CoreFVs    (exprFreeVars)
 import CoreUtils  (exprType)
 import Coercion   (Coercion, isCoVar, isCoVarType, mkCoVarCo)
-import DataCon    (dataConWorkId, dataConAllTyVars, dataConRepArgTys)
+import DataCon    (dataConWorkId, dataConUnivTyVars, dataConExTyVars, dataConRepArgTys)
 import VarSet
 import Name       (localiseName)
 import Var        (Var, isTyVar, varName, setVarName)
@@ -237,8 +237,9 @@ termUnfoldings e = go (S.termFreeVars e) emptyVarSet []
       where (as, arg_tys, _res_ty, _arity, _strictness) = primOpSig pop
             xs = zipWith (mkSysLocal (fsLit "x")) bv_uniques arg_tys
     
-    dataUnfolding dc = S.tyLambdas as $ S.lambdas xs $ S.value (S.Data dc (map mkTyVarTy as) (map mkCoVarCo qs) ys)
-      where as = dataConAllTyVars dc
+    dataUnfolding dc = S.tyLambdas univ_as $ S.tyLambdas ex_as $ S.lambdas xs $ S.value (S.Data dc (map mkTyVarTy ex_as) (map mkCoVarCo qs) ys)
+      where univ_as = dataConUnivTyVars dc
+            ex_as   = dataConExTyVars dc
             arg_tys = dataConRepArgTys dc
             xs = zipWith (mkSysLocal (fsLit "x")) bv_uniques arg_tys
             (qs, ys) = span isCoVar xs