From: simonpj <unknown>
Date: Wed, 16 Mar 2005 09:04:26 +0000 (+0000)
Subject: [project @ 2005-03-16 09:04:26 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~905
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ad626c2450db94ae9094ff7f633afc2974babf7f;p=ghc-hetmet.git

[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

....
---

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 '*'