diff options
| author | simonpj@microsoft.com <unknown> | 2010-03-01 11:14:01 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2010-03-01 11:14:01 +0000 |
| commit | 6d0b77ef003cc4add9a4252863a56416541e93a9 (patch) | |
| tree | 4ccd640c0fa2f435623c4c1619eaf9ce8abce36e /compiler | |
| parent | 06f696924193fd7a028f40db565c70b9421594b0 (diff) | |
| download | haskell-6d0b77ef003cc4add9a4252863a56416541e93a9.tar.gz | |
Tidy up AnyTyCon stuff
If we find ourselves making up an AnyTyCon of kind '??', say,
then default it to liftedTypeKind. And similarly for any sub-kind
of LiftedTypeKind.
This is just a tidy-up.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/prelude/TysPrim.lhs | 19 |
1 files changed, 5 insertions, 14 deletions
diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index a6f9b479f5..3490a827ea 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -46,7 +46,7 @@ module TysPrim( word64PrimTyCon, word64PrimTy, -- * Any - anyTyCon, anyType, anyTyConOfKind, anyTypeOfKind + anyTyCon, anyTyConOfKind, anyTypeOfKind ) where #include "HsVersions.h" @@ -234,7 +234,6 @@ Although Any(*->*), say, doesn't have a binding site, it still needs to have a Unique. Unlike tuples (which are also an infinite family) there is no convenient way to index them, so we use the Unique from their OccName instead. That should be unique, - - both wrt each other, because their strings differ - and wrt any other Name, because Names get uniques with @@ -269,22 +268,14 @@ anyTyConName = mkPrimTc (fsLit "Any") anyTyConKey anyTyCon anyTyCon :: TyCon anyTyCon = mkLiftedPrimTyCon anyTyConName liftedTypeKind 0 PtrRep -anyType :: Type -anyType = mkTyConApp anyTyCon [] - anyTypeOfKind :: Kind -> Type -anyTypeOfKind kind - | isLiftedTypeKind kind = anyType - | otherwise = mkTyConApp (mk_any_tycon kind) [] +anyTypeOfKind kind = mkTyConApp (anyTyConOfKind kind) [] anyTyConOfKind :: Kind -> TyCon +-- Map all superkinds of liftedTypeKind to liftedTypeKind anyTyConOfKind kind - | isLiftedTypeKind kind = anyTyCon - | otherwise = mk_any_tycon kind - -mk_any_tycon :: Kind -> TyCon -mk_any_tycon kind -- Kind other than * - = tycon + | liftedTypeKind `isSubKind` kind = anyTyCon + | otherwise = tycon where -- Derive the name from the kind, thus: -- Any(*->*), Any(*->*->*) |