[project @ 2001-08-14 16:29:56 by simonmar]

Add TyCon.mkLiftedPrimTyCon, solely for RealWorld which is the only
lifted primitive TyCon.

diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs
index 7c16614..f36f212 100644 (file)
--- a/ghc/compiler/prelude/TysPrim.lhs
+++ b/ghc/compiler/prelude/TysPrim.lhs
@@ -49,7 +49,7 @@ module TysPrim(
 import Var             ( TyVar, mkSysTyVar )
 import Name            ( Name )
 import PrimRep         ( PrimRep(..) )
-import TyCon           ( TyCon, ArgVrcs, mkPrimTyCon )
+import TyCon           ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon )
 import Type            ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
                          unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKinds
                        )
@@ -208,7 +208,7 @@ 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 = mkPrimTyCon realWorldTyConName liftedTypeKind 0 [] PrimPtrRep
+realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PrimPtrRep
 realWorldTy         = mkTyConTy realWorldTyCon
 realWorldStatePrimTy = mkStatePrimTy realWorldTy       -- State# RealWorld
 \end{code}

diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs
index faa3b3f..fb48222 100644 (file)
--- a/ghc/compiler/types/TyCon.lhs
+++ b/ghc/compiler/types/TyCon.lhs
@@ -19,6 +19,7 @@ module TyCon(
        mkClassTyCon,
        mkFunTyCon,
        mkPrimTyCon,
+       mkLiftedPrimTyCon,
        mkTupleTyCon,
        mkSynTyCon,
        mkKindCon,
@@ -318,7 +319,15 @@ mkForeignTyCon name ext_name kind arity arg_vrcs
     }
 
 
+-- most Prim tycons are lifted
 mkPrimTyCon name kind arity arg_vrcs rep
+  = mkPrimTyCon' name kind arity arg_vrcs rep True  
+
+-- but RealWorld is lifted
+mkLiftedPrimTyCon name kind arity arg_vrcs rep
+  = mkPrimTyCon' name kind arity arg_vrcs rep False
+
+mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted
   = PrimTyCon {
        tyConName    = name,
        tyConUnique  = nameUnique name,
@@ -326,7 +335,7 @@ mkPrimTyCon name kind arity arg_vrcs rep
        tyConArity   = arity,
         tyConArgVrcs = arg_vrcs,
        primTyConRep = rep,
-       isUnLifted   = True,
+       isUnLifted   = is_unlifted,
        tyConExtName = Nothing
     }