Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : ghc-kinds
http://hackage.haskell.org/trac/ghc/changeset/801c46e1d9e3f108228481ba6f63a8d9fba246cc >--------------------------------------------------------------- commit 801c46e1d9e3f108228481ba6f63a8d9fba246cc Author: Julien Cretin <g...@ia0.eu> Date: Tue Sep 13 14:29:29 2011 +0200 isSubKind BOX BOX is now valid >--------------------------------------------------------------- compiler/TODO | 4 ---- compiler/types/Kind.lhs | 15 +++++++++------ 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/compiler/TODO b/compiler/TODO index fbd3d91..eea6e40 100644 --- a/compiler/TODO +++ b/compiler/TODO @@ -1,9 +1,5 @@ ## TODO FIRST -* kind substitution in types, substTyVarBndr - look at CoreSubst, substIdBndr - no_kind_change : verify that kind is closed - * UserKiVar (in Parser mkHsForAll or renamer) look at kind annotation to know if a UserTyvar is a kind variable (UserKiVar) or a type variable (UserTyVar) diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs index d75f694..56458a9 100644 --- a/compiler/types/Kind.lhs +++ b/compiler/types/Kind.lhs @@ -183,12 +183,15 @@ isKind k = isSuperKind (typeKind k) isSubKind :: Kind -> Kind -> Bool -- ^ @k1 \`isSubKind\` k2@ checks that @k1@ <: @k2@ -isSubKind (TyConApp kc1 []) (TyConApp kc2 []) = kc1 `isSubKindCon` kc2 --- IA0: isSubKind (TyConApp kc1 k1s) (TyConApp kc2 k2s) = panic "IA0: isSubKind" -- IA0_WHEN: *^n -> * -isSubKind (FunTy a1 r1) (FunTy a2 r2) = (a2 `isSubKind` a1) && (r1 `isSubKind` r2) -isSubKind (TyConApp kc1 k1s) (TyConApp kc2 k2s) = - not (isSubOpenTypeKindCon kc1) && kc1 == kc2 - && length k1s == length k2s && all (uncurry eqKind) (zip k1s k2s) +isSubKind (FunTy a1 r1) (FunTy a2 r2) = (a2 `isSubKind` a1) && (r1 `isSubKind` r2) +isSubKind (TyConApp kc1 k1s) (TyConApp kc2 k2s) + | isSuperKindTyCon kc1 = -- handles BOX + isSuperKindTyCon kc2 && null k1s && null k2s + | isSuperKind (tyConKind kc1) = -- handles not promoted kinds (*, #, (#), etc.) + ASSERT( isSuperKind (tyConKind kc2) && null k1s && null k2s ) + kc1 `isSubKindCon` kc2 + | otherwise = -- handles promoted kinds (List *, Nat, etc.) + kc1 == kc2 && length k1s == length k2s && all (uncurry eqKind) (zip k1s k2s) isSubKind (TyVarTy kv1) (TyVarTy kv2) = kv1 == kv2 isSubKind (ForAllTy {}) (ForAllTy {}) = panic "IA0: isSubKind on ForAllTy" isSubKind _ _ = False _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc