\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,
word32PrimTyCon, word32PrimTy,
int64PrimTyCon, int64PrimTy,
- word64PrimTyCon, word64PrimTy
+ word64PrimTyCon, word64PrimTy,
+
+ anyPrimTyCon, anyPrimTy, anyPrimTyCon1, mkAnyPrimTyCon
) where
#include "HsVersions.h"
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 )
, 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}
%************************************************************************
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
-- 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}
= 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
%************************************************************************
%* *
+ 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}
%* *
%************************************************************************
projects / ghc-hetmet.git / blobdiff