X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprelude%2FTysPrim.lhs;h=ac3a528f367d5b5b942e61607c7975e6ed8cda35;hb=521b792553bacbdb0eec138b150ab0626ea6f36b;hp=a6f9b479f5d59df8ab3d856096957546f682f2c0;hpb=4455bfc7d1d881e10e4b8269746b73768c7b8296;p=ghc-hetmet.git

diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index a6f9b47..ac3a528 100644
--- a/compiler/prelude/TysPrim.lhs
+++ b/compiler/prelude/TysPrim.lhs
@@ -12,6 +12,7 @@ module TysPrim(
 	alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
 	alphaTy, betaTy, gammaTy, deltaTy,
 	openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar, openAlphaTyVars,
+        argAlphaTy, argAlphaTyVar, argBetaTy, argBetaTyVar,
 
 	primTyCons,
 
@@ -46,7 +47,7 @@ module TysPrim(
 	word64PrimTyCon,	word64PrimTy,
 
 	-- * Any
-	anyTyCon, anyType, anyTyConOfKind, anyTypeOfKind
+	anyTyCon, anyTyConOfKind, anyTypeOfKind
   ) where
 
 #include "HsVersions.h"
@@ -180,7 +181,13 @@ openAlphaTyVars@(openAlphaTyVar:openBetaTyVar:_) = tyVarList openTypeKind
 
 openAlphaTy, openBetaTy :: Type
 openAlphaTy = mkTyVarTy openAlphaTyVar
-openBetaTy   = mkTyVarTy openBetaTyVar
+openBetaTy  = mkTyVarTy openBetaTyVar
+
+argAlphaTyVar, argBetaTyVar :: TyVar
+(argAlphaTyVar : argBetaTyVar : _) = tyVarList argTypeKind
+argAlphaTy, argBetaTy :: Type
+argAlphaTy = mkTyVarTy argAlphaTyVar
+argBetaTy  = mkTyVarTy argBetaTyVar
 \end{code}
 
 
@@ -234,7 +241,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 +275,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(*->*->*)