Another round of External Core fixes

[ghc-hetmet.git] / compiler / prelude / TysPrim.lhs

diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index 1ec7721..e8638d7 100644 (file)
--- 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,
@@ -39,7 +46,9 @@ module TysPrim(
        word32PrimTyCon,        word32PrimTy,
 
        int64PrimTyCon,         int64PrimTy,
-       word64PrimTyCon,        word64PrimTy
+       word64PrimTyCon,        word64PrimTy,
+
+       anyPrimTyCon, anyPrimTy, anyPrimTyCon1, mkAnyPrimTyCon
   ) where
 
 #include "HsVersions.h"
@@ -52,13 +61,14 @@ import TyCon                ( TyCon, mkPrimTyCon, mkLiftedPrimTyCon,
 import Type            ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
                          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 )
@@ -97,6 +107,7 @@ primTyCons
     , wordPrimTyCon
     , word32PrimTyCon
     , word64PrimTyCon
+    , anyPrimTyCon, anyPrimTyCon1
     ]
 
 mkPrimTc :: FastString -> Unique -> TyCon -> Name
@@ -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
@@ -263,6 +276,53 @@ 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}
 %*                                                                     *
 %************************************************************************