Fix Trac #959: a long-standing bug in instantiating otherwise-unbound type variables

    
   DO NOT MERGE TO GHC 6.12 branch
   (Reason: interface file format change.)

The typechecker needs to instantiate otherwise-unconstraint type variables to
an appropriately-kinded constant type, but we didn't have a supply of 
arbitrarily-kinded tycons for this purpose.  Now we do.

The details are described in Note [Any types] in TysPrim.  The
fundamental change is that there is a new sort of TyCon, namely
AnyTyCon, defined in TyCon.

Ter's a small change to interface-file binary format, because the new
AnyTyCons have to be serialised.

I tided up the handling of uniques a bit too, so that mkUnique is not
exported, so that we can see all the different name spaces in one module.

18 files changed, 272 insertions, 227 deletions

diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs
index b12a07feae..3a2338e8a4 100644
--- a/compiler/basicTypes/OccName.lhs
+++ b/compiler/basicTypes/OccName.lhs
@@ -98,7 +98,6 @@ import BasicTypes
 import UniqFM
 import UniqSet
 import FastString
-import FastTypes
 import Outputable
 import Binary
 import Data.Char
@@ -304,22 +303,24 @@ mkClsOccFS = mkOccNameFS clsName
 
 OccEnvs are used mainly for the envts in ModIfaces.
 
+Note [The Unique of an OccName]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 They are efficient, because FastStrings have unique Int# keys.  We assume
-this key is less than 2^24, so we can make a Unique using
+this key is less than 2^24, and indeed FastStrings are allocated keys 
+sequentially starting at 0.
+
+So we can make a Unique using
 	mkUnique ns key  :: Unique
 where 'ns' is a Char reprsenting the name space.  This in turn makes it
 easy to build an OccEnv.
 
 \begin{code}
 instance Uniquable OccName where
-  getUnique (OccName ns fs)
-      = mkUnique char (iBox (uniqueOfFS fs))
-      where	-- See notes above about this getUnique function
-        char = case ns of
-		VarName   -> 'i'
-		DataName  -> 'd'
-		TvName    -> 'v'
-		TcClsName -> 't'
+      -- See Note [The Unique of an OccName]
+  getUnique (OccName VarName   fs) = mkVarOccUnique  fs
+  getUnique (OccName DataName  fs) = mkDataOccUnique fs
+  getUnique (OccName TvName    fs) = mkTvOccUnique   fs
+  getUnique (OccName TcClsName fs) = mkTcOccUnique   fs
 
 newtype OccEnv a = A (UniqFM a)
 
diff --git a/compiler/basicTypes/Unique.lhs b/compiler/basicTypes/Unique.lhs
index aecd372197..1ef0ca8590 100644
--- a/compiler/basicTypes/Unique.lhs
+++ b/compiler/basicTypes/Unique.lhs
@@ -25,7 +25,6 @@ module Unique (
 
 	pprUnique, 
 
-	mkUnique,			-- Used in UniqSupply
 	mkUniqueGrimily,		-- Used in UniqSupply only!
 	getKey, getKeyFastInt,		-- Used in Var, UniqFM, Name only!
 
@@ -47,6 +46,9 @@ module Unique (
 	mkPreludeTyConUnique, mkPreludeClassUnique,
 	mkPArrDataConUnique,
 
+        mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique,
+        mkRegSingleUnique, mkRegPairUnique, mkRegClassUnique, mkRegSubUnique,
+
 	mkBuiltinUnique,
 	mkPseudoUniqueC,
 	mkPseudoUniqueD,
@@ -93,7 +95,6 @@ Now come the functions which construct uniques from their pieces, and vice versa
 The stuff about unique *supplies* is handled further down this module.
 
 \begin{code}
-mkUnique	:: Char -> Int -> Unique	-- Builds a unique from pieces
 unpkUnique	:: Unique -> (Char, Int)	-- The reverse
 
 mkUniqueGrimily :: Int -> Unique		-- A trap-door for UniqSupply
@@ -131,6 +132,9 @@ newTagUnique u c = mkUnique c i where (_,i) = unpkUnique u
 
 -- and as long as the Char fits in 8 bits, which we assume anyway!
 
+mkUnique :: Char -> Int -> Unique	-- Builds a unique from pieces
+-- NOT EXPORTED, so that we can see all the Chars that 
+--               are used in this one module
 mkUnique c i
   = MkUnique (tag `bitOrFastInt` bits)
   where
@@ -340,8 +344,7 @@ isTupleKey u = case unpkUnique u of
 mkPrimOpIdUnique op         = mkUnique '9' op
 mkPreludeMiscIdUnique  i    = mkUnique '0' i
 
--- No numbers left anymore, so I pick something different for the character
--- tag 
+-- No numbers left anymore, so I pick something different for the character tag 
 mkPArrDataConUnique a	        = mkUnique ':' (2*a)
 
 -- The "tyvar uniques" print specially nicely: a, b, c, etc.
@@ -358,5 +361,18 @@ mkPseudoUniqueC i = mkUnique 'C' i -- used for getUnique on Regs
 mkPseudoUniqueD i = mkUnique 'D' i -- used in NCG for getUnique on RealRegs
 mkPseudoUniqueE i = mkUnique 'E' i -- used in NCG spiller to create spill VirtualRegs
 mkPseudoUniqueH i = mkUnique 'H' i -- used in NCG spiller to create spill VirtualRegs
+
+mkRegSingleUnique, mkRegPairUnique, mkRegSubUnique, mkRegClassUnique :: Int -> Unique
+mkRegSingleUnique = mkUnique 'R'
+mkRegSubUnique    = mkUnique 'S'
+mkRegPairUnique   = mkUnique 'P'
+mkRegClassUnique  = mkUnique 'L'
+
+mkVarOccUnique, mkDataOccUnique, mkTvOccUnique, mkTcOccUnique :: FastString -> Unique
+-- See Note [The Unique of an OccName] in OccName
+mkVarOccUnique  fs = mkUnique 'i' (iBox (uniqueOfFS fs))
+mkDataOccUnique fs = mkUnique 'd' (iBox (uniqueOfFS fs))
+mkTvOccUnique 	fs = mkUnique 'v' (iBox (uniqueOfFS fs))
+mkTcOccUnique 	fs = mkUnique 'c' (iBox (uniqueOfFS fs))
 \end{code}
 
diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index 7f752f88c2..515ac8565f 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -31,13 +31,13 @@ import MkCore
 import CoreUtils
 import CoreFVs
 
-import TcHsSyn	( mkArbitraryType )	-- Mis-placed?
 import TcType
+import TysPrim  ( anyTypeOfKind )
 import CostCentre
 import Module
 import Id
 import MkId	( seqId )
-import Var	( Var, TyVar )
+import Var	( Var, TyVar, tyVarKind )
 import VarSet
 import Rules
 import VarEnv
@@ -192,8 +192,9 @@ dsHsBind auto_scc rest (AbsBinds tyvars [] exports binds)
 			-- see if it has any impact; it is on by default
   = 	-- Note [Abstracting over tyvars only]
     do	{ core_prs <- ds_lhs_binds NoSccs binds
-	; arby_env <- mkArbitraryTypeEnv tyvars exports
-	; let (lg_binds, core_prs') = mapAndUnzip do_one core_prs
+	; 
+	; let arby_env = mkArbitraryTypeEnv tyvars exports
+              (lg_binds, core_prs') = mapAndUnzip do_one core_prs
 	      bndrs = mkVarSet (map fst core_prs)
 
 	      add_lets | core_prs `lengthExceeds` 10 = add_some
@@ -265,8 +266,8 @@ dsHsBind auto_scc rest (AbsBinds all_tyvars dicts exports binds)
 	; let mk_bind ((tyvars, global, local, prags), n)  -- locals!!n == local
 	        = 	-- Need to make fresh locals to bind in the selector,
 		      	-- because some of the tyvars will be bound to 'Any'
-		  do { ty_args <- mapM mk_ty_arg all_tyvars
-		     ; let substitute = substTyWith all_tyvars ty_args
+		  do { let ty_args = map mk_ty_arg all_tyvars
+		           substitute = substTyWith all_tyvars ty_args
 		     ; locals' <- newSysLocalsDs (map substitute local_tys)
 		     ; tup_id  <- newSysLocalDs  (substitute tup_ty)
 		     ; mb_specs <- mapM (dsSpec all_tyvars dicts tyvars global
@@ -281,7 +282,7 @@ dsHsBind auto_scc rest (AbsBinds all_tyvars dicts exports binds)
 		     ; return ((global', rhs) : spec_binds) }
 	        where
 	          mk_ty_arg all_tyvar
-			| all_tyvar `elem` tyvars = return (mkTyVarTy all_tyvar)
+			| all_tyvar `elem` tyvars = mkTyVarTy all_tyvar
 	      		| otherwise		  = dsMkArbitraryType all_tyvar
 
 	; export_binds_s <- mapM mk_bind (exports `zip` [0..])
@@ -344,9 +345,9 @@ dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
 		bs | not (null bs) -> do { warnDs (dead_msg bs); return Nothing } 
 		   | otherwise -> do
 
-	{ f_body <- fix_up (Let mono_bind (Var mono_id))
+	{ let     f_body = fix_up (Let mono_bind (Var mono_id))
 
-	; let	  local_poly  = setIdNotExported poly_id
+	          local_poly  = setIdNotExported poly_id
 			-- Very important to make the 'f' non-exported,
 			-- else it won't be inlined!
 		  spec_id     = mkLocalId spec_name spec_ty
@@ -367,9 +368,9 @@ dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
   where
 	-- Bind to Any any of all_ptvs that aren't 
 	-- relevant for this particular function 
-    fix_up body | null void_tvs = return body
-		| otherwise	= do { void_tys <- mapM dsMkArbitraryType void_tvs
-				     ; return (mkTyApps (mkLams void_tvs body) void_tys) }
+    fix_up body | null void_tvs = body
+		| otherwise	= mkTyApps (mkLams void_tvs body) $
+                                  map dsMkArbitraryType void_tvs
 
     void_tvs = all_tvs \\ tvs
 
@@ -383,27 +384,24 @@ dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
 		    2 (ppr spec_expr)
     	     
 
-mkArbitraryTypeEnv :: [TyVar] -> [([TyVar], a, b, c)] -> DsM (TyVarEnv Type)
+mkArbitraryTypeEnv :: [TyVar] -> [([TyVar], a, b, c)] -> TyVarEnv Type
 -- If any of the tyvars is missing from any of the lists in 
 -- the second arg, return a binding in the result
 mkArbitraryTypeEnv tyvars exports
   = go emptyVarEnv exports
   where
-    go env [] = return env
+    go env [] = env
     go env ((ltvs, _, _, _) : exports)
-	= do { env' <- foldlM extend env [tv | tv <- tyvars
-					, not (tv `elem` ltvs)
-					, not (tv `elemVarEnv` env)]
-	     ; go env' exports }
+	= go env' exports
+        where
+          env' = foldl extend env [tv | tv <- tyvars
+			              , not (tv `elem` ltvs)
+				      , not (tv `elemVarEnv` env)]
 
-    extend env tv = do { ty <- dsMkArbitraryType tv
-		       ; return (extendVarEnv env tv ty) }
+    extend env tv = extendVarEnv env tv (dsMkArbitraryType tv)
 
-
-dsMkArbitraryType :: TcTyVar -> DsM Type
-dsMkArbitraryType tv = mkArbitraryType warn tv
-  where
-    warn span msg = putSrcSpanDs span (warnDs msg)
+dsMkArbitraryType :: TcTyVar -> Type
+dsMkArbitraryType tv = anyTypeOfKind (tyVarKind tv)
 \end{code}
 
 Note [Unused spec binders]
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index ffbba4a140..b04e6e104e 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -883,6 +883,7 @@ instance Binary IfaceType where
     put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
     put_ bh (IfaceTyConApp IfaceUbxTupleKindTc [])     = putByte bh 15
     put_ bh (IfaceTyConApp IfaceArgTypeKindTc [])      = putByte bh 16
+    put_ bh (IfaceTyConApp (IfaceAnyTc k) []) 	       = do { putByte bh 17; put_ bh k }
 
 	-- Generic cases
 
@@ -918,6 +919,7 @@ instance Binary IfaceType where
               14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
               15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
               16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
+              17 -> do { k <- get bh; return (IfaceTyConApp (IfaceAnyTc k) []) }
 
 	      18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
 	      _  -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
@@ -937,6 +939,7 @@ instance Binary IfaceTyCon where
    put_ bh IfaceArgTypeKindTc      = putByte bh 10
    put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar }
    put_ bh (IfaceTc ext)      = do { putByte bh 12; put_ bh ext }
+   put_ bh (IfaceAnyTc k)     = do { putByte bh 13; put_ bh k }
 
    get bh = do
 	h <- getByte bh
@@ -952,7 +955,8 @@ instance Binary IfaceTyCon where
           9 -> return IfaceUbxTupleKindTc
           10 -> return IfaceArgTypeKindTc
 	  11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
-	  _ -> do { ext <- get bh; return (IfaceTc ext) }
+	  12 -> do { ext <- get bh; return (IfaceTc ext) }
+	  _  -> do { k <- get bh; return (IfaceAnyTc k) }
 
 instance Binary IfacePredType where
     put_ bh (IfaceClassP aa ab) = do
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index 1688344556..2db1908713 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -68,32 +68,41 @@ data IfacePredType 	-- NewTypes are handled as ordinary TyConApps
 
 type IfaceContext = [IfacePredType]
 
--- NB: If you add a data constructor, remember to add a case to
---     IfaceSyn.eqIfTc!
 data IfaceTyCon 	-- Abbreviations for common tycons with known names
   = IfaceTc Name	-- The common case
   | IfaceIntTc | IfaceBoolTc | IfaceCharTc
   | IfaceListTc | IfacePArrTc
   | IfaceTupTc Boxity Arity 
+  | IfaceAnyTc IfaceKind    -- Used for AnyTyCon (see Note [Any Types] in TysPrim)
   | IfaceLiftedTypeKindTc | IfaceOpenTypeKindTc | IfaceUnliftedTypeKindTc
   | IfaceUbxTupleKindTc | IfaceArgTypeKindTc 
-  deriving( Eq )
 
 ifaceTyConName :: IfaceTyCon -> Name
-ifaceTyConName IfaceIntTc  	  = intTyConName
-ifaceTyConName IfaceBoolTc 	  = boolTyConName
-ifaceTyConName IfaceCharTc 	  = charTyConName
-ifaceTyConName IfaceListTc 	  = listTyConName
-ifaceTyConName IfacePArrTc 	  = parrTyConName
-ifaceTyConName (IfaceTupTc bx ar) = getName (tupleTyCon bx ar)
+ifaceTyConName IfaceIntTc  	       = intTyConName
+ifaceTyConName IfaceBoolTc 	       = boolTyConName
+ifaceTyConName IfaceCharTc 	       = charTyConName
+ifaceTyConName IfaceListTc 	       = listTyConName
+ifaceTyConName IfacePArrTc 	       = parrTyConName
+ifaceTyConName (IfaceTupTc bx ar)      = getName (tupleTyCon bx ar)
 ifaceTyConName IfaceLiftedTypeKindTc   = liftedTypeKindTyConName
 ifaceTyConName IfaceOpenTypeKindTc     = openTypeKindTyConName
 ifaceTyConName IfaceUnliftedTypeKindTc = unliftedTypeKindTyConName
 ifaceTyConName IfaceUbxTupleKindTc     = ubxTupleKindTyConName
 ifaceTyConName IfaceArgTypeKindTc      = argTypeKindTyConName
-ifaceTyConName (IfaceTc ext)      = ext
+ifaceTyConName (IfaceTc ext)           = ext
+ifaceTyConName (IfaceAnyTc kind)       = pprPanic "ifaceTyConName" (ppr (IfaceAnyTc kind))
+	       		    	       	 -- Note [The Name of an IfaceAnyTc]
 \end{code}
 
+Note [The Name of an IfaceAnyTc]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It isn't easy to get the Name of an IfaceAnyTc in a pure way.  What you
+really need to do is to transform it to a TyCon, and get the Name of that.
+But doing so needs the monad.
+
+In fact, ifaceTyConName is only used for instances and rules, and we don't
+expect to instantiate those at these (internal-ish) Any types, so rather
+than solve this potential problem now, I'm going to defer it until it happens!
 
 %************************************************************************
 %*									*
@@ -312,6 +321,7 @@ toIfaceType (PredTy st) =
 toIfaceTyCon :: TyCon -> IfaceTyCon
 toIfaceTyCon tc 
   | isTupleTyCon tc = IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+  | isAnyTyCon tc   = IfaceAnyTc (toIfaceKind (tyConKind tc))
   | otherwise	    = toIfaceTyCon_name (tyConName tc)
 
 toIfaceTyCon_name :: Name -> IfaceTyCon
@@ -323,7 +333,8 @@ toIfaceTyCon_name nm
 
 toIfaceWiredInTyCon :: TyCon -> Name -> IfaceTyCon
 toIfaceWiredInTyCon tc nm
-  | isTupleTyCon tc                 =  IfaceTupTc (tupleTyConBoxity tc) (tyConArity tc)
+  | isTupleTyCon tc                 = IfaceTupTc  (tupleTyConBoxity tc) (tyConArity tc)
+  | isAnyTyCon tc                   = IfaceAnyTc (toIfaceKind (tyConKind tc))
   | nm == intTyConName              = IfaceIntTc
   | nm == boolTyConName             = IfaceBoolTc 
   | nm == charTyConName             = IfaceCharTc 
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 7db955162f..6a5595719d 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -37,6 +37,7 @@ import Class
 import TyCon
 import DataCon
 import TysWiredIn
+import TysPrim		( anyTyConOfKind )
 import Var              ( TyVar )
 import qualified Var
 import VarEnv
@@ -1122,6 +1123,8 @@ tcIfaceTyCon IfaceCharTc      	= tcWiredInTyCon charTyCon
 tcIfaceTyCon IfaceListTc      	= tcWiredInTyCon listTyCon
 tcIfaceTyCon IfacePArrTc      	= tcWiredInTyCon parrTyCon
 tcIfaceTyCon (IfaceTupTc bx ar) = tcWiredInTyCon (tupleTyCon bx ar)
+tcIfaceTyCon (IfaceAnyTc kind)  = do { tc_kind <- tcIfaceType kind
+                                     ; tcWiredInTyCon (anyTyConOfKind tc_kind) }
 tcIfaceTyCon (IfaceTc name)     = do { thing <- tcIfaceGlobal name 
 				     ; return (check_tc (tyThingTyCon thing)) }
   where
diff --git a/compiler/nativeGen/Reg.hs b/compiler/nativeGen/Reg.hs
index 1da72c4cef..422ea2440f 100644
--- a/compiler/nativeGen/Reg.hs
+++ b/compiler/nativeGen/Reg.hs
@@ -125,8 +125,8 @@ data RealReg
 instance Uniquable RealReg where
 	getUnique reg
 	 = case reg of
-	 	RealRegSingle i		-> mkUnique 'S' i
-		RealRegPair r1 r2	-> mkUnique 'P' (r1 * 65536 + r2)
+	 	RealRegSingle i		-> mkRegSingleUnique i
+		RealRegPair r1 r2	-> mkRegPairUnique (r1 * 65536 + r2)
 
 instance Outputable RealReg where
 	ppr reg
diff --git a/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs b/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
index c3c1148f26..6d312200bd 100644
--- a/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/ArchBase.hs
@@ -57,11 +57,11 @@ data Reg
 -- | so we can put regs in UniqSets
 instance Uniquable Reg where
 	getUnique (Reg c i)
-	 = mkUnique 'R'
+	 = mkRegSingleUnique
 	 $ fromEnum c * 1000 + i
 
 	getUnique (RegSub s (Reg c i))
-	 = mkUnique 'S'
+	 = mkRegSubUnique 
 	 $ fromEnum s * 10000 + fromEnum c * 1000 + i
 
 	getUnique (RegSub _ (RegSub _ _))
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
index b7b7475aec..15fbb59e34 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillClean.hs
@@ -436,15 +436,15 @@ isStoreReg ss
 instance Uniquable Store where
     getUnique (SReg  r)
 	| RegReal (RealRegSingle i)	<- r
-	= mkUnique 'R' i
+	= mkRegSingleUnique i
 
 	| RegReal (RealRegPair r1 r2)	<- r
-	= mkUnique 'P' (r1 * 65535 + r2)
+	= mkRegPairUnique (r1 * 65535 + r2)
 
 	| otherwise
 	= error "RegSpillClean.getUnique: found virtual reg during spill clean, only real regs expected."
 
-    getUnique (SSlot i)			= mkUnique 'S' i
+    getUnique (SSlot i)	= mkRegSubUnique i    -- [SLPJ] I hope "SubUnique" is ok
 
 instance Outputable Store where
 	ppr (SSlot i)	= text "slot" <> int i
diff --git a/compiler/nativeGen/RegClass.hs b/compiler/nativeGen/RegClass.hs
index 8b6b2d4160..4bb300f2b9 100644
--- a/compiler/nativeGen/RegClass.hs
+++ b/compiler/nativeGen/RegClass.hs
@@ -21,9 +21,9 @@ data RegClass
 
 
 instance Uniquable RegClass where
-    getUnique RcInteger	= mkUnique 'L' 0
-    getUnique RcFloat	= mkUnique 'L' 1
-    getUnique RcDouble	= mkUnique 'L' 2
+    getUnique RcInteger	= mkRegClassUnique 0
+    getUnique RcFloat	= mkRegClassUnique 1
+    getUnique RcDouble	= mkRegClassUnique 2
 
 instance Outputable RegClass where
     ppr RcInteger	= Outputable.text "I"
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 67e79e28c7..bc08660cf3 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -923,7 +923,8 @@ addrPrimTyConKey, arrayPrimTyConKey, boolTyConKey, byteArrayPrimTyConKey,
     listTyConKey, foreignObjPrimTyConKey, weakPrimTyConKey,
     mutableArrayPrimTyConKey, mutableByteArrayPrimTyConKey,
     orderingTyConKey, mVarPrimTyConKey, ratioTyConKey, rationalTyConKey,
-    realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey :: Unique
+    realWorldTyConKey, stablePtrPrimTyConKey, stablePtrTyConKey,
+    anyTyConKey :: Unique
 addrPrimTyConKey			= mkPreludeTyConUnique	1
 arrayPrimTyConKey			= mkPreludeTyConUnique	3
 boolTyConKey				= mkPreludeTyConUnique	4
@@ -956,10 +957,7 @@ rationalTyConKey			= mkPreludeTyConUnique 33
 realWorldTyConKey			= mkPreludeTyConUnique 34
 stablePtrPrimTyConKey			= mkPreludeTyConUnique 35
 stablePtrTyConKey			= mkPreludeTyConUnique 36
-
-anyPrimTyConKey, anyPrimTyCon1Key :: Unique
-anyPrimTyConKey				= mkPreludeTyConUnique 37
-anyPrimTyCon1Key			= mkPreludeTyConUnique 38
+anyTyConKey				= mkPreludeTyConUnique 37
 
 statePrimTyConKey, stableNamePrimTyConKey, stableNameTyConKey,
     mutVarPrimTyConKey, ioTyConKey,
diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index c69bea12b1..4e1576f9f0 100644
--- a/compiler/prelude/TysPrim.lhs
+++ b/compiler/prelude/TysPrim.lhs
@@ -1,9 +1,13 @@
 %
 % (c) The AQUA Project, Glasgow University, 1994-1998
 %
+
+     
 \section[TysPrim]{Wired-in knowledge about primitive types}
 
 \begin{code}
+-- | 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,
@@ -41,20 +45,21 @@ module TysPrim(
 	int64PrimTyCon,		int64PrimTy,
 	word64PrimTyCon,	word64PrimTy,
 
-	anyPrimTyCon, anyPrimTy, anyPrimTyCon1, mkAnyPrimTyCon
+	-- * Any
+	anyTyCon, anyType, anyTyConOfKind, anyTypeOfKind
   ) where
 
 #include "HsVersions.h"
 
 import Var		( TyVar, mkTyVar )
 import Name		( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName )
+import OccName		( mkTcOcc )
 import OccName		( mkTyVarOccFS, mkTcOccFS )
-import TyCon		( TyCon, mkPrimTyCon, mkLiftedPrimTyCon )
+import TyCon		( TyCon, mkPrimTyCon, mkLiftedPrimTyCon, mkAnyTyCon )
 import Type
 import SrcLoc
-import Unique		( mkAlphaTyVarUnique, pprUnique )
+import Unique		( mkAlphaTyVarUnique )
 import PrelNames
-import StaticFlags
 import FastString
 import Outputable
 
@@ -94,7 +99,7 @@ primTyCons
     , wordPrimTyCon
     , word32PrimTyCon
     , word64PrimTyCon
-    , anyPrimTyCon, anyPrimTyCon1
+    , anyTyCon
     ]
 
 mkPrimTc :: FastString -> Unique -> TyCon -> Name
@@ -104,7 +109,7 @@ mkPrimTc fs unique tycon
 		  (ATyCon tycon)	-- Relevant TyCon
 		  UserSyntax		-- None are built-in syntax
 
-charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, realWorldTyConName, arrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName, anyPrimTyConName, anyPrimTyCon1Name :: Name
+charPrimTyConName, intPrimTyConName, int32PrimTyConName, int64PrimTyConName, wordPrimTyConName, word32PrimTyConName, word64PrimTyConName, addrPrimTyConName, floatPrimTyConName, doublePrimTyConName, statePrimTyConName, realWorldTyConName, arrayPrimTyConName, byteArrayPrimTyConName, mutableArrayPrimTyConName, mutableByteArrayPrimTyConName, mutVarPrimTyConName, mVarPrimTyConName, tVarPrimTyConName, stablePtrPrimTyConName, stableNamePrimTyConName, bcoPrimTyConName, weakPrimTyConName, threadIdPrimTyConName :: Name
 charPrimTyConName    	      = mkPrimTc (fsLit "Char#") charPrimTyConKey charPrimTyCon
 intPrimTyConName     	      = mkPrimTc (fsLit "Int#") intPrimTyConKey  intPrimTyCon
 int32PrimTyConName	      = mkPrimTc (fsLit "Int32#") int32PrimTyConKey int32PrimTyCon
@@ -129,8 +134,6 @@ stableNamePrimTyConName       = mkPrimTc (fsLit "StableName#") stableNamePrimTyC
 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 anyPrimTyCon1
 \end{code}
 
 %************************************************************************
@@ -182,6 +185,115 @@ openBetaTy   = mkTyVarTy openBetaTyVar
 
 %************************************************************************
 %*									*
+		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!  (But in principle we
+must take care: it does not include the module/package.)
+
+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
+
+anyType :: Type
+anyType = mkTyConApp anyTyCon []
+
+anyTypeOfKind :: Kind -> Type
+anyTypeOfKind kind
+  | isLiftedTypeKind kind = anyType
+  | otherwise             = mkTyConApp (mk_any_tycon kind) []
+
+anyTyConOfKind :: Kind -> TyCon
+anyTyConOfKind kind 
+  | isLiftedTypeKind kind = anyTyCon
+  | otherwise             = mk_any_tycon kind
+
+mk_any_tycon :: Kind -> TyCon
+mk_any_tycon kind    -- Kind other than *
+  = 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}
+
+
+%************************************************************************
+%*									*
 \subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)}
 %*									*
 %************************************************************************
@@ -294,54 +406,6 @@ 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 :: Type
-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 unique kind 
-  = WARN( opt_PprStyle_Debug, ptext (sLit "Urk! Inventing strangely-kinded Any TyCon:") <+> ppr unique <+> ppr kind )
-	-- See Note [Strangely-kinded void TyCons] in TcHsSyn
-    tycon
-  where
-     name  = mkPrimTc (mkFastString ("Any" ++ showSDoc (pprUnique unique))) unique tycon
-     tycon = mkLiftedPrimTyCon name kind 0 PtrRep
-\end{code}
-
-
-%************************************************************************
-%*									*
 \subsection[TysPrim-arrays]{The primitive array types}
 %*									*
 %************************************************************************
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 83c3f45022..cf54f26043 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -3,12 +3,9 @@
 %
 \section[TysWiredIn]{Wired-in knowledge about {\em non-primitive} types}
 
-This module tracks the ``state interface'' document, ``GHC prelude:
-types and operations.''
-
 \begin{code}
 -- | This module is about types that can be defined in Haskell, but which
--- must be wired into the compiler nonetheless.
+--   must be wired into the compiler nonetheless.  C.f module TysPrim
 module TysWiredIn (
         -- * All wired in things
 	wiredInTyCons, 
@@ -329,6 +326,7 @@ unboxedPairDataCon :: DataCon
 unboxedPairDataCon = tupleCon   Unboxed 2
 \end{code}
 
+
 %************************************************************************
 %*									*
 \subsection[TysWiredIn-boxed-prim]{The ``boxed primitive'' types (@Char@, @Int@, etc)}
diff --git a/compiler/stgSyn/CoreToStg.lhs b/compiler/stgSyn/CoreToStg.lhs
index b2d725796d..b5484a44d3 100644
--- a/compiler/stgSyn/CoreToStg.lhs
+++ b/compiler/stgSyn/CoreToStg.lhs
@@ -437,7 +437,7 @@ mkStgAltType bndr alts
 		    | isUnLiftedTyCon tc     -> PrimAlt tc
 		    | isHiBootTyCon tc	     -> look_for_better_tycon
 		    | isAlgTyCon tc 	     -> AlgAlt tc
-		    | otherwise		     -> ASSERT( _is_poly_alt_tycon tc )
+		    | otherwise		     -> ASSERT2( _is_poly_alt_tycon tc, ppr tc )
 						PolyAlt
 	Nothing				     -> PolyAlt
 
diff --git a/compiler/typecheck/TcHsSyn.lhs b/compiler/typecheck/TcHsSyn.lhs
index 299d70fa78..de572ba65b 100644
--- a/compiler/typecheck/TcHsSyn.lhs
+++ b/compiler/typecheck/TcHsSyn.lhs
@@ -16,8 +16,6 @@ module TcHsSyn (
 	nlHsIntLit, 
 	shortCutLit, hsOverLitName,
 	
-	mkArbitraryType,	-- Put this elsewhere?
-
 	-- re-exported from TcMonad
 	TcId, TcIdSet, TcDictBinds,
 
@@ -39,7 +37,6 @@ import TcType
 import TcMType
 import TysPrim
 import TysWiredIn
-import TyCon
 import DataCon
 import Name
 import Var
@@ -52,7 +49,6 @@ import SrcLoc
 import Util
 import Bag
 import Outputable
-import FastString
 \end{code}
 
 \begin{code}
@@ -1012,76 +1008,7 @@ zonkTypeZapping ty
 	-- mutable tyvar to a fresh immutable one.  So the mutable store
 	-- plays the role of an environment.  If we come across a mutable
 	-- type variable that isn't so bound, it must be completely free.
-    zonk_unbound_tyvar tv = do { ty <- mkArbitraryType warn tv
+    zonk_unbound_tyvar tv = do { let ty = anyTypeOfKind (tyVarKind tv)
 			       ; writeMetaTyVar tv ty
 			       ; return ty }
-	where
-	    warn span msg = setSrcSpan span (addWarnTc msg)
-
-
-{- 	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 Void (Nil Void)
-
-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
-	Void for kind *
-	List for kind *->*
-	Tuple for kind *->...*->*
-
-which deals with most cases.  (Previously, it only dealt with
-kind *.)   
-
-In the other cases, it just makes up a TyCon with a suitable kind.  If
-this gets into an interface file, anyone reading that file won't
-understand it.  This is fixable (by making the client of the interface
-file make up a TyCon too) but it is tiresome and never happens, so I
-am leaving it.
-
-Meanwhile I have now fixed GHC to emit a civilized warning.
- -}
-
-mkArbitraryType :: (SrcSpan -> SDoc -> TcRnIf g l a)	-- How to complain
-		-> TcTyVar
-		-> TcRnIf g l Type		-- Used by desugarer too
--- Make up an arbitrary type whose kind is the same as the tyvar.
--- We'll use this to instantiate the (unbound) tyvar.
---
--- Also used by the desugarer; hence the (tiresome) parameter
--- to use when generating a warning
-mkArbitraryType warn tv 
-  | liftedTypeKind `isSubKind` kind 		-- The vastly common case
-  = return anyPrimTy
-  | eqKind kind (tyConKind anyPrimTyCon1) 	-- @*->*@
-  = return (mkTyConApp anyPrimTyCon1 [])	--     No tuples this size
-  | all isLiftedTypeKind args 			-- @*-> ... ->*->*@
-  , isLiftedTypeKind res			--    Horrible hack to make less use 
-  = return (mkTyConApp tup_tc [])		--    of mkAnyPrimTyCon
-  | otherwise
-  = do	{ _ <- warn (getSrcSpan tv) msg
-	; return (mkTyConApp (mkAnyPrimTyCon (getUnique tv) kind) []) }
-		-- Same name as the tyvar, apart from making it start with a colon (sigh)
-		-- I dread to think what will happen if this gets out into an 
-		-- interface file.  Catastrophe likely.  Major sigh.
-  where
-    kind       = tyVarKind tv
-    (args,res) = splitKindFunTys kind
-    tup_tc     = tupleTyCon Boxed (length args)
-		
-    msg = vcat [ hang (ptext (sLit "Inventing strangely-kinded Any TyCon"))
-		    2 (ptext (sLit "of kind") <+> quotes (ppr kind))
-	       , nest 2 (ptext (sLit "from an instantiation of type variable") <+> quotes (ppr tv))
-	       , ptext (sLit "This warning can be suppressed by a type signature fixing") <+> quotes (ppr tv)
-	       , nest 2 (ptext (sLit "but is harmless without -O (and usually harmless anyway)."))
-	       , ptext (sLit "See http://hackage.haskell.org/trac/ghc/ticket/959 for details")  ]
-\end{code}
+\end{code}
\ No newline at end of file
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index bb21536b2d..6f8803c365 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -20,13 +20,14 @@ module TyCon(
 	mkClassTyCon,
 	mkFunTyCon,
 	mkPrimTyCon,
-	mkVoidPrimTyCon,
+	mkKindTyCon,
 	mkLiftedPrimTyCon,
 	mkTupleTyCon,
 	mkSynTyCon,
         mkSuperKindTyCon,
         mkCoercionTyCon,
         mkForeignTyCon,
+        mkAnyTyCon,
 
         -- ** Predicates on TyCons
         isAlgTyCon,
@@ -37,7 +38,7 @@ module TyCon(
         isSynTyCon, isClosedSynTyCon, isOpenSynTyCon,
         isSuperKindTyCon,
         isCoercionTyCon, isCoercionTyCon_maybe,
-        isForeignTyCon,
+        isForeignTyCon, isAnyTyCon,
 
 	isInjectiveTyCon,
 	isDataTyCon, isProductTyCon, isEnumerationTyCon, 
@@ -103,7 +104,7 @@ import Data.List( elemIndex )
 %************************************************************************
 
 \begin{code}
--- | Represents type constructors. Type constructors are introduced by things such as:
+-- | TyCons represent type constructors. Type constructors are introduced by things such as:
 --
 -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of kind @*@
 --
@@ -150,6 +151,7 @@ data TyCon
 					-- that doesn't mean it's a true GADT; only that the "where"
 					-- 	form was used. This field is used only to guide
 					--	pretty-printing
+
 	algTcStupidTheta :: [PredType],	-- ^ The \"stupid theta\" for the data type (always empty for GADTs).
 	                                -- A \"stupid theta\" is the context to the left of an algebraic type
 	                                -- declaration, e.g. @Eq a@ in the declaration @data Eq a => T a ...@.
@@ -198,17 +200,19 @@ data TyCon
 	tyConUnique   :: Unique,
 	tyConName     :: Name,
 	tyConKind     :: Kind,
-	tyConArity    :: Arity,		-- SLPJ Oct06: I'm not sure what the significance
-					--	       of the arity of a primtycon is!
+	tyConArity    :: Arity,			-- SLPJ Oct06: I'm not sure what the significance
+						--	       of the arity of a primtycon is!
+
+	primTyConRep  :: PrimRep,		-- ^ Many primitive tycons are unboxed, but some are
+                       				--   boxed (represented by pointers). This 'PrimRep' holds
+			                	--   that information.
+						-- Only relevant if tyConKind = *
 
-	primTyConRep  :: PrimRep,
-			-- ^ Many primitive tycons are unboxed, but some are
-			-- boxed (represented by pointers). This 'PrimRep' holds
-			-- that information
+	isUnLifted   :: Bool,		        -- ^ Most primitive tycons are unlifted (may not contain bottom)
+					        --   but foreign-imported ones may be lifted
 
-	isUnLifted   :: Bool,		-- ^ Most primitive tycons are unlifted (may not contain bottom)
-					-- but foreign-imported ones may be lifted
-	tyConExtName :: Maybe FastString	-- ^ @Just e@ for foreign-imported types, holds the name of the imported thing
+	tyConExtName :: Maybe FastString	-- ^ @Just e@ for foreign-imported types, 
+                                                --   holds the name of the imported thing
     }
 
   -- | Type coercions, such as @(~)@, @sym@, @trans@, @left@ and @right@.
@@ -226,6 +230,19 @@ data TyCon
 		--	the kind as a pair of types: @(ta, tc)@
     }
 
+  -- | Any types.  Like tuples, this is a potentially-infinite family of TyCons
+  --   one for each distinct Kind. They have no values at all.
+  --   Because there are infinitely many of them (like tuples) they are 
+  --   defined in GHC.Prim and have names like "Any(*->*)".  
+  --   Their Unique is derived from the OccName.
+  -- See Note [Any types] in TysPrim
+  | AnyTyCon {
+	tyConUnique  :: Unique,
+	tyConName    :: Name,
+	tyConKind    :: Kind	-- Never = *; that is done via PrimTyCon
+		     		-- See Note [Any types] in TysPrim
+    }
+
   -- | Super-kinds. These are "kinds-of-kinds" and are never seen in Haskell source programs.
   -- There are only two super-kinds: TY (aka "box"), which is the super-kind of kinds that 
   -- construct types eventually, and CO (aka "diamond"), which is the super-kind of kinds
@@ -643,10 +660,10 @@ mkPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon
 mkPrimTyCon name kind arity rep
   = mkPrimTyCon' name kind arity rep True  
 
--- | Create the special void 'TyCon' which is unlifted and has 'VoidRep'
-mkVoidPrimTyCon :: Name -> Kind -> Arity -> TyCon
-mkVoidPrimTyCon name kind arity 
-  = mkPrimTyCon' name kind arity VoidRep True  
+-- | Kind constructors
+mkKindTyCon :: Name -> Kind -> TyCon
+mkKindTyCon name kind
+  = mkPrimTyCon' name kind 0 VoidRep True  
 
 -- | Create a lifted primitive 'TyCon' such as @RealWorld@
 mkLiftedPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon
@@ -688,6 +705,12 @@ mkCoercionTyCon name arity kindRule
         coKindFun = kindRule
     }
 
+mkAnyTyCon :: Name -> Kind -> TyCon
+mkAnyTyCon name kind 
+  = AnyTyCon { tyConName = name,
+		tyConKind = kind,
+        	tyConUnique = nameUnique name }
+
 -- | Create a super-kind 'TyCon'
 mkSuperKindTyCon :: Name -> TyCon -- Super kinds always have arity zero
 mkSuperKindTyCon name
@@ -907,6 +930,11 @@ isSuperKindTyCon :: TyCon -> Bool
 isSuperKindTyCon (SuperKindTyCon {}) = True
 isSuperKindTyCon _                   = False
 
+-- | Is this an AnyTyCon?
+isAnyTyCon :: TyCon -> Bool
+isAnyTyCon (AnyTyCon {}) = True
+isAnyTyCon _              = False
+
 -- | Attempt to pull a 'TyCon' apart into the arity and 'coKindFun' of
 -- a coercion 'TyCon'. Returns @Nothing@ if the 'TyCon' is not of the
 -- appropriate kind
diff --git a/compiler/types/TypeRep.lhs b/compiler/types/TypeRep.lhs
index 5c29087ec9..c1670f67bd 100644
--- a/compiler/types/TypeRep.lhs
+++ b/compiler/types/TypeRep.lhs
@@ -304,14 +304,11 @@ funTyCon = mkFunTyCon funTyConName (mkArrowKinds [argTypeKind, openTypeKind] lif
 tySuperKindTyCon     = mkSuperKindTyCon tySuperKindTyConName
 coSuperKindTyCon     = mkSuperKindTyCon coSuperKindTyConName
 
-liftedTypeKindTyCon   = mkKindTyCon liftedTypeKindTyConName
-openTypeKindTyCon     = mkKindTyCon openTypeKindTyConName
-unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName
-ubxTupleKindTyCon     = mkKindTyCon ubxTupleKindTyConName
-argTypeKindTyCon      = mkKindTyCon argTypeKindTyConName
-
-mkKindTyCon :: Name -> TyCon
-mkKindTyCon name = mkVoidPrimTyCon name tySuperKind 0
+liftedTypeKindTyCon   = mkKindTyCon liftedTypeKindTyConName   tySuperKind
+openTypeKindTyCon     = mkKindTyCon openTypeKindTyConName     tySuperKind
+unliftedTypeKindTyCon = mkKindTyCon unliftedTypeKindTyConName tySuperKind
+ubxTupleKindTyCon     = mkKindTyCon ubxTupleKindTyConName     tySuperKind
+argTypeKindTyCon      = mkKindTyCon argTypeKindTyConName      tySuperKind
 
 --------------------------
 -- ... and now their names
diff --git a/compiler/vectorise/VectUtils.hs b/compiler/vectorise/VectUtils.hs
index dcef9d8e4e..ea647c733f 100644
--- a/compiler/vectorise/VectUtils.hs
+++ b/compiler/vectorise/VectUtils.hs
@@ -98,7 +98,7 @@ mkBuiltinTyConApps get_tc tys ty
     mk tc ty1 ty2 = mkTyConApp tc [ty1,ty2]
 
 voidType :: VM Type
-voidType = mkBuiltinTyConApp voidTyCon []
+voidType = mkBuiltinTyConApp VectMonad.voidTyCon []
 
 mkWrapType :: Type -> VM Type
 mkWrapType ty = mkBuiltinTyConApp wrapTyCon [ty]