From 7461c989da4763dcf94dc9b93f5d216d23e030d0 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Fri, 21 Mar 2014 15:24:49 +0000
Subject: [PATCH] Add missing kind-check for tcEqType on forall-types
This wasn't showing up as a bug, but it was definitely wrong.
(cherry picked from commit 74894e0bc405247092e865b9541f5f18d26aa015)
---
compiler/typecheck/TcType.lhs | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/compiler/typecheck/TcType.lhs b/compiler/typecheck/TcType.lhs
index cc4ded499fa5..551b17c6be5c 100644
--- a/compiler/typecheck/TcType.lhs
+++ b/compiler/typecheck/TcType.lhs
@@ -245,7 +245,6 @@ checking. It's attached to mutable type variables only.
It's knot-tied back to Var.lhs. There is no reason in principle
why Var.lhs shouldn't actually have the definition, but it "belongs" here.
-
Note [Signature skolems]
~~~~~~~~~~~~~~~~~~~~~~~~
Consider this
@@ -1008,7 +1007,8 @@ tcEqType ty1 ty2
| Just t2' <- tcView t2 = go env t1 t2'
go env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 == rnOccR env tv2
go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2
- go env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = go (rnBndr2 env tv1 tv2) t1 t2
+ go env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = go env (tyVarKind tv1) (tyVarKind tv2)
+ && go (rnBndr2 env tv1 tv2) t1 t2
go env (AppTy s1 t1) (AppTy s2 t2) = go env s1 s2 && go env t1 t2
go env (FunTy s1 t1) (FunTy s2 t2) = go env s1 s2 && go env t1 t2
go env (TyConApp tc1 ts1) (TyConApp tc2 ts2) = (tc1 == tc2) && gos env ts1 ts2
@@ -1027,7 +1027,8 @@ pickyEqType ty1 ty2
init_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2))
go env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 == rnOccR env tv2
go _ (LitTy lit1) (LitTy lit2) = lit1 == lit2
- go env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = go (rnBndr2 env tv1 tv2) t1 t2
+ go env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = go env (tyVarKind tv1) (tyVarKind tv2)
+ && go (rnBndr2 env tv1 tv2) t1 t2
go env (AppTy s1 t1) (AppTy s2 t2) = go env s1 s2 && go env t1 t2
go env (FunTy s1 t1) (FunTy s2 t2) = go env s1 s2 && go env t1 t2
go env (TyConApp tc1 ts1) (TyConApp tc2 ts2) = (tc1 == tc2) && gos env ts1 ts2
--
GitLab