From: simonmar <unknown>
Date: Tue, 14 Aug 2001 16:29:56 +0000 (+0000)
Subject: [project @ 2001-08-14 16:29:56 by simonmar]
X-Git-Tag: Approximately_9120_patches~1259
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=eca4400fe193c38ecea52894fa659b8388fbb0bc;p=ghc-hetmet.git

[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
--- 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
--- 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
     }