[project @ 2001-05-24 13:59:09 by simonpj]
[ghc-hetmet.git] / ghc / compiler / prelude / TysPrim.lhs
index 8b96d6e..7c16614 100644 (file)
@@ -41,23 +41,19 @@ module TysPrim(
        int64PrimTyCon,         int64PrimTy,
        word64PrimTyCon,        word64PrimTy,
 
-       primRepTyCon,
-
-       pcPrimTyCon
+       primRepTyCon
   ) where
 
 #include "HsVersions.h"
 
 import Var             ( TyVar, mkSysTyVar )
-import Name            ( mkWiredInTyConName )
-import OccName         ( mkOccFS, tcName )
-import PrimRep         ( PrimRep(..), isFollowableRep )
-import TyCon           ( mkPrimTyCon, TyCon, ArgVrcs )
-import Type            ( Type, 
-                         mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
-                         unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds
+import Name            ( Name )
+import PrimRep         ( PrimRep(..) )
+import TyCon           ( TyCon, ArgVrcs, mkPrimTyCon )
+import Type            ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
+                         unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKinds
                        )
-import Unique          ( Unique, mkAlphaTyVarUnique )
+import Unique          ( mkAlphaTyVarUnique )
 import PrelNames
 import Outputable
 \end{code}
@@ -105,7 +101,7 @@ primTyCons
 
 \begin{code}
 alphaTyVars :: [TyVar]
-alphaTyVars = [ mkSysTyVar u boxedTypeKind
+alphaTyVars = [ mkSysTyVar u liftedTypeKind
              | u <- map mkAlphaTyVarUnique [2..] ]
 
 betaTyVars = tail alphaTyVars
@@ -117,7 +113,7 @@ alphaTys = mkTyVarTys alphaTyVars
 (alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
 
        -- openAlphaTyVar is prepared to be instantiated
-       -- to a boxed or unboxed type variable.  It's used for the 
+       -- 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
@@ -147,39 +143,43 @@ vrcsZP = [vrcZero,vrcPos]
 
 \begin{code}
 -- only used herein
-pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> ArgVrcs -> PrimRep -> TyCon
-pcPrimTyCon key str arity arg_vrcs rep
-  = the_tycon
+pcPrimTyCon :: Name -> ArgVrcs -> PrimRep -> TyCon
+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
+    result_kind = unliftedTypeKind -- all primitive types are unlifted
+
+pcPrimTyCon0 :: Name -> PrimRep -> TyCon
+pcPrimTyCon0 name rep
+  = mkPrimTyCon name result_kind 0 [] rep
   where
-    name      = mkWiredInTyConName key pREL_GHC (mkOccFS tcName str) the_tycon
-    the_tycon = mkPrimTyCon name kind arity arg_vrcs rep
-    kind      = mkArrowKinds (take arity (repeat boxedTypeKind)) result_kind
-    result_kind | isFollowableRep rep = boxedTypeKind  -- Represented by a GC-ish ptr
-               | otherwise           = unboxedTypeKind -- Represented by a non-ptr
+    result_kind = unliftedTypeKind -- all primitive types are unlifted
 
 charPrimTy     = mkTyConTy charPrimTyCon
-charPrimTyCon  = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 [] CharRep
+charPrimTyCon  = pcPrimTyCon0 charPrimTyConName CharRep
 
 intPrimTy      = mkTyConTy intPrimTyCon
-intPrimTyCon   = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 [] IntRep
+intPrimTyCon   = pcPrimTyCon0 intPrimTyConName IntRep
 
 int64PrimTy    = mkTyConTy int64PrimTyCon
-int64PrimTyCon = pcPrimTyCon int64PrimTyConKey SLIT("Int64#") 0 [] Int64Rep
+int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep
 
 wordPrimTy     = mkTyConTy wordPrimTyCon
-wordPrimTyCon  = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 [] WordRep
+wordPrimTyCon  = pcPrimTyCon0 wordPrimTyConName WordRep
 
 word64PrimTy   = mkTyConTy word64PrimTyCon
-word64PrimTyCon        = pcPrimTyCon word64PrimTyConKey SLIT("Word64#") 0 [] Word64Rep
+word64PrimTyCon        = pcPrimTyCon0 word64PrimTyConName Word64Rep
 
 addrPrimTy     = mkTyConTy addrPrimTyCon
-addrPrimTyCon  = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 [] AddrRep
+addrPrimTyCon  = pcPrimTyCon0 addrPrimTyConName AddrRep
 
 floatPrimTy    = mkTyConTy floatPrimTyCon
-floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 [] FloatRep
+floatPrimTyCon = pcPrimTyCon0 floatPrimTyConName FloatRep
 
 doublePrimTy   = mkTyConTy doublePrimTyCon
-doublePrimTyCon        = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 [] DoubleRep
+doublePrimTyCon        = pcPrimTyCon0 doublePrimTyConName DoubleRep
 \end{code}
 
 
@@ -189,7 +189,7 @@ doublePrimTyCon     = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 [] DoubleRep
 %*                                                                     *
 %************************************************************************
 
-State# is the primitive, unboxed type of states.  It has one type parameter,
+State# is the primitive, unlifted type of states.  It has one type parameter,
 thus
        State# RealWorld
 or
@@ -200,17 +200,16 @@ keep different state threads separate.  It is represented by nothing at all.
 
 \begin{code}
 mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty]
-statePrimTyCon  = pcPrimTyCon statePrimTyConKey SLIT("State#") 1 vrcsZ VoidRep
+statePrimTyCon  = pcPrimTyCon statePrimTyConName vrcsZ VoidRep
 \end{code}
 
-@_RealWorld@ is deeply magical.  It {\em is primitive}, but it
-{\em is not unboxed} (hence PtrRep).
-We never manipulate values of type RealWorld; it's only used in the type
-system, to parameterise State#.
+RealWorld is deeply magical.  It is *primitive*, but it is not
+*unlifted* (hence PrimPtrRep).  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
 realWorldTy         = mkTyConTy realWorldTyCon
-realWorldTyCon      = pcPrimTyCon realWorldTyConKey SLIT("RealWorld") 0 [] PrimPtrRep
 realWorldStatePrimTy = mkStatePrimTy realWorldTy       -- State# RealWorld
 \end{code}
 
@@ -225,15 +224,10 @@ defined in \tr{TysWiredIn.lhs}, not here.
 %************************************************************************
 
 \begin{code}
-arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 vrcsP ArrayRep
-
-byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 [] ByteArrayRep
-
-mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 
-                                    2 vrcsZP ArrayRep
-
-mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#")
-                                        1 vrcsZ ByteArrayRep
+arrayPrimTyCon           = pcPrimTyCon  arrayPrimTyConName            vrcsP  ArrayRep
+mutableArrayPrimTyCon    = pcPrimTyCon  mutableArrayPrimTyConName     vrcsZP ArrayRep
+mutableByteArrayPrimTyCon = pcPrimTyCon  mutableByteArrayPrimTyConName vrcsZ  ByteArrayRep
+byteArrayPrimTyCon       = pcPrimTyCon0 byteArrayPrimTyConName               ByteArrayRep
 
 mkArrayPrimTy elt          = mkTyConApp arrayPrimTyCon [elt]
 byteArrayPrimTy                    = mkTyConTy byteArrayPrimTyCon
@@ -248,8 +242,7 @@ mkMutableByteArrayPrimTy s  = mkTyConApp mutableByteArrayPrimTyCon [s]
 %************************************************************************
 
 \begin{code}
-mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConKey SLIT("MutVar#")
-                              2 vrcsZP PrimPtrRep
+mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PrimPtrRep
 
 mkMutVarPrimTy s elt       = mkTyConApp mutVarPrimTyCon [s, elt]
 \end{code}
@@ -261,8 +254,7 @@ mkMutVarPrimTy s elt            = mkTyConApp mutVarPrimTyCon [s, elt]
 %************************************************************************
 
 \begin{code}
-mVarPrimTyCon = pcPrimTyCon mVarPrimTyConKey SLIT("MVar#")
-                            2 vrcsZP PrimPtrRep
+mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PrimPtrRep
 
 mkMVarPrimTy s elt         = mkTyConApp mVarPrimTyCon [s, elt]
 \end{code}
@@ -274,8 +266,7 @@ mkMVarPrimTy s elt      = mkTyConApp mVarPrimTyCon [s, elt]
 %************************************************************************
 
 \begin{code}
-stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#")
-                                 1 vrcsP StablePtrRep
+stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP StablePtrRep
 
 mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
 \end{code}
@@ -287,8 +278,7 @@ mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
 %************************************************************************
 
 \begin{code}
-stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConKey SLIT("StableName#")
-                                  1 vrcsP StableNameRep
+stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP StableNameRep
 
 mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
 \end{code}
@@ -311,7 +301,7 @@ dead before it really was.
 
 \begin{code}
 foreignObjPrimTy    = mkTyConTy foreignObjPrimTyCon
-foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 [] ForeignObjRep
+foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName ForeignObjRep
 \end{code}
   
 %************************************************************************
@@ -322,7 +312,7 @@ foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 [
 
 \begin{code}
 bcoPrimTy    = mkTyConTy bcoPrimTyCon
-bcoPrimTyCon = pcPrimTyCon bcoPrimTyConKey SLIT("BCO#") 0 [] BCORep
+bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName BCORep
 \end{code}
   
 %************************************************************************
@@ -332,7 +322,7 @@ bcoPrimTyCon = pcPrimTyCon bcoPrimTyConKey SLIT("BCO#") 0 [] BCORep
 %************************************************************************
 
 \begin{code}
-weakPrimTyCon = pcPrimTyCon weakPrimTyConKey SLIT("Weak#") 1 vrcsP WeakPtrRep
+weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP WeakPtrRep
 
 mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v]
 \end{code}
@@ -354,7 +344,7 @@ to the thread id internally.
 
 \begin{code}
 threadIdPrimTy    = mkTyConTy threadIdPrimTyCon
-threadIdPrimTyCon = pcPrimTyCon threadIdPrimTyConKey SLIT("ThreadId#") 0 [] ThreadIdRep
+threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName ThreadIdRep
 \end{code}
 
 %************************************************************************
@@ -368,17 +358,17 @@ 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 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)
+primRepTyCon WeakPtrRep    = weakPrimTyCon
+primRepTyCon other         = pprPanic "primRepTyCon" (ppr other)
 \end{code}