X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FTysPrim.lhs;h=e8638d78eef73b00daa970a718ee64183dcbbcb7;hp=2f6168bafb0cf1c8e1146c37d7ff58cc9816650f;hb=4c6a3f787abcaed009a574196d82237d9ae64fc8;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 2f6168b..e8638d7 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" @@ -47,17 +56,19 @@ module TysPrim( import Var ( TyVar, mkTyVar ) import Name ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName ) import OccName ( mkOccNameFS, tcName, mkTyVarOcc ) -import TyCon ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon, +import TyCon ( TyCon, mkPrimTyCon, mkLiftedPrimTyCon, PrimRep(..) ) import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, - unliftedTypeKind, liftedTypeKind, openTypeKind, - Kind, mkArrowKinds, + unliftedTypeKind, + liftedTypeKind, openTypeKind, + 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 ) @@ -96,13 +107,13 @@ 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 @@ -130,6 +141,8 @@ stableNamePrimTyConName = mkPrimTc FSLIT("StableName#") stableNamePrimTyCo 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} %************************************************************************ @@ -145,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 @@ -167,18 +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 - -vrcPos,vrcZero :: (Bool,Bool) -vrcPos = (True,False) -vrcZero = (False,False) - -vrcsP,vrcsZ,vrcsZP :: ArgVrcs -vrcsP = [vrcPos] -vrcsZ = [vrcZero] -vrcsZP = [vrcZero,vrcPos] +openBetaTy = mkTyVarTy openBetaTyVar \end{code} @@ -190,19 +195,18 @@ vrcsZP = [vrcZero,vrcPos] \begin{code} -- only used herein -pcPrimTyCon :: Name -> ArgVrcs -> PrimRep -> TyCon -pcPrimTyCon name arg_vrcs rep - = mkPrimTyCon name kind arity arg_vrcs rep +pcPrimTyCon :: Name -> Int -> PrimRep -> TyCon +pcPrimTyCon name arity rep + = mkPrimTyCon name kind arity rep where - arity = length arg_vrcs kind = mkArrowKinds (replicate arity liftedTypeKind) result_kind - result_kind = unliftedTypeKind -- all primitive types are unlifted + result_kind = unliftedTypeKind pcPrimTyCon0 :: Name -> PrimRep -> TyCon pcPrimTyCon0 name rep - = mkPrimTyCon name result_kind 0 [] rep + = mkPrimTyCon name result_kind 0 rep where - result_kind = unliftedTypeKind -- all primitive types are unlifted + result_kind = unliftedTypeKind charPrimTy = mkTyConTy charPrimTyCon charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep @@ -253,7 +257,7 @@ keep different state threads separate. It is represented by nothing at all. \begin{code} mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty] -statePrimTyCon = pcPrimTyCon statePrimTyConName vrcsZ VoidRep +statePrimTyCon = pcPrimTyCon statePrimTyConName 1 VoidRep \end{code} RealWorld is deeply magical. It is *primitive*, but it is not @@ -261,7 +265,7 @@ 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 = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PtrRep +realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 PtrRep realWorldTy = mkTyConTy realWorldTyCon realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld \end{code} @@ -272,15 +276,62 @@ 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} %* * %************************************************************************ \begin{code} -arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName vrcsP PtrRep -mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName vrcsZP PtrRep -mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName vrcsZ PtrRep -byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName PtrRep +arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName 1 PtrRep +mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName 2 PtrRep +mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName 1 PtrRep +byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName PtrRep mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt] byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon @@ -295,7 +346,7 @@ mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} -mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName 2 PtrRep mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} @@ -307,7 +358,7 @@ mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName 2 PtrRep mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} @@ -319,7 +370,7 @@ mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName vrcsZP PtrRep +tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName 2 PtrRep mkTVarPrimTy s elt = mkTyConApp tVarPrimTyCon [s, elt] \end{code} @@ -331,7 +382,7 @@ mkTVarPrimTy s elt = mkTyConApp tVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP AddrRep +stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName 1 AddrRep mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] \end{code} @@ -343,7 +394,7 @@ mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] %************************************************************************ \begin{code} -stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep +stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName 1 PtrRep mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] \end{code} @@ -366,7 +417,7 @@ bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep %************************************************************************ \begin{code} -weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep +weakPrimTyCon = pcPrimTyCon weakPrimTyConName 1 PtrRep mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] \end{code}