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

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
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
......
......@@ -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
......
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