[project @ 2004-08-26 15:44:50 by simonpj]
[ghc-hetmet.git] / ghc / compiler / prelude / TysPrim.lhs
index 7c16614..0cc59d9 100644 (file)
@@ -3,9 +3,6 @@
 %
 \section[TysPrim]{Wired-in knowledge about primitive types}
 
-This module tracks the ``state interface'' document, ``GHC prelude:
-types and operations.''
-
 \begin{code}
 module TysPrim(
        alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
@@ -38,24 +35,32 @@ module TysPrim(
        foreignObjPrimTyCon,            foreignObjPrimTy,
        threadIdPrimTyCon,              threadIdPrimTy,
        
-       int64PrimTyCon,         int64PrimTy,
-       word64PrimTyCon,        word64PrimTy,
+       int32PrimTyCon,         int32PrimTy,
+       word32PrimTyCon,        word32PrimTy,
 
-       primRepTyCon
+       int64PrimTyCon,         int64PrimTy,
+       word64PrimTyCon,        word64PrimTy
   ) where
 
 #include "HsVersions.h"
 
-import Var             ( TyVar, mkSysTyVar )
-import Name            ( Name )
-import PrimRep         ( PrimRep(..) )
-import TyCon           ( TyCon, ArgVrcs, mkPrimTyCon )
+import Var             ( TyVar, mkTyVar )
+import Name            ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName )
+import OccName         ( mkVarOcc, mkOccFS, tcName )
+import TyCon           ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon,
+                         PrimRep(..) )
 import Type            ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
-                         unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKinds
+                         unliftedTypeKind, liftedTypeKind, openTypeKind, 
+                         Kind, mkArrowKinds,
+                         TyThing(..)
                        )
+import SrcLoc          ( noSrcLoc )
 import Unique          ( mkAlphaTyVarUnique )
 import PrelNames
+import FastString      ( FastString, mkFastString )
 import Outputable
+
+import Char            ( ord, chr )
 \end{code}
 
 %************************************************************************
@@ -74,6 +79,7 @@ primTyCons
     , doublePrimTyCon
     , floatPrimTyCon
     , intPrimTyCon
+    , int32PrimTyCon
     , int64PrimTyCon
     , foreignObjPrimTyCon
     , bcoPrimTyCon
@@ -88,10 +94,43 @@ primTyCons
     , statePrimTyCon
     , threadIdPrimTyCon
     , wordPrimTyCon
+    , word32PrimTyCon
     , word64PrimTyCon
     ]
-\end{code}
 
+mkPrimTc :: FastString -> Unique -> TyCon -> Name
+mkPrimTc fs uniq tycon
+  = mkWiredInName gHC_PRIM (mkOccFS tcName fs) 
+                 uniq
+                 Nothing               -- No parent object
+                 (ATyCon tycon)        -- Relevant TyCon
+                 UserSyntax            -- None are built-in syntax
+
+charPrimTyConName            = mkPrimTc FSLIT("Char#") charPrimTyConKey charPrimTyCon
+intPrimTyConName             = mkPrimTc FSLIT("Int#") intPrimTyConKey  intPrimTyCon
+int32PrimTyConName           = mkPrimTc FSLIT("Int32#") int32PrimTyConKey int32PrimTyCon
+int64PrimTyConName           = mkPrimTc FSLIT("Int64#") int64PrimTyConKey int64PrimTyCon
+wordPrimTyConName            = mkPrimTc FSLIT("Word#") wordPrimTyConKey wordPrimTyCon
+word32PrimTyConName          = mkPrimTc FSLIT("Word32#") word32PrimTyConKey word32PrimTyCon
+word64PrimTyConName          = mkPrimTc FSLIT("Word64#") word64PrimTyConKey word64PrimTyCon
+addrPrimTyConName            = mkPrimTc FSLIT("Addr#") addrPrimTyConKey addrPrimTyCon
+floatPrimTyConName           = mkPrimTc FSLIT("Float#") floatPrimTyConKey floatPrimTyCon
+doublePrimTyConName          = mkPrimTc FSLIT("Double#") doublePrimTyConKey doublePrimTyCon
+statePrimTyConName           = mkPrimTc FSLIT("State#") statePrimTyConKey statePrimTyCon
+realWorldTyConName           = mkPrimTc FSLIT("RealWorld") realWorldTyConKey realWorldTyCon
+arrayPrimTyConName           = mkPrimTc FSLIT("Array#") arrayPrimTyConKey arrayPrimTyCon
+byteArrayPrimTyConName       = mkPrimTc FSLIT("ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon
+mutableArrayPrimTyConName     = mkPrimTc FSLIT("MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon
+mutableByteArrayPrimTyConName = mkPrimTc FSLIT("MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon
+mutVarPrimTyConName          = mkPrimTc FSLIT("MutVar#") mutVarPrimTyConKey mutVarPrimTyCon
+mVarPrimTyConName            = mkPrimTc FSLIT("MVar#") mVarPrimTyConKey mVarPrimTyCon
+stablePtrPrimTyConName        = mkPrimTc FSLIT("StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon
+stableNamePrimTyConName       = mkPrimTc FSLIT("StableName#") stableNamePrimTyConKey stableNamePrimTyCon
+foreignObjPrimTyConName       = mkPrimTc FSLIT("ForeignObj#") foreignObjPrimTyConKey foreignObjPrimTyCon
+bcoPrimTyConName             = mkPrimTc FSLIT("BCO#") bcoPrimTyConKey bcoPrimTyCon
+weakPrimTyConName            = mkPrimTc FSLIT("Weak#") weakPrimTyConKey weakPrimTyCon
+threadIdPrimTyConName                = mkPrimTc FSLIT("ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon
+\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -99,10 +138,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 (mkInternalName (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 +166,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 +195,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
@@ -158,17 +205,23 @@ pcPrimTyCon0 name rep
     result_kind = unliftedTypeKind -- all primitive types are unlifted
 
 charPrimTy     = mkTyConTy charPrimTyCon
-charPrimTyCon  = pcPrimTyCon0 charPrimTyConName CharRep
+charPrimTyCon  = pcPrimTyCon0 charPrimTyConName WordRep
 
 intPrimTy      = mkTyConTy intPrimTyCon
 intPrimTyCon   = pcPrimTyCon0 intPrimTyConName IntRep
 
+int32PrimTy    = mkTyConTy int32PrimTyCon
+int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName IntRep
+
 int64PrimTy    = mkTyConTy int64PrimTyCon
 int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep
 
 wordPrimTy     = mkTyConTy wordPrimTyCon
 wordPrimTyCon  = pcPrimTyCon0 wordPrimTyConName WordRep
 
+word32PrimTy   = mkTyConTy word32PrimTyCon
+word32PrimTyCon        = pcPrimTyCon0 word32PrimTyConName WordRep
+
 word64PrimTy   = mkTyConTy word64PrimTyCon
 word64PrimTyCon        = pcPrimTyCon0 word64PrimTyConName Word64Rep
 
@@ -204,11 +257,11 @@ statePrimTyCon     = pcPrimTyCon statePrimTyConName vrcsZ VoidRep
 \end{code}
 
 RealWorld is deeply magical.  It is *primitive*, but it is not
-*unlifted* (hence PrimPtrRep).  We never manipulate values of type
+*unlifted* (hence ptrArg).  We never manipulate values of type
 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 [] PtrRep
 realWorldTy         = mkTyConTy realWorldTyCon
 realWorldStatePrimTy = mkStatePrimTy realWorldTy       -- State# RealWorld
 \end{code}
@@ -224,10 +277,10 @@ defined in \tr{TysWiredIn.lhs}, not here.
 %************************************************************************
 
 \begin{code}
-arrayPrimTyCon           = pcPrimTyCon  arrayPrimTyConName            vrcsP  ArrayRep
-mutableArrayPrimTyCon    = pcPrimTyCon  mutableArrayPrimTyConName     vrcsZP ArrayRep
-mutableByteArrayPrimTyCon = pcPrimTyCon  mutableByteArrayPrimTyConName vrcsZ  ByteArrayRep
-byteArrayPrimTyCon       = pcPrimTyCon0 byteArrayPrimTyConName               ByteArrayRep
+arrayPrimTyCon           = pcPrimTyCon  arrayPrimTyConName            vrcsP  PtrRep
+mutableArrayPrimTyCon    = pcPrimTyCon  mutableArrayPrimTyConName     vrcsZP PtrRep
+mutableByteArrayPrimTyCon = pcPrimTyCon  mutableByteArrayPrimTyConName vrcsZ  PtrRep
+byteArrayPrimTyCon       = pcPrimTyCon0 byteArrayPrimTyConName               PtrRep
 
 mkArrayPrimTy elt          = mkTyConApp arrayPrimTyCon [elt]
 byteArrayPrimTy                    = mkTyConTy byteArrayPrimTyCon
@@ -242,7 +295,7 @@ mkMutableByteArrayPrimTy s  = mkTyConApp mutableByteArrayPrimTyCon [s]
 %************************************************************************
 
 \begin{code}
-mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PrimPtrRep
+mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep
 
 mkMutVarPrimTy s elt       = mkTyConApp mutVarPrimTyCon [s, elt]
 \end{code}
@@ -254,7 +307,7 @@ mkMutVarPrimTy s elt            = mkTyConApp mutVarPrimTyCon [s, elt]
 %************************************************************************
 
 \begin{code}
-mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PrimPtrRep
+mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep
 
 mkMVarPrimTy s elt         = mkTyConApp mVarPrimTyCon [s, elt]
 \end{code}
@@ -266,7 +319,7 @@ mkMVarPrimTy s elt      = mkTyConApp mVarPrimTyCon [s, elt]
 %************************************************************************
 
 \begin{code}
-stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP StablePtrRep
+stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP AddrRep
 
 mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
 \end{code}
@@ -278,7 +331,7 @@ mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
 %************************************************************************
 
 \begin{code}
-stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP StableNameRep
+stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep
 
 mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
 \end{code}
@@ -301,9 +354,9 @@ dead before it really was.
 
 \begin{code}
 foreignObjPrimTy    = mkTyConTy foreignObjPrimTyCon
-foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName ForeignObjRep
+foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName PtrRep
 \end{code}
-  
+
 %************************************************************************
 %*                                                                     *
 \subsection[TysPrim-BCOs]{The ``bytecode object'' type}
@@ -312,7 +365,7 @@ foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName ForeignObjRep
 
 \begin{code}
 bcoPrimTy    = mkTyConTy bcoPrimTyCon
-bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName BCORep
+bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep
 \end{code}
   
 %************************************************************************
@@ -322,7 +375,7 @@ bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName BCORep
 %************************************************************************
 
 \begin{code}
-weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP WeakPtrRep
+weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep
 
 mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v]
 \end{code}
@@ -344,31 +397,5 @@ to the thread id internally.
 
 \begin{code}
 threadIdPrimTy    = mkTyConTy threadIdPrimTyCon
-threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName ThreadIdRep
-\end{code}
-
-%************************************************************************
-%*                                                                     *
-\subsection[TysPrim-PrimRep]{Making types from PrimReps}
-%*                                                                     *
-%************************************************************************
-
-Each of the primitive types from this module is equivalent to a
-PrimRep (see PrimRep.lhs).  The following function returns the
-primitive TyCon for a given PrimRep.
-
-\begin{code}
-primRepTyCon CharRep       = charPrimTyCon
-primRepTyCon Int8Rep       = charPrimTyCon
-primRepTyCon IntRep        = intPrimTyCon
-primRepTyCon WordRep       = wordPrimTyCon
-primRepTyCon Int64Rep      = int64PrimTyCon
-primRepTyCon Word64Rep     = word64PrimTyCon
-primRepTyCon AddrRep       = addrPrimTyCon
-primRepTyCon FloatRep      = floatPrimTyCon
-primRepTyCon DoubleRep     = doublePrimTyCon
-primRepTyCon StablePtrRep  = stablePtrPrimTyCon
-primRepTyCon ForeignObjRep = foreignObjPrimTyCon
-primRepTyCon WeakPtrRep    = weakPrimTyCon
-primRepTyCon other         = pprPanic "primRepTyCon" (ppr other)
+threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep
 \end{code}