[commit: ghc] master: Make sure that Constraint is unrelated to other kinds in tcIsSubKind (24a0e44)

[Simon Peyton Jones]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/24a0e442ed928e363c594c6389a72852b393b3f9

>---------------------------------------------------------------

commit 24a0e442ed928e363c594c6389a72852b393b3f9
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Sun Mar 3 22:49:23 2013 +0000

    Make sure that Constraint is unrelated to other kinds in tcIsSubKind
    
    This was causing the bug reported in Trac #7697

>---------------------------------------------------------------

 compiler/types/Kind.lhs | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs
index aa99aac..0082a33 100644
--- a/compiler/types/Kind.lhs
+++ b/compiler/types/Kind.lhs
@@ -239,30 +239,35 @@ isSubKindCon kc1 kc2
   | isOpenTypeKindCon kc2   = isSubOpenTypeKindCon kc1 
   | isConstraintKindCon kc1 = isLiftedTypeKindCon kc2
   | isLiftedTypeKindCon kc1 = isConstraintKindCon kc2
-  | otherwise               = False
     -- See Note [Kind Constraint and kind *]
+  | otherwise               = False
 
 -------------------------
 -- Hack alert: we need a tiny variant for the typechecker
 -- Reason:     f :: Int -> (a~b)
 --             g :: forall (c::Constraint). Int -> c
+--             h :: Int => Int
 -- We want to reject these, even though Constraint is
 -- a sub-kind of OpenTypeKind.  It must be a sub-kind of OpenTypeKind
 -- *after* the typechecker
 --   a) So that (Ord a -> Eq a) is a legal type
 --   b) So that the simplifer can generate (error (Eq a) "urk")
+-- Moreover, after the type checker, Constraint and *
+-- are identical; see Note [Kind Constraint and kind *]
 --
--- Easiest way to reject is simply to make Constraint not
+-- Easiest way to reject is simply to make Constraint a compliete
 -- below OpenTypeKind when type checking
 
 tcIsSubKind :: Kind -> Kind -> Bool
 tcIsSubKind k1 k2
   | isConstraintKind k1 = isConstraintKind k2
+  | isConstraintKind k2 = isConstraintKind k1
   | otherwise           = isSubKind k1 k2
 
 tcIsSubKindCon :: TyCon -> TyCon -> Bool
 tcIsSubKindCon kc1 kc2
   | isConstraintKindCon kc1 = isConstraintKindCon kc2
+  | isConstraintKindCon kc2 = isConstraintKindCon kc1
   | otherwise               = isSubKindCon kc1 kc2
 
 -------------------------