summaryrefslogtreecommitdiff
path: root/compiler/types/Type.lhs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2012-10-02 18:11:08 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2012-10-02 18:11:08 +0100
commit2c207b6f60ba5d271f400747256e4a32ca8f7e63 (patch)
treebdc5712cd97715c9ee4565e2d5ed30be7764eb62 /compiler/types/Type.lhs
parent4708d3838d1d76c4a6d153b3e3a42b97c7d2f9c3 (diff)
downloadhaskell-2c207b6f60ba5d271f400747256e4a32ca8f7e63.tar.gz
Compare the kinds of type variables when comparing types
This is just a bug that's been around since we introduced polymorphic kinds. The roots are in Type.cmpTypeX, but there was a variant in TcRnDriver.checkBootTyCon, which is where it came up. Fixes Trac #7272
Diffstat (limited to 'compiler/types/Type.lhs')
-rw-r--r--compiler/types/Type.lhs16
1 files changed, 14 insertions, 2 deletions
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index a8fb161b7f..57706612e2 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -95,7 +95,7 @@ module Type (
-- * Type comparison
eqType, eqTypeX, eqTypes, cmpType, cmpTypes,
- eqPred, eqPredX, cmpPred, eqKind,
+ eqPred, eqPredX, cmpPred, eqKind, eqTyVarBndrs,
-- * Forcing evaluation of types
seqType, seqTypes,
@@ -1187,6 +1187,17 @@ eqPred = eqType
eqPredX :: RnEnv2 -> PredType -> PredType -> Bool
eqPredX env p1 p2 = isEqual $ cmpTypeX env p1 p2
+
+eqTyVarBndrs :: RnEnv2 -> [TyVar] -> [TyVar] -> Maybe RnEnv2
+-- Check that the tyvar lists are the same length
+-- and have matching kinds; if so, extend the RnEnv2
+-- Returns Nothing if they don't match
+eqTyVarBndrs env [] []
+ = Just env
+eqTyVarBndrs env (tv1:tvs1) (tv2:tvs2)
+ | eqTypeX env (tyVarKind tv1) (tyVarKind tv2)
+ = eqTyVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2
+eqTyVarBndrs _ _ _= Nothing
\end{code}
Now here comes the real worker
@@ -1217,7 +1228,8 @@ cmpTypeX env t1 t2 | Just t1' <- coreView t1 = cmpTypeX env t1' t2
-- So the RHS has a data type
cmpTypeX env (TyVarTy tv1) (TyVarTy tv2) = rnOccL env tv1 `compare` rnOccR env tv2
-cmpTypeX env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = cmpTypeX (rnBndr2 env tv1 tv2) t1 t2
+cmpTypeX env (ForAllTy tv1 t1) (ForAllTy tv2 t2) = cmpTypeX env (tyVarKind tv1) (tyVarKind tv1)
+ `thenCmp` cmpTypeX (rnBndr2 env tv1 tv2) t1 t2
cmpTypeX env (AppTy s1 t1) (AppTy s2 t2) = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
cmpTypeX env (FunTy s1 t1) (FunTy s2 t2) = cmpTypeX env s1 s2 `thenCmp` cmpTypeX env t1 t2
cmpTypeX env (TyConApp tc1 tys1) (TyConApp tc2 tys2) = (tc1 `compare` tc2) `thenCmp` cmpTypesX env tys1 tys2