X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=a0770af428bc261764918329b968e78299c75115;hb=5a387d82672b4648c38793a57a69cfda07f1baff;hp=7c16614bf1118e19859bb6e90df7dff88d871363;hpb=cbdeae8fc8a1c72d20d89241acae8a313214b51c;p=ghc-hetmet.git

diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs
index 7c16614..a0770af 100644
--- a/ghc/compiler/prelude/TysPrim.lhs
+++ b/ghc/compiler/prelude/TysPrim.lhs
@@ -38,6 +38,9 @@ module TysPrim(
 	foreignObjPrimTyCon,		foreignObjPrimTy,
 	threadIdPrimTyCon,		threadIdPrimTy,
 	
+	int32PrimTyCon,		int32PrimTy,
+	word32PrimTyCon,	word32PrimTy,
+
 	int64PrimTyCon,		int64PrimTy,
 	word64PrimTyCon,	word64PrimTy,
 
@@ -46,16 +49,22 @@ module TysPrim(
 
 #include "HsVersions.h"
 
-import Var		( TyVar, mkSysTyVar )
-import Name		( Name )
+import Var		( TyVar, mkTyVar )
+import Name		( Name, mkLocalName )
+import OccName		( mkVarOcc )
 import PrimRep		( PrimRep(..) )
-import TyCon		( TyCon, ArgVrcs, mkPrimTyCon )
+import TyCon		( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon )
 import Type		( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
-			  unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKinds
+			  unliftedTypeKind, liftedTypeKind, openTypeKind, 
+			  Kind, mkArrowKinds
 			)
+import SrcLoc		( noSrcLoc )
 import Unique		( mkAlphaTyVarUnique )
 import PrelNames
+import FastString	( mkFastString )
 import Outputable
+
+import Char 		( ord, chr )
 \end{code}
 
 %************************************************************************
@@ -74,6 +83,7 @@ primTyCons
     , doublePrimTyCon
     , floatPrimTyCon
     , intPrimTyCon
+    , int32PrimTyCon
     , int64PrimTyCon
     , foreignObjPrimTyCon
     , bcoPrimTyCon
@@ -88,6 +98,7 @@ primTyCons
     , statePrimTyCon
     , threadIdPrimTyCon
     , wordPrimTyCon
+    , word32PrimTyCon
     , word64PrimTyCon
     ]
 \end{code}
@@ -99,10 +110,22 @@ primTyCons
 %*									*
 %************************************************************************
 
+alphaTyVars is a list of type variables for use in templates: 
+	["a", "b", ..., "z", "t1", "t2", ... ]
+
 \begin{code}
+tyVarList :: Kind -> [TyVar]
+tyVarList kind = [ mkTyVar (mkLocalName (mkAlphaTyVarUnique u) 
+				(mkVarOcc (mkFastString name))
+			 	noSrcLoc) kind
+	         | u <- [2..],
+		   let name | c <= 'z'  = [c]
+		            | otherwise = 't':show u
+			    where c = chr (u-2 + ord 'a')
+	         ]
+
 alphaTyVars :: [TyVar]
-alphaTyVars = [ mkSysTyVar u liftedTypeKind
-	      | u <- map mkAlphaTyVarUnique [2..] ]
+alphaTyVars = tyVarList liftedTypeKind
 
 betaTyVars = tail alphaTyVars
 
@@ -115,12 +138,8 @@ alphaTys = mkTyVarTys alphaTyVars
 	-- openAlphaTyVar is prepared to be instantiated
 	-- to a lifted or unlifted type variable.  It's used for the 
 	-- result type for "error", so that we can have (error Int# "Help")
-openAlphaTyVar :: TyVar
-openAlphaTyVar = mkSysTyVar (mkAlphaTyVarUnique 1) openTypeKind
-
 openAlphaTyVars :: [TyVar]
-openAlphaTyVars = [ mkSysTyVar u openTypeKind
-		  | u <- map mkAlphaTyVarUnique [2..] ]
+openAlphaTyVars@(openAlphaTyVar:_) = tyVarList openTypeKind
 
 openAlphaTy = mkTyVarTy openAlphaTyVar
 
@@ -148,7 +167,7 @@ pcPrimTyCon name arg_vrcs rep
   = mkPrimTyCon name kind arity arg_vrcs rep
   where
     arity       = length arg_vrcs
-    kind        = mkArrowKinds (take arity (repeat liftedTypeKind)) result_kind
+    kind        = mkArrowKinds (replicate arity liftedTypeKind) result_kind
     result_kind = unliftedTypeKind -- all primitive types are unlifted
 
 pcPrimTyCon0 :: Name -> PrimRep -> TyCon
@@ -163,12 +182,18 @@ charPrimTyCon	= pcPrimTyCon0 charPrimTyConName CharRep
 intPrimTy	= mkTyConTy intPrimTyCon
 intPrimTyCon	= pcPrimTyCon0 intPrimTyConName IntRep
 
+int32PrimTy	= mkTyConTy int32PrimTyCon
+int32PrimTyCon	= pcPrimTyCon0 int32PrimTyConName Int32Rep
+
 int64PrimTy	= mkTyConTy int64PrimTyCon
 int64PrimTyCon	= pcPrimTyCon0 int64PrimTyConName Int64Rep
 
 wordPrimTy	= mkTyConTy wordPrimTyCon
 wordPrimTyCon	= pcPrimTyCon0 wordPrimTyConName WordRep
 
+word32PrimTy	= mkTyConTy word32PrimTyCon
+word32PrimTyCon	= pcPrimTyCon0 word32PrimTyConName Word32Rep
+
 word64PrimTy	= mkTyConTy word64PrimTyCon
 word64PrimTyCon	= pcPrimTyCon0 word64PrimTyConName Word64Rep
 
@@ -208,7 +233,7 @@ RealWorld is deeply magical.  It is *primitive*, but it is not
 RealWorld; it's only used in the type system, to parameterise State#.
 
 \begin{code}
-realWorldTyCon = mkPrimTyCon realWorldTyConName liftedTypeKind 0 [] PrimPtrRep
+realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PrimPtrRep
 realWorldTy	     = mkTyConTy realWorldTyCon
 realWorldStatePrimTy = mkStatePrimTy realWorldTy	-- State# RealWorld
 \end{code}
@@ -362,7 +387,9 @@ primRepTyCon CharRep       = charPrimTyCon
 primRepTyCon Int8Rep       = charPrimTyCon
 primRepTyCon IntRep        = intPrimTyCon
 primRepTyCon WordRep       = wordPrimTyCon
+primRepTyCon Int32Rep      = int32PrimTyCon
 primRepTyCon Int64Rep      = int64PrimTyCon
+primRepTyCon Word32Rep     = word32PrimTyCon
 primRepTyCon Word64Rep     = word64PrimTyCon
 primRepTyCon AddrRep       = addrPrimTyCon
 primRepTyCon FloatRep      = floatPrimTyCon