X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprelude%2FTysPrim.lhs;h=056c5e47fd5bbac7eb111a59cf791f196ca7226e;hb=5ba62318965cc25b2aad20345d9b6acf665ea23d;hp=4cb3ef7de401b364895fa728cb9755234f9accfc;hpb=3e0b6b2542d8464bfba365b97a6e4b95c3885f10;p=ghc-hetmet.git diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 4cb3ef7..056c5e4 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -4,10 +4,17 @@ \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, - openAlphaTy, openAlphaTyVar, openAlphaTyVars, + openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar, openAlphaTyVars, primTyCons, @@ -39,7 +46,9 @@ module TysPrim( word32PrimTyCon, word32PrimTy, int64PrimTyCon, int64PrimTy, - word64PrimTyCon, word64PrimTy + word64PrimTyCon, word64PrimTy, + + anyPrimTyCon, anyPrimTy, anyPrimTyCon1, mkAnyPrimTyCon ) where #include "HsVersions.h" @@ -50,15 +59,16 @@ import OccName ( mkOccNameFS, tcName, mkTyVarOcc ) import TyCon ( TyCon, mkPrimTyCon, mkLiftedPrimTyCon, PrimRep(..) ) import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, - unliftedTypeKind, unboxedTypeKind, + unliftedTypeKind, liftedTypeKind, openTypeKind, - Kind, mkArrowKinds, + Kind, mkArrowKinds, mkArrowKind, TyThing(..) ) -import SrcLoc ( noSrcLoc ) -import Unique ( mkAlphaTyVarUnique ) +import SrcLoc +import Unique ( mkAlphaTyVarUnique, pprUnique ) import PrelNames -import FastString ( FastString, mkFastString ) +import StaticFlags +import FastString import Outputable import Char ( ord, chr ) @@ -97,40 +107,42 @@ primTyCons , wordPrimTyCon , word32PrimTyCon , word64PrimTyCon + , anyPrimTyCon, anyPrimTyCon1 ] mkPrimTc :: FastString -> Unique -> TyCon -> Name mkPrimTc fs uniq tycon = mkWiredInName gHC_PRIM (mkOccNameFS 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 -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 +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} %************************************************************************ @@ -146,7 +158,7 @@ alphaTyVars is a list of type variables for use in templates: tyVarList :: Kind -> [TyVar] tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u) (mkTyVarOcc (mkFastString name)) - noSrcLoc) kind + noSrcSpan) kind | u <- [2..], let name | c <= 'z' = [c] | otherwise = 't':show u @@ -168,9 +180,10 @@ alphaTys = mkTyVarTys alphaTyVars -- 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] -openAlphaTyVars@(openAlphaTyVar:_) = tyVarList openTypeKind +openAlphaTyVars@(openAlphaTyVar:openBetaTyVar:_) = tyVarList openTypeKind openAlphaTy = mkTyVarTy openAlphaTyVar +openBetaTy = mkTyVarTy openBetaTyVar \end{code} @@ -187,17 +200,13 @@ pcPrimTyCon name arity rep = mkPrimTyCon name kind arity rep where kind = mkArrowKinds (replicate arity liftedTypeKind) result_kind - result_kind = case rep of - PtrRep -> unliftedTypeKind - _other -> unboxedTypeKind + result_kind = unliftedTypeKind pcPrimTyCon0 :: Name -> PrimRep -> TyCon pcPrimTyCon0 name rep = mkPrimTyCon name result_kind 0 rep where - result_kind = case rep of - PtrRep -> unliftedTypeKind - _other -> unboxedTypeKind + result_kind = unliftedTypeKind charPrimTy = mkTyConTy charPrimTyCon charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep @@ -267,6 +276,53 @@ defined in \tr{TysWiredIn.lhs}, not here. %************************************************************************ %* * + Any +%* * +%************************************************************************ + +The type constructor Any is type to which you can unsafely coerce any +lifted type, and back. + + * It is lifted, and hence represented by a pointer + + * It does not claim to be a *data* type, and that's important for + the code generator, because the code gen may *enter* a data value + but never enters a function value. + +It's also used to instantiate un-constrained type variables after type +checking. For example + 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 +into interface files, we'll get a crash; at least until we add interface-file +syntax to support them. + +\begin{code} +anyPrimTy = mkTyConApp anyPrimTyCon [] + +anyPrimTyCon :: TyCon -- Kind * +anyPrimTyCon = mkLiftedPrimTyCon anyPrimTyConName liftedTypeKind 0 PtrRep + +anyPrimTyCon1 :: TyCon -- Kind *->* +anyPrimTyCon1 = mkLiftedPrimTyCon anyPrimTyCon1Name kind 0 PtrRep + where + kind = mkArrowKind liftedTypeKind liftedTypeKind + +mkAnyPrimTyCon :: Unique -> Kind -> TyCon +-- Grotesque hack alert: the client gives the unique; so equality won't work +mkAnyPrimTyCon uniq kind + = WARN( opt_PprStyle_Debug, ptext (sLit "Urk! Inventing strangely-kinded Any TyCon:") <+> ppr uniq <+> ppr kind ) + -- See Note [Strangely-kinded void TyCons] in TcHsSyn + tycon + where + name = mkPrimTc (mkFastString ("Any" ++ showSDoc (pprUnique uniq))) uniq tycon + tycon = mkLiftedPrimTyCon name kind 0 PtrRep +\end{code} + + +%************************************************************************ +%* * \subsection[TysPrim-arrays]{The primitive array types} %* * %************************************************************************