Repository : http://darcs.haskell.org/ghc.git/
On branch : master https://github.com/ghc/ghc/commit/09b025eabf08044b67d047b970cd99add97e9d77 >--------------------------------------------------------------- commit 09b025eabf08044b67d047b970cd99add97e9d77 Author: Simon Peyton Jones <[email protected]> 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 _______________________________________________ ghc-commits mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-commits
