merge GHC HEAD
[ghc-hetmet.git] / compiler / prelude / TysPrim.lhs
index 19d71db..4c70bcb 100644 (file)
@@ -1,22 +1,35 @@
 %
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
+
+     
 \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
-
+-- | This module defines TyCons that can't be expressed in Haskell. 
+--   They are all, therefore, wired-in TyCons.  C.f module TysWiredIn
 module TysPrim(
        alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
-       alphaTy, betaTy, gammaTy, deltaTy,
+       alphaTy, betaTy, gammaTy, deltaTy, ecTyVars,
        openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar, openAlphaTyVars,
+        argAlphaTy, argAlphaTyVar, argBetaTy, argBetaTyVar,
+
+        -- Kind constructors...
+        tySuperKindTyCon, tySuperKind,
+        liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
+        argTypeKindTyCon, ubxTupleKindTyCon,
 
-       primTyCons,
+        tySuperKindTyConName, liftedTypeKindTyConName,
+        openTypeKindTyConName, unliftedTypeKindTyConName,
+        ubxTupleKindTyConName, argTypeKindTyConName,
+
+        -- Kinds
+       liftedTypeKind, unliftedTypeKind, openTypeKind,
+        argTypeKind, ubxTupleKind,
+        mkArrowKind, mkArrowKinds, isCoercionKind,
+
+        funTyCon, funTyConName,
+        primTyCons,
 
        charPrimTyCon,          charPrimTy,
        intPrimTyCon,           intPrimTy,
@@ -46,31 +59,30 @@ module TysPrim(
        word32PrimTyCon,        word32PrimTy,
 
        int64PrimTyCon,         int64PrimTy,
-       word64PrimTyCon,        word64PrimTy,
+        word64PrimTyCon,        word64PrimTy,
+
+        eqPredPrimTyCon,            -- ty1 ~ ty2
 
-       anyPrimTyCon, anyPrimTy, anyPrimTyCon1, mkAnyPrimTyCon
+       -- * Any
+       anyTyCon, anyTyConOfKind, anyTypeOfKind
   ) where
 
 #include "HsVersions.h"
 
 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          ( mkTcOcc,mkTyVarOccFS, mkTcOccFS )
+import TyCon
+import TypeRep
+import Type
+import Coercion
 import SrcLoc
-import Unique          ( mkAlphaTyVarUnique, pprUnique )
+import Unique          ( mkAlphaTyVarUnique )
 import PrelNames
-import FastString      ( FastString, mkFastString )
+import FastString
 import Outputable
 
-import Char            ( ord, chr )
+import Data.Char
 \end{code}
 
 %************************************************************************
@@ -106,42 +118,43 @@ primTyCons
     , wordPrimTyCon
     , word32PrimTyCon
     , word64PrimTyCon
-    , anyPrimTyCon, anyPrimTyCon1
+    , anyTyCon
+    , eqPredPrimTyCon
     ]
 
 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, eqPredPrimTyConName :: 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
+eqPredPrimTyConName           = mkPrimTc (fsLit "~") eqPredPrimTyConKey eqPredPrimTyCon
+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
 \end{code}
 
 %************************************************************************
@@ -156,7 +169,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]
@@ -164,28 +177,134 @@ tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u)
                            where c = chr (u-2 + ord 'a')
                 ]
 
+ecTyVars :: [TyVar]
+ecTyVars = tyVarList ecKind
+
 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
+openBetaTy  = mkTyVarTy openBetaTyVar
+
+argAlphaTyVar, argBetaTyVar :: TyVar
+(argAlphaTyVar : argBetaTyVar : _) = tyVarList argTypeKind
+argAlphaTy, argBetaTy :: Type
+argAlphaTy = mkTyVarTy argAlphaTyVar
+argBetaTy  = mkTyVarTy argBetaTyVar
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
+                FunTyCon
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+funTyConName :: Name
+funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon
+
+funTyCon :: TyCon
+funTyCon = mkFunTyCon funTyConName (mkArrowKinds [argTypeKind, openTypeKind] liftedTypeKind)
+        -- You might think that (->) should have type (?? -> ? -> *), and you'd be right
+       -- But if we do that we get kind errors when saying
+       --      instance Control.Arrow (->)
+       -- becuase the expected kind is (*->*->*).  The trouble is that the
+       -- expected/actual stuff in the unifier does not go contra-variant, whereas
+       -- the kind sub-typing does.  Sigh.  It really only matters if you use (->) in
+       -- a prefix way, thus:  (->) Int# Int#.  And this is unusual.
+        -- because they are never in scope in the source
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
+                Kinds
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+-- | See "Type#kind_subtyping" for details of the distinction between the 'Kind' 'TyCon's
+tySuperKindTyCon, liftedTypeKindTyCon,
+      openTypeKindTyCon, unliftedTypeKindTyCon,
+      ubxTupleKindTyCon, argTypeKindTyCon
+   :: TyCon
+tySuperKindTyConName, liftedTypeKindTyConName,
+      openTypeKindTyConName, unliftedTypeKindTyConName,
+      ubxTupleKindTyConName, argTypeKindTyConName
+   :: Name
+
+tySuperKindTyCon      = mkSuperKindTyCon tySuperKindTyConName
+liftedTypeKindTyCon   = mkKindTyCon liftedTypeKindTyConName   tySuperKind
+openTypeKindTyCon     = mkKindTyCon openTypeKindTyConName     tySuperKind
+unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName tySuperKind
+ubxTupleKindTyCon     = mkKindTyCon ubxTupleKindTyConName     tySuperKind
+argTypeKindTyCon      = mkKindTyCon argTypeKindTyConName      tySuperKind
+
+--------------------------
+-- ... and now their names
+
+tySuperKindTyConName      = mkPrimTyConName (fsLit "BOX") tySuperKindTyConKey tySuperKindTyCon
+liftedTypeKindTyConName   = mkPrimTyConName (fsLit "*") liftedTypeKindTyConKey liftedTypeKindTyCon
+openTypeKindTyConName     = mkPrimTyConName (fsLit "?") openTypeKindTyConKey openTypeKindTyCon
+unliftedTypeKindTyConName = mkPrimTyConName (fsLit "#") unliftedTypeKindTyConKey unliftedTypeKindTyCon
+ubxTupleKindTyConName     = mkPrimTyConName (fsLit "(#)") ubxTupleKindTyConKey ubxTupleKindTyCon
+argTypeKindTyConName      = mkPrimTyConName (fsLit "??") argTypeKindTyConKey argTypeKindTyCon
+
+mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
+mkPrimTyConName occ key tycon = mkWiredInName gHC_PRIM (mkTcOccFS occ) 
+                                             key 
+                                             (ATyCon tycon)
+                                             BuiltInSyntax
+       -- All of the super kinds and kinds are defined in Prim and use BuiltInSyntax,
+       -- because they are never in scope in the source
 \end{code}
 
 
+\begin{code}
+kindTyConType :: TyCon -> Type
+kindTyConType kind = TyConApp kind []
+
+-- | See "Type#kind_subtyping" for details of the distinction between these 'Kind's
+liftedTypeKind, unliftedTypeKind, openTypeKind, argTypeKind, ubxTupleKind :: Kind
+
+liftedTypeKind   = kindTyConType liftedTypeKindTyCon
+unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
+openTypeKind     = kindTyConType openTypeKindTyCon
+argTypeKind      = kindTyConType argTypeKindTyCon
+ubxTupleKind    = kindTyConType ubxTupleKindTyCon
+
+-- | Given two kinds @k1@ and @k2@, creates the 'Kind' @k1 -> k2@
+mkArrowKind :: Kind -> Kind -> Kind
+mkArrowKind k1 k2 = FunTy k1 k2
+
+-- | Iterated application of 'mkArrowKind'
+mkArrowKinds :: [Kind] -> Kind -> Kind
+mkArrowKinds arg_kinds result_kind = foldr mkArrowKind result_kind arg_kinds
+
+tySuperKind :: SuperKind
+tySuperKind = kindTyConType tySuperKindTyCon 
+\end{code}
+
 %************************************************************************
 %*                                                                     *
 \subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)}
@@ -207,34 +326,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}
 
@@ -245,6 +384,22 @@ doublePrimTyCon    = pcPrimTyCon0 doublePrimTyConName DoubleRep
 %*                                                                     *
 %************************************************************************
 
+Note [The (~) TyCon)
+~~~~~~~~~~~~~~~~~~~~
+There is a perfectly ordinary type constructor (~) that represents the type
+of coercions (which, remember, are values).  For example
+   Refl Int :: Int ~ Int
+
+Atcually it is not quite "perfectly ordinary" because it is kind-polymorphic:
+   Refl Maybe :: Maybe ~ Maybe
+
+So the true kind of (~) :: forall k. k -> k -> #.  But we don't have
+polymorphic kinds (yet). However, (~) really only appears saturated in
+which case there is no problem in finding the kind of (ty1 ~ ty2). So
+we check that in CoreLint (and, in an assertion, in Kind.typeKind).
+
+Note [The State# TyCon]
+~~~~~~~~~~~~~~~~~~~~~~~
 State# is the primitive, unlifted type of states.  It has one type parameter,
 thus
        State# RealWorld
@@ -255,8 +410,15 @@ 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   -- See Note [The State# TyCon]
 statePrimTyCon  = pcPrimTyCon statePrimTyConName 1 VoidRep
+
+eqPredPrimTyCon :: TyCon  -- The representation type for equality predicates
+                         -- See Note [The (~) TyCon]
+eqPredPrimTyCon  = pcPrimTyCon eqPredPrimTyConName 2 VoidRep
 \end{code}
 
 RealWorld is deeply magical.  It is *primitive*, but it is not
@@ -264,61 +426,17 @@ 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}
 
 Note: the ``state-pairing'' types are not truly primitive, so they are
 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
-       lenth 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 
-  = pprTrace "Urk! Inventing strangely-kinded Any TyCon:" (ppr uniq <+> ppr kind)
-    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}
@@ -326,14 +444,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 +468,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 +482,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 +496,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 +510,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 +524,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 +538,9 @@ mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
 %************************************************************************
 
 \begin{code}
+bcoPrimTy    :: Type
 bcoPrimTy    = mkTyConTy bcoPrimTyCon
+bcoPrimTyCon :: TyCon
 bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep
 \end{code}
   
@@ -415,8 +551,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 +574,115 @@ 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}
+
+
+
+%************************************************************************
+%*                                                                     *
+               Any
+%*                                                                     *
+%************************************************************************
+
+Note [Any types]
+~~~~~~~~~~~~~~~~
+The type constructor Any::* has these properties
+
+  * It is defined in module GHC.Prim, and exported so that it is 
+    available to users.  For this reason it's treated like any other 
+    primitive type:
+      - has a fixed unique, anyTyConKey, 
+      - lives in the global name cache
+      - built with TyCon.PrimTyCon
+
+  * It is lifted, and hence represented by a pointer
+
+  * It is inhabited by at least one value, namely bottom
+
+  * You can unsafely coerce any lifted type to Ayny, and back.
+
+  * 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 is used to instantiate otherwise un-constrained type variables of kind *
+    For example        length Any []
+    See Note [Strangely-kinded void TyCons]
+
+In addition, we have a potentially-infinite family of types, one for
+each kind /other than/ *, needed to instantiate otherwise
+un-constrained type variables of kinds other than *.  This is a bit
+like tuples; there is a potentially-infinite family.  They have slightly
+different characteristics to Any::*:
+  
+  * They are built with TyCon.AnyTyCon
+  * They have non-user-writable names like "Any(*->*)" 
+  * They are not exported by GHC.Prim
+  * They are uninhabited (of course; not kind *)
+  * They have a unique derived from their OccName (see Note [Uniques of Any])
+  * Their Names do not live in the global name cache
+
+Note [Uniques of Any]
+~~~~~~~~~~~~~~~~~~~~~
+Although Any(*->*), say, doesn't have a binding site, it still needs
+to have a Unique.  Unlike tuples (which are also an infinite family)
+there is no convenient way to index them, so we use the Unique from
+their OccName instead.  That should be unique, 
+  - both wrt each other, because their strings differ
+
+  - and wrt any other Name, because Names get uniques with 
+    various 'char' tags, but the OccName of Any will 
+    get a Unique built with mkTcOccUnique, which has a particular 'char' 
+    tag; see Unique.mkTcOccUnique!
+
+Note [Strangely-kinded void TyCons]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+See Trac #959 for more examples
+
+When the type checker finds a type variable with no binding, which
+means it can be instantiated with an arbitrary type, it usually
+instantiates it to Void.  Eg.
+
+       length []
+===>
+       length Any (Nil Any)
+
+But in really obscure programs, the type variable might have a kind
+other than *, so we need to invent a suitably-kinded type.
+
+This commit uses
+       Any for kind *
+       Any(*->*) for kind *->*
+       etc
+
+\begin{code}
+anyTyConName :: Name
+anyTyConName = mkPrimTc (fsLit "Any") anyTyConKey anyTyCon
+
+anyTyCon :: TyCon
+anyTyCon = mkLiftedPrimTyCon anyTyConName liftedTypeKind 0 PtrRep
+
+anyTypeOfKind :: Kind -> Type
+anyTypeOfKind kind = mkTyConApp (anyTyConOfKind kind) []
+
+anyTyConOfKind :: Kind -> TyCon
+-- Map all superkinds of liftedTypeKind to liftedTypeKind
+anyTyConOfKind kind 
+  | isLiftedTypeKind kind = anyTyCon
+  | otherwise             = tycon
+  where
+         -- Derive the name from the kind, thus:
+         --     Any(*->*), Any(*->*->*)
+         -- These are names that can't be written by the user,
+         -- and are not allocated in the global name cache
+    str = "Any" ++ showSDoc (pprParendKind kind)
+
+    occ   = mkTcOcc str
+    uniq  = getUnique occ  -- See Note [Uniques of Any]
+    name  = mkWiredInName gHC_PRIM occ uniq (ATyCon tycon) UserSyntax
+    tycon = mkAnyTyCon name kind 
+\end{code}