Commit 09b025ea authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

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
parent 6806906d
...@@ -512,6 +512,7 @@ tcPolyInfer top_lvl rec_tc prag_fn tc_sig_fn mono closed bind_list ...@@ -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 tcMonoBinds top_lvl rec_tc tc_sig_fn LetLclBndr bind_list
; let name_taus = [(name, idType mono_id) | (name, _, mono_id) <- mono_infos] ; 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) <- ; (qtvs, givens, mr_bites, ev_binds) <-
simplifyInfer closed mono name_taus wanted simplifyInfer closed mono name_taus wanted
...@@ -558,9 +559,11 @@ mkExport prag_fn qtvs theta (poly_name, mb_sig, mono_id) ...@@ -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 -- In the inference case (no signature) this stuff figures out
-- the right type variables and theta to quantify over -- the right type variables and theta to quantify over
-- See Note [Impedence matching] -- See Note [Impedence matching]
my_tv_set = growThetaTyVars theta (tyVarsOfType mono_ty) my_tvs1 = growThetaTyVars theta (tyVarsOfType mono_ty)
my_tvs = filter (`elemVarSet` my_tv_set) qtvs -- Maintain original order my_tvs2 = foldVarSet (\tv tvs -> tyVarsOfType (tyVarKind tv) `unionVarSet` tvs)
my_theta = filter (quantifyPred my_tv_set) theta 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 inferred_poly_ty = mkSigmaTy my_tvs my_theta mono_ty
; poly_id <- addInlinePrags poly_id prag_sigs ; poly_id <- addInlinePrags poly_id prag_sigs
......
...@@ -200,6 +200,7 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds ...@@ -200,6 +200,7 @@ simplifyInfer _top_lvl apply_mr name_taus wanteds
| isEmptyWC wanteds | isEmptyWC wanteds
= do { gbl_tvs <- tcGetGlobalTyVars = do { gbl_tvs <- tcGetGlobalTyVars
; qtkvs <- quantifyTyVars gbl_tvs (tyVarsOfTypes (map snd name_taus)) ; qtkvs <- quantifyTyVars gbl_tvs (tyVarsOfTypes (map snd name_taus))
; traceTc "simplifyInfer: emtpy WC" (ppr name_taus $$ ppr qtkvs)
; return (qtkvs, [], False, emptyTcEvBinds) } ; return (qtkvs, [], False, emptyTcEvBinds) }
| otherwise | otherwise
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment