X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=a0770af428bc261764918329b968e78299c75115;hb=5a387d82672b4648c38793a57a69cfda07f1baff;hp=4acf8a55b3e673f6e2004531aa1cbed213e3c53d;hpb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index 4acf8a5..a0770af 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -8,9 +8,11 @@ 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, @@ -30,37 +32,102 @@ module TysPrim( mVarPrimTyCon, mkMVarPrimTy, stablePtrPrimTyCon, mkStablePtrPrimTy, + stableNamePrimTyCon, mkStableNamePrimTy, + bcoPrimTyCon, bcoPrimTy, weakPrimTyCon, mkWeakPrimTy, foreignObjPrimTyCon, foreignObjPrimTy, threadIdPrimTyCon, threadIdPrimTy, + int32PrimTyCon, int32PrimTy, + word32PrimTyCon, word32PrimTy, + int64PrimTyCon, int64PrimTy, word64PrimTyCon, word64PrimTy, - primRepTyCon, - - pcPrimTyCon + primRepTyCon ) 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, mkLocalName ) +import OccName ( mkVarOcc ) +import PrimRep ( PrimRep(..) ) +import TyCon ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon ) +import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, + unliftedTypeKind, liftedTypeKind, openTypeKind, + Kind, mkArrowKinds ) -import PrelMods ( pREL_GHC ) +import SrcLoc ( noSrcLoc ) +import Unique ( mkAlphaTyVarUnique ) +import PrelNames +import 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 + ] +\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 (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 boxedTypeKind - | u <- map mkAlphaTyVarUnique [2..] ] +alphaTyVars = tyVarList liftedTypeKind + +betaTyVars = tail alphaTyVars alphaTyVar, betaTyVar, gammaTyVar :: TyVar (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars @@ -69,16 +136,24 @@ 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 - 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.)} @@ -87,39 +162,49 @@ openAlphaTyVars = [ mkSysTyVar u openTypeKind \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 + 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 - 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 + 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} @@ -129,7 +214,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 @@ -140,18 +225,17 @@ 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 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 = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PrimPtrRep 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 @@ -165,13 +249,10 @@ defined in \tr{TysWiredIn.lhs}, not here. %************************************************************************ \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 ArrayRep +mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName vrcsZP ArrayRep +mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName vrcsZ ByteArrayRep +byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName ByteArrayRep mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt] byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon @@ -186,7 +267,7 @@ mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} -mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConKey SLIT("MutVar#") 2 PtrRep +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PrimPtrRep mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} @@ -198,7 +279,7 @@ mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -mVarPrimTyCon = pcPrimTyCon mVarPrimTyConKey SLIT("MVar#") 2 PtrRep +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PrimPtrRep mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} @@ -210,13 +291,25 @@ mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] %************************************************************************ \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 StableNameRep + +mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] +\end{code} + +%************************************************************************ +%* * \subsection[TysPrim-foreign-objs]{The ``foreign object'' type} %* * %************************************************************************ @@ -233,7 +326,18 @@ dead before it really was. \begin{code} foreignObjPrimTy = mkTyConTy foreignObjPrimTyCon -foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 ForeignObjRep +foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName ForeignObjRep +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-BCOs]{The ``bytecode object'' type} +%* * +%************************************************************************ + +\begin{code} +bcoPrimTy = mkTyConTy bcoPrimTyCon +bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName BCORep \end{code} %************************************************************************ @@ -243,7 +347,7 @@ foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 F %************************************************************************ \begin{code} -weakPrimTyCon = pcPrimTyCon weakPrimTyConKey SLIT("Weak#") 1 WeakPtrRep +weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP WeakPtrRep mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] \end{code} @@ -265,7 +369,7 @@ to the thread id internally. \begin{code} threadIdPrimTy = mkTyConTy threadIdPrimTyCon -threadIdPrimTyCon = pcPrimTyCon threadIdPrimTyConKey SLIT("ThreadId#") 0 ThreadIdRep +threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName ThreadIdRep \end{code} %************************************************************************ @@ -279,16 +383,19 @@ 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 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 +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}