From ad626c2450db94ae9094ff7f633afc2974babf7f Mon Sep 17 00:00:00 2001 From: simonpj Date: Wed, 16 Mar 2005 09:04:26 +0000 Subject: [PATCH] [project @ 2005-03-16 09:04:26 by simonpj] ---------------------------------- Two GADT error-reporting bugs ---------------------------------- Merge to STABLE ...missed file... 1. Bug in kind-checking for GADTs; turned out to be in isOpenTypeKind on KindVars .... --- ghc/compiler/types/Kind.lhs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/ghc/compiler/types/Kind.lhs b/ghc/compiler/types/Kind.lhs index db7fe9a..191dd41 100644 --- a/ghc/compiler/types/Kind.lhs +++ b/ghc/compiler/types/Kind.lhs @@ -145,6 +145,9 @@ isArgTypeKind other = False isOpenTypeKind :: Kind -> Bool -- True of any sub-kind of OpenTypeKind (i.e. anything except arrow) isOpenTypeKind (FunKind _ _) = False +isOpenTypeKind (KindVar _) = False -- This is a conservative answer + -- It matters in the call to isSubKind in + -- checkExpectedKind. isOpenTypeKind other = True isSubKind :: Kind -> Kind -> Bool @@ -154,9 +157,8 @@ isSubKind UnliftedTypeKind UnliftedTypeKind = True isSubKind UbxTupleKind UbxTupleKind = True isSubKind k1 OpenTypeKind = isOpenTypeKind k1 isSubKind k1 ArgTypeKind = isArgTypeKind k1 -isSubKind (FunKind a1 r1) (FunKind a2 r2) - = (a2 `isSubKind` a1) && (r1 `isSubKind` r2) -isSubKind k1 k2 = False +isSubKind (FunKind a1 r1) (FunKind a2 r2) = (a2 `isSubKind` a1) && (r1 `isSubKind` r2) +isSubKind k1 k2 = False defaultKind :: Kind -> Kind -- Used when generalising: default kind '?' and '??' to '*' -- 1.7.10.4