X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=0cc59d98f7c3330aef35c54794cbbfd662a76de9;hb=bb88e732b7383c10496c0f60c3bdea2c22362cc6;hp=9ba28873754da69a84adb1832bfb79c1b5ed0b99;hpb=259be9ef2ecc354d52622479921634606d6d2832;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index 9ba2887..0cc59d9 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -45,18 +45,19 @@ module TysPrim( #include "HsVersions.h" import Var ( TyVar, mkTyVar ) -import Name ( Name, mkInternalName ) -import OccName ( mkVarOcc ) -import PrimRep ( PrimRep(..) ) -import TyCon ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon ) +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, - Kind, mkArrowKinds + Kind, mkArrowKinds, + TyThing(..) ) import SrcLoc ( noSrcLoc ) import Unique ( mkAlphaTyVarUnique ) import PrelNames -import FastString ( mkFastString ) +import FastString ( FastString, mkFastString ) import Outputable import Char ( ord, chr ) @@ -96,8 +97,40 @@ primTyCons , 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} %************************************************************************ %* * @@ -172,13 +205,13 @@ 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 Int32Rep +int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName IntRep int64PrimTy = mkTyConTy int64PrimTyCon int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep @@ -187,7 +220,7 @@ wordPrimTy = mkTyConTy wordPrimTyCon wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep word32PrimTy = mkTyConTy word32PrimTyCon -word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName Word32Rep +word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep word64PrimTy = mkTyConTy word64PrimTyCon word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep @@ -224,7 +257,7 @@ statePrimTyCon = pcPrimTyCon statePrimTyConName vrcsZ VoidRep \end{code} RealWorld is deeply magical. It is *primitive*, but it is not -*unlifted* (hence PtrRep). 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} @@ -286,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}