X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FTysPrim.lhs;h=6e74fd987d64884acb76131e7f162fd4ddc4b32b;hp=19d71db1e92510ef82997346957590c061b9abe5;hb=d436c70d43fb905c63220040168295e473f4b90a;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4 diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 19d71db..6e74fd9 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -4,13 +4,6 @@ \section[TysPrim]{Wired-in knowledge about primitive types} \begin{code} -{-# OPTIONS -w #-} --- The above warning supression flag is a temporary kludge. --- While working on this module you are encouraged to remove it and fix --- any warnings in the module. See --- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings --- for details - module TysPrim( alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar, alphaTy, betaTy, gammaTy, deltaTy, @@ -55,19 +48,14 @@ module TysPrim( import Var ( TyVar, mkTyVar ) import Name ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName ) -import OccName ( mkOccNameFS, tcName, mkTyVarOcc ) -import TyCon ( TyCon, mkPrimTyCon, mkLiftedPrimTyCon, - PrimRep(..) ) -import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, - unliftedTypeKind, - liftedTypeKind, openTypeKind, - Kind, mkArrowKinds, mkArrowKind, - TyThing(..) - ) +import OccName ( mkTyVarOccFS, mkTcOccFS ) +import TyCon ( TyCon, mkPrimTyCon, mkLiftedPrimTyCon ) +import Type import SrcLoc import Unique ( mkAlphaTyVarUnique, pprUnique ) import PrelNames -import FastString ( FastString, mkFastString ) +import StaticFlags +import FastString import Outputable import Char ( ord, chr ) @@ -110,38 +98,39 @@ primTyCons ] mkPrimTc :: FastString -> Unique -> TyCon -> Name -mkPrimTc fs uniq tycon - = mkWiredInName gHC_PRIM (mkOccNameFS tcName fs) - uniq +mkPrimTc fs unique tycon + = mkWiredInName gHC_PRIM (mkTcOccFS fs) + unique (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 -tVarPrimTyConName = mkPrimTc FSLIT("TVar#") tVarPrimTyConKey tVarPrimTyCon -stablePtrPrimTyConName = mkPrimTc FSLIT("StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon -stableNamePrimTyConName = mkPrimTc FSLIT("StableName#") stableNamePrimTyConKey stableNamePrimTyCon -bcoPrimTyConName = mkPrimTc FSLIT("BCO#") bcoPrimTyConKey bcoPrimTyCon -weakPrimTyConName = mkPrimTc FSLIT("Weak#") weakPrimTyConKey weakPrimTyCon -threadIdPrimTyConName = mkPrimTc FSLIT("ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon -anyPrimTyConName = mkPrimTc FSLIT("Any") anyPrimTyConKey anyPrimTyCon -anyPrimTyCon1Name = mkPrimTc FSLIT("Any1") anyPrimTyCon1Key anyPrimTyCon +charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, realWorldTyConName, arrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, anyPrimTyConName, anyPrimTyCon1Name :: Name +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 +tVarPrimTyConName = mkPrimTc (fsLit "TVar#") tVarPrimTyConKey tVarPrimTyCon +stablePtrPrimTyConName = mkPrimTc (fsLit "StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon +stableNamePrimTyConName = mkPrimTc (fsLit "StableName#") stableNamePrimTyConKey stableNamePrimTyCon +bcoPrimTyConName = mkPrimTc (fsLit "BCO#") bcoPrimTyConKey bcoPrimTyCon +weakPrimTyConName = mkPrimTc (fsLit "Weak#") weakPrimTyConKey weakPrimTyCon +threadIdPrimTyConName = mkPrimTc (fsLit "ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon +anyPrimTyConName = mkPrimTc (fsLit "Any") anyPrimTyConKey anyPrimTyCon +anyPrimTyCon1Name = mkPrimTc (fsLit "Any1") anyPrimTyCon1Key anyPrimTyCon \end{code} %************************************************************************ @@ -156,7 +145,7 @@ alphaTyVars is a list of type variables for use in templates: \begin{code} tyVarList :: Kind -> [TyVar] tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u) - (mkTyVarOcc (mkFastString name)) + (mkTyVarOccFS (mkFastString name)) noSrcSpan) kind | u <- [2..], let name | c <= 'z' = [c] @@ -167,20 +156,25 @@ tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u) alphaTyVars :: [TyVar] alphaTyVars = tyVarList liftedTypeKind +betaTyVars :: [TyVar] betaTyVars = tail alphaTyVars -alphaTyVar, betaTyVar, gammaTyVar :: TyVar +alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar :: TyVar (alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars +alphaTys :: [Type] alphaTys = mkTyVarTys alphaTyVars +alphaTy, betaTy, gammaTy, deltaTy :: Type (alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys -- 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") openAlphaTyVars :: [TyVar] +openAlphaTyVar, openBetaTyVar :: TyVar openAlphaTyVars@(openAlphaTyVar:openBetaTyVar:_) = tyVarList openTypeKind +openAlphaTy, openBetaTy :: Type openAlphaTy = mkTyVarTy openAlphaTyVar openBetaTy = mkTyVarTy openBetaTyVar \end{code} @@ -207,34 +201,54 @@ pcPrimTyCon0 name rep where result_kind = unliftedTypeKind +charPrimTy :: Type charPrimTy = mkTyConTy charPrimTyCon +charPrimTyCon :: TyCon charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep +intPrimTy :: Type intPrimTy = mkTyConTy intPrimTyCon +intPrimTyCon :: TyCon intPrimTyCon = pcPrimTyCon0 intPrimTyConName IntRep +int32PrimTy :: Type int32PrimTy = mkTyConTy int32PrimTyCon +int32PrimTyCon :: TyCon int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName IntRep +int64PrimTy :: Type int64PrimTy = mkTyConTy int64PrimTyCon +int64PrimTyCon :: TyCon int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep +wordPrimTy :: Type wordPrimTy = mkTyConTy wordPrimTyCon +wordPrimTyCon :: TyCon wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep +word32PrimTy :: Type word32PrimTy = mkTyConTy word32PrimTyCon +word32PrimTyCon :: TyCon word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep +word64PrimTy :: Type word64PrimTy = mkTyConTy word64PrimTyCon +word64PrimTyCon :: TyCon word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep +addrPrimTy :: Type addrPrimTy = mkTyConTy addrPrimTyCon +addrPrimTyCon :: TyCon addrPrimTyCon = pcPrimTyCon0 addrPrimTyConName AddrRep +floatPrimTy :: Type floatPrimTy = mkTyConTy floatPrimTyCon +floatPrimTyCon :: TyCon floatPrimTyCon = pcPrimTyCon0 floatPrimTyConName FloatRep +doublePrimTy :: Type doublePrimTy = mkTyConTy doublePrimTyCon +doublePrimTyCon :: TyCon doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep \end{code} @@ -255,7 +269,9 @@ where s is a type variable. The only purpose of the type parameter is to keep different state threads separate. It is represented by nothing at all. \begin{code} +mkStatePrimTy :: Type -> Type mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty] +statePrimTyCon :: TyCon statePrimTyCon = pcPrimTyCon statePrimTyConName 1 VoidRep \end{code} @@ -264,8 +280,11 @@ RealWorld is deeply magical. It is *primitive*, but it is not RealWorld; it's only used in the type system, to parameterise State#. \begin{code} +realWorldTyCon :: TyCon realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 PtrRep +realWorldTy :: Type realWorldTy = mkTyConTy realWorldTyCon +realWorldStatePrimTy :: Type realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld \end{code} @@ -290,7 +309,7 @@ lifted type, and back. It's also used to instantiate un-constrained type variables after type checking. For example - lenth Any [] + length Any [] Annoyingly, we sometimes need Anys of other kinds, such as (*->*) etc. This is a bit like tuples. We define a couple of useful ones here, and make others up on the fly. If any of these others end up being exported @@ -298,6 +317,7 @@ into interface files, we'll get a crash; at least until we add interface-file syntax to support them. \begin{code} +anyPrimTy :: Type anyPrimTy = mkTyConApp anyPrimTyCon [] anyPrimTyCon :: TyCon -- Kind * @@ -310,11 +330,12 @@ anyPrimTyCon1 = mkLiftedPrimTyCon anyPrimTyCon1Name kind 0 PtrRep mkAnyPrimTyCon :: Unique -> Kind -> TyCon -- Grotesque hack alert: the client gives the unique; so equality won't work -mkAnyPrimTyCon uniq kind - = pprTrace "Urk! Inventing strangely-kinded Any TyCon:" (ppr uniq <+> ppr kind) +mkAnyPrimTyCon unique kind + = WARN( opt_PprStyle_Debug, ptext (sLit "Urk! Inventing strangely-kinded Any TyCon:") <+> ppr unique <+> ppr kind ) + -- See Note [Strangely-kinded void TyCons] in TcHsSyn tycon where - name = mkPrimTc (mkFastString ("Any" ++ showSDoc (pprUnique uniq))) uniq tycon + name = mkPrimTc (mkFastString ("Any" ++ showSDoc (pprUnique unique))) unique tycon tycon = mkLiftedPrimTyCon name kind 0 PtrRep \end{code} @@ -326,14 +347,20 @@ mkAnyPrimTyCon uniq kind %************************************************************************ \begin{code} +arrayPrimTyCon, mutableArrayPrimTyCon, mutableByteArrayPrimTyCon, + byteArrayPrimTyCon :: TyCon arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName 1 PtrRep mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName 2 PtrRep mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName 1 PtrRep byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName PtrRep +mkArrayPrimTy :: Type -> Type mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt] +byteArrayPrimTy :: Type byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon +mkMutableArrayPrimTy :: Type -> Type -> Type mkMutableArrayPrimTy s elt = mkTyConApp mutableArrayPrimTyCon [s, elt] +mkMutableByteArrayPrimTy :: Type -> Type mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] \end{code} @@ -344,8 +371,10 @@ mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} +mutVarPrimTyCon :: TyCon mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName 2 PtrRep +mkMutVarPrimTy :: Type -> Type -> Type mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} @@ -356,8 +385,10 @@ mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] %************************************************************************ \begin{code} +mVarPrimTyCon :: TyCon mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName 2 PtrRep +mkMVarPrimTy :: Type -> Type -> Type mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} @@ -368,9 +399,11 @@ mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] %************************************************************************ \begin{code} +tVarPrimTyCon :: TyCon tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName 2 PtrRep -mkTVarPrimTy s elt = mkTyConApp tVarPrimTyCon [s, elt] +mkTVarPrimTy :: Type -> Type -> Type +mkTVarPrimTy s elt = mkTyConApp tVarPrimTyCon [s, elt] \end{code} %************************************************************************ @@ -380,8 +413,10 @@ mkTVarPrimTy s elt = mkTyConApp tVarPrimTyCon [s, elt] %************************************************************************ \begin{code} +stablePtrPrimTyCon :: TyCon stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName 1 AddrRep +mkStablePtrPrimTy :: Type -> Type mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] \end{code} @@ -392,8 +427,10 @@ mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] %************************************************************************ \begin{code} +stableNamePrimTyCon :: TyCon stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName 1 PtrRep +mkStableNamePrimTy :: Type -> Type mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] \end{code} @@ -404,7 +441,9 @@ mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] %************************************************************************ \begin{code} +bcoPrimTy :: Type bcoPrimTy = mkTyConTy bcoPrimTyCon +bcoPrimTyCon :: TyCon bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep \end{code} @@ -415,8 +454,10 @@ bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep %************************************************************************ \begin{code} +weakPrimTyCon :: TyCon weakPrimTyCon = pcPrimTyCon weakPrimTyConName 1 PtrRep +mkWeakPrimTy :: Type -> Type mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] \end{code} @@ -436,6 +477,8 @@ Hence the programmer API for thread manipulation uses a weak pointer to the thread id internally. \begin{code} +threadIdPrimTy :: Type threadIdPrimTy = mkTyConTy threadIdPrimTyCon +threadIdPrimTyCon :: TyCon threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep \end{code}