%
\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, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
+ alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
alphaTy, betaTy, gammaTy, deltaTy,
- openAlphaTyVar, openAlphaTyVars,
+ openAlphaTy, openAlphaTyVar, openAlphaTyVars,
+
+ primTyCons,
charPrimTyCon, charPrimTy,
intPrimTyCon, intPrimTy,
mVarPrimTyCon, mkMVarPrimTy,
stablePtrPrimTyCon, mkStablePtrPrimTy,
+ stableNamePrimTyCon, mkStableNamePrimTy,
+ bcoPrimTyCon, bcoPrimTy,
weakPrimTyCon, mkWeakPrimTy,
foreignObjPrimTyCon, foreignObjPrimTy,
threadIdPrimTyCon, threadIdPrimTy,
- int64PrimTyCon, int64PrimTy,
- word64PrimTyCon, word64PrimTy,
-
- primRepTyCon,
+ int32PrimTyCon, int32PrimTy,
+ word32PrimTyCon, word32PrimTy,
- pcPrimTyCon
+ int64PrimTyCon, int64PrimTy,
+ word64PrimTyCon, word64PrimTy
) where
#include "HsVersions.h"
-import Var ( TyVar, mkSysTyVar )
-import Name ( mkWiredInTyConName )
-import PrimRep ( PrimRep(..), isFollowableRep )
-import TyCon ( mkPrimTyCon, TyCon )
-import Type ( Type,
- mkTyConApp, mkTyConTy, mkTyVarTys,
- unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds
+import Var ( TyVar, mkTyVar )
+import Name ( Name, mkInternalName, mkWiredInName )
+import OccName ( mkVarOcc, mkOccFS, tcName )
+import PrimRep ( PrimRep(..) )
+import TyCon ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon )
+import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
+ unliftedTypeKind, liftedTypeKind, openTypeKind,
+ Kind, mkArrowKinds,
+ TyThing(..)
)
-import PrelMods ( pREL_GHC )
+import SrcLoc ( noSrcLoc )
+import Unique ( mkAlphaTyVarUnique )
+import PrelNames
+import FastString ( FastString, mkFastString )
import Outputable
-import Unique
+
+import Char ( ord, chr )
\end{code}
+%************************************************************************
+%* *
+\subsection{Primitive type constructors}
+%* *
+%************************************************************************
+
+\begin{code}
+primTyCons :: [TyCon]
+primTyCons
+ = [ addrPrimTyCon
+ , arrayPrimTyCon
+ , byteArrayPrimTyCon
+ , charPrimTyCon
+ , doublePrimTyCon
+ , floatPrimTyCon
+ , intPrimTyCon
+ , int32PrimTyCon
+ , int64PrimTyCon
+ , foreignObjPrimTyCon
+ , bcoPrimTyCon
+ , weakPrimTyCon
+ , mutableArrayPrimTyCon
+ , mutableByteArrayPrimTyCon
+ , mVarPrimTyCon
+ , mutVarPrimTyCon
+ , realWorldTyCon
+ , stablePtrPrimTyCon
+ , stableNamePrimTyCon
+ , statePrimTyCon
+ , threadIdPrimTyCon
+ , wordPrimTyCon
+ , word32PrimTyCon
+ , word64PrimTyCon
+ ]
+
+mkPrimTc :: FastString -> Unique -> TyCon -> Name
+mkPrimTc fs uniq tycon
+ = mkWiredInName gHC_PRIM (mkOccFS tcName fs)
+ uniq
+ Nothing -- No parent object
+ (ATyCon tycon) -- Relevant TyCon
+
+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}
+
+%************************************************************************
+%* *
+\subsection{Support code}
+%* *
+%************************************************************************
+
+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 boxedTypeKind
- | u <- map mkAlphaTyVarUnique [2..] ]
+alphaTyVars = tyVarList liftedTypeKind
+
+betaTyVars = tail alphaTyVars
alphaTyVar, betaTyVar, gammaTyVar :: TyVar
(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = 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
-
openAlphaTyVars :: [TyVar]
-openAlphaTyVars = [ mkSysTyVar u openTypeKind
- | u <- map mkAlphaTyVarUnique [2..] ]
+openAlphaTyVars@(openAlphaTyVar:_) = tyVarList openTypeKind
+
+openAlphaTy = mkTyVarTy openAlphaTyVar
+
+vrcPos,vrcZero :: (Bool,Bool)
+vrcPos = (True,False)
+vrcZero = (False,False)
+
+vrcsP,vrcsZ,vrcsZP :: ArgVrcs
+vrcsP = [vrcPos]
+vrcsZ = [vrcZero]
+vrcsZP = [vrcZero,vrcPos]
\end{code}
+
%************************************************************************
%* *
\subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)}
\begin{code}
-- only used herein
-pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> PrimRep -> TyCon
-pcPrimTyCon key str arity rep
- = the_tycon
+pcPrimTyCon :: Name -> ArgVrcs -> PrimRep -> TyCon
+pcPrimTyCon name arg_vrcs rep
+ = mkPrimTyCon name kind arity arg_vrcs rep
where
- name = mkWiredInTyConName key pREL_GHC str the_tycon
- the_tycon = mkPrimTyCon name kind arity rep
- kind = mkArrowKinds (take arity (repeat openTypeKind)) result_kind
- result_kind | isFollowableRep rep = boxedTypeKind -- Represented by a GC-ish ptr
- | otherwise = unboxedTypeKind -- Represented by a non-ptr
+ arity = length arg_vrcs
+ kind = mkArrowKinds (replicate arity 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
+ 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
+
+int32PrimTy = mkTyConTy int32PrimTyCon
+int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName Int32Rep
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
+
+word32PrimTy = mkTyConTy word32PrimTyCon
+word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName Word32Rep
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}
%* *
%************************************************************************
-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
\begin{code}
mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty]
-statePrimTyCon = pcPrimTyCon statePrimTyConKey SLIT("State#") 1 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 PtrRep). We never manipulate values of type
+RealWorld; it's only used in the type system, to parameterise State#.
\begin{code}
+realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PtrRep
realWorldTy = mkTyConTy realWorldTyCon
-realWorldTyCon = pcPrimTyCon realWorldTyConKey SLIT("RealWorld") 0 PtrRep
-realWorldStatePrimTy = mkStatePrimTy realWorldTy
+realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld
\end{code}
Note: the ``state-pairing'' types are not truly primitive, so they are
%************************************************************************
\begin{code}
-arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 ArrayRep
-
-byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 ByteArrayRep
-
-mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 2 ArrayRep
-
-mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1 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
%************************************************************************
\begin{code}
-mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConKey SLIT("MutVar#") 2 PtrRep
+mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep
mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt]
\end{code}
%************************************************************************
\begin{code}
-mVarPrimTyCon = pcPrimTyCon mVarPrimTyConKey SLIT("MVar#") 2 PtrRep
+mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep
mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt]
\end{code}
%************************************************************************
\begin{code}
-stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 StablePtrRep
+stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP StablePtrRep
mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
\end{code}
%************************************************************************
%* *
+\subsection[TysPrim-stable-names]{The stable-name type}
+%* *
+%************************************************************************
+
+\begin{code}
+stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep
+
+mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
+\end{code}
+
+%************************************************************************
+%* *
\subsection[TysPrim-foreign-objs]{The ``foreign object'' type}
%* *
%************************************************************************
\begin{code}
foreignObjPrimTy = mkTyConTy foreignObjPrimTyCon
-foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 ForeignObjRep
+foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName PtrRep
+\end{code}
+
+%************************************************************************
+%* *
+\subsection[TysPrim-BCOs]{The ``bytecode object'' type}
+%* *
+%************************************************************************
+
+\begin{code}
+bcoPrimTy = mkTyConTy bcoPrimTyCon
+bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep
\end{code}
%************************************************************************
%************************************************************************
\begin{code}
-weakPrimTyCon = pcPrimTyCon weakPrimTyConKey SLIT("Weak#") 1 WeakPtrRep
+weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep
mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v]
\end{code}
\begin{code}
threadIdPrimTy = mkTyConTy threadIdPrimTyCon
-threadIdPrimTyCon = pcPrimTyCon threadIdPrimTyConKey SLIT("ThreadId#") 0 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 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}