From 0cb389e5f07d29f92456a3c17361565b8b5ef865 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Tue, 14 Aug 2012 17:06:00 +0100
Subject: [PATCH] Fix Trac #7128, by zonking kind varaibles more assiduously
when typechecking a class declaration
MERGED from commit e949162653b65d8e48573e84583c6509be2f24ed
---
compiler/typecheck/TcHsSyn.lhs | 2 +-
compiler/typecheck/TcTyClsDecls.lhs | 19 +++++++++++++++----
2 files changed, 16 insertions(+), 5 deletions(-)
diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 922b2cd40411..2a3b2a4c1f7a 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -29,7 +29,7 @@ module TcHsSyn (
zonkTopDecls, zonkTopExpr, zonkTopLExpr,
zonkTopBndrs, zonkTyBndrsX,
emptyZonkEnv, mkEmptyZonkEnv, mkTyVarZonkEnv,
- zonkTcTypeToType, zonkTcTypeToTypes
+ zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc,
) where
#include "HsVersions.h"
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index e5255486917e..930735c6676c 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -568,12 +568,15 @@ tcTyClDecl1 _parent calc_isrec
; ctxt' <- tcHsContext ctxt
; ctxt' <- zonkTcTypeToTypes emptyZonkEnv ctxt'
- -- Squeeze out any kind unification variables
-
+ -- Squeeze out any kind unification variables
; fds' <- mapM (addLocM tc_fundep) fundeps
; (sig_stuff, gen_dm_env) <- tcClassSigs class_name sigs meths
+ ; env <- getLclTypeEnv
+ ; traceTc "tcClassDecl" (ppr fundeps $$ ppr tvs' $$ ppr fds' $$ ppr env)
; return (tvs', ctxt', fds', sig_stuff, gen_dm_env) }
+
+
; clas <- fixM $ \ clas -> do
{ let -- This little knot is just so we can get
-- hold of the name of the class TyCon, which we
@@ -602,9 +605,17 @@ tcTyClDecl1 _parent calc_isrec
-- tying the the type and class declaration type checking knot.
}
where
- tc_fundep (tvs1, tvs2) = do { tvs1' <- mapM tcLookupTyVar tvs1 ;
- ; tvs2' <- mapM tcLookupTyVar tvs2 ;
+ tc_fundep (tvs1, tvs2) = do { tvs1' <- mapM tc_fd_tyvar tvs1 ;
+ ; tvs2' <- mapM tc_fd_tyvar tvs2 ;
; return (tvs1', tvs2') }
+ tc_fd_tyvar name -- Scoped kind variables are bound to unification variables
+ -- which are now fixed, so we can zonk
+ = do { tv <- tcLookupTyVar name
+ ; ty <- zonkTyVarOcc emptyZonkEnv tv
+ -- Squeeze out any kind unification variables
+ ; case getTyVar_maybe ty of
+ Just tv' -> return tv'
+ Nothing -> pprPanic "tc_fd_tyvar" (ppr name $$ ppr tv $$ ppr ty) }
tcTyClDecl1 _ _
(ForeignType {tcdLName = L _ tc_name, tcdExtName = tc_ext_name})
--
GitLab