Wibbles to yesterday's "Simplify kind generalisation" patch
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 22 May 2013 16:43:56 +0000 (17:43 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 22 May 2013 16:44:20 +0000 (17:44 +0100)
In particular, in mkExport we must quantify over the kind
variables mentioned in the kinds of the free type variables

compiler/typecheck/TcBinds.lhs
compiler/typecheck/TcSimplify.lhs

index c992faa..b8bef9e 100644 (file)
@@ -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
index 226b486..2cbb5af 100644 (file)
@@ -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