X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprelude%2FTysPrim.lhs;h=056c5e47fd5bbac7eb111a59cf791f196ca7226e;hb=d92b6ce787e0a85ef99ef2ccd0a6a63665ea7f5c;hp=908cbaadb8f071200fe15ab48e4699baa4776752;hpb=c128930dc98c73e2459a4610539fee73ca941247;p=ghc-hetmet.git diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 908cbaa..056c5e4 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -4,6 +4,13 @@ \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, @@ -57,10 +64,11 @@ import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, Kind, mkArrowKinds, mkArrowKind, TyThing(..) ) -import SrcLoc ( noSrcLoc ) +import SrcLoc import Unique ( mkAlphaTyVarUnique, pprUnique ) import PrelNames -import FastString ( FastString, mkFastString ) +import StaticFlags +import FastString import Outputable import Char ( ord, chr ) @@ -109,32 +117,32 @@ mkPrimTc fs uniq tycon (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 = 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} %************************************************************************ @@ -150,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 @@ -283,7 +291,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 @@ -304,7 +312,8 @@ 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) + = 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