[commit: ghc] master: Wibbles to yesterday's "Simplify kind generalisation" patch (09b025e)

[Simon Peyton Jones]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/09b025eabf08044b67d047b970cd99add97e9d77

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

commit 09b025eabf08044b67d047b970cd99add97e9d77
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed May 22 17:43:56 2013 +0100

    Wibbles to yesterday's "Simplify kind generalisation" patch
    
    In particular, in mkExport we must quantify over the kind
    variables mentioned in the kinds of the free type variables

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

 compiler/typecheck/TcBinds.lhs    | 9 ++++++---
 compiler/typecheck/TcSimplify.lhs | 1 +
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index c992faa..b8bef9e 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -512,6 +512,7 @@ tcPolyInfer top_lvl rec_tc prag_fn tc_sig_fn mono closed bind_list
                 tcMonoBinds top_lvl rec_tc tc_sig_fn LetLclBndr bind_list
 
        ; let name_taus = [(name, idType mono_id) | (name, _, mono_id) <- mono_infos]
+       ; traceTc "simplifyInfer call" (ppr name_taus $$ ppr wanted)
        ; (qtvs, givens, mr_bites, ev_binds) <- 
                           simplifyInfer closed mono name_taus wanted
 
@@ -558,9 +559,11 @@ mkExport prag_fn qtvs theta (poly_name, mb_sig, mono_id)
               -- In the inference case (no signature) this stuff figures out
               -- the right type variables and theta to quantify over
               -- See Note [Impedence matching]
-              my_tv_set = growThetaTyVars theta (tyVarsOfType mono_ty)
-              my_tvs = filter (`elemVarSet` my_tv_set) qtvs   -- Maintain original order
-              my_theta = filter (quantifyPred my_tv_set) theta
+              my_tvs1 = growThetaTyVars theta (tyVarsOfType mono_ty)
+              my_tvs2 = foldVarSet (\tv tvs -> tyVarsOfType (tyVarKind tv) `unionVarSet` tvs) 
+                                   my_tvs1 my_tvs1            -- Add kind variables!  Trac #7916
+              my_tvs   = filter (`elemVarSet` my_tvs2) qtvs   -- Maintain original order
+              my_theta = filter (quantifyPred my_tvs2) theta
               inferred_poly_ty = mkSigmaTy my_tvs my_theta mono_ty
 
         ; poly_id <- addInlinePrags poly_id prag_sigs
diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs
index 226b486..2cbb5af 100644
--- a/compiler/typecheck/TcSimplify.lhs
+++ b/compiler/typecheck/TcSimplify.lhs
@@ -200,6 +200,7 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds
   | isEmptyWC wanteds
   = do { gbl_tvs <- tcGetGlobalTyVars
        ; qtkvs <- quantifyTyVars gbl_tvs (tyVarsOfTypes (map snd name_taus))
+       ; traceTc "simplifyInfer: emtpy WC" (ppr name_taus $$ ppr qtkvs) 
        ; return (qtkvs, [], False, emptyTcEvBinds) }
 
   | otherwise