[project @ 2005-06-22 08:24:22 by simonmar]

[ghc-hetmet.git] / ghc / compiler / types / Kind.lhs

diff --git a/ghc/compiler/types/Kind.lhs b/ghc/compiler/types/Kind.lhs
index 0e88536..ac89b3b 100644 (file)
--- a/ghc/compiler/types/Kind.lhs
+++ b/ghc/compiler/types/Kind.lhs
@@ -50,9 +50,9 @@ In particular:
 
 \begin{code}
 data Kind 
-  = LiftedTypeKind     -- *
+  = LiftedTypeKind     --  *
   | OpenTypeKind       -- ?
-  | UnliftedTypeKind   -- #
+  | UnliftedTypeKind   --  #
   | UbxTupleKind       -- (##)
   | ArgTypeKind                -- ??
   | FunKind Kind Kind  -- k1 -> k2
@@ -60,7 +60,7 @@ data Kind
   deriving( Eq )
 
 data KindVar = KVar Unique (IORef (Maybe SimpleKind))
-  -- INVARIANT: a KindVar can only be instantaited by a SimpleKind
+  -- INVARIANT: a KindVar can only be instantiated by a SimpleKind
 
 type SimpleKind = Kind 
   -- A SimpleKind has no ? or # kinds in it:
@@ -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 '*'