[project @ 1996-07-19 18:36:04 by partain]

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

diff --git a/ghc/compiler/types/Kind.lhs b/ghc/compiler/types/Kind.lhs
index ad6875d..ab77d19 100644 (file)
--- a/ghc/compiler/types/Kind.lhs
+++ b/ghc/compiler/types/Kind.lhs
@@ -17,10 +17,11 @@ module Kind (
        hasMoreBoxityInfo,
        resultKind, argKind,
 
-       isUnboxedKind, isTypeKind
+       isUnboxedKind, isTypeKind,
+       notArrowKind
     ) where
 
-import Ubiq{-uitous-}
+IMP_Ubiq(){-uitous-}
 
 import Util            ( panic, assertPanic )
 --import Outputable    ( Outputable(..) )
@@ -58,11 +59,14 @@ UnboxedTypeKind `hasMoreBoxityInfo` UnboxedTypeKind = True
 
 TypeKind       `hasMoreBoxityInfo` TypeKind        = True
 
-kind1          `hasMoreBoxityInfo` kind2           = ASSERT( notArrowKind kind1 &&
-                                                             notArrowKind kind2 )
-                                                     False
+kind1@(ArrowKind _ _) `hasMoreBoxityInfo` kind2@(ArrowKind _ _) = ASSERT( kind1 == kind2 )
+                                                                 True
+       -- The two kinds can be arrow kinds; for example when unifying
+       -- (m1 Int) and (m2 Int) we end up unifying m1 and m2, which should
+       -- have the same kind.
+
+kind1          `hasMoreBoxityInfo` kind2           = False
 
--- Not exported
 notArrowKind (ArrowKind _ _) = False
 notArrowKind other_kind             = True