X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysWiredIn.lhs;h=5b1e3d0a0c3ada9c101c5a855fc97890dd2bf543;hb=f7ecf7234c224489be8a5e63fced903b655d92ee;hp=6a5285a460ddf23e6ac7ccaeb88441d6274b3a7c;hpb=26741ec416bae2c502ef00a2ba0e79050a32cb67;p=ghc-hetmet.git

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 6a5285a..5b1e3d0 100644
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -48,11 +48,11 @@ module TysWiredIn (
 	mkTupleTy,
 	nilDataCon,
 	primIoTyCon,
-	primIoDataCon,
 	realWorldStateTy,
 	return2GMPsTyCon,
 	returnIntAndGMPTyCon,
 	stTyCon,
+	stDataCon,
 	stablePtrTyCon,
 	stateAndAddrPrimTyCon,
 	stateAndArrayPrimTyCon,
@@ -86,14 +86,14 @@ module TysWiredIn (
 --import Kind
 
 IMP_Ubiq()
-IMPORT_DELOOPER(TyLoop)		( mkDataCon, StrictnessMark(..) )
+IMPORT_DELOOPER(TyLoop)	( mkDataCon, StrictnessMark(..) )
+IMPORT_DELOOPER(IdLoop)	( SpecEnv )
 
 -- friends:
 import PrelMods
 import TysPrim
 
 -- others:
-import SpecEnv		( SYN_IE(SpecEnv) )
 import Kind		( mkBoxedTypeKind, mkArrowKind )
 import Name		( mkWiredInName, ExportFlag(..) )
 import SrcLoc		( mkBuiltinSrcLoc )
@@ -101,7 +101,7 @@ import TyCon		( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
 			  NewOrData(..), TyCon
 			)
 import Type		( mkTyConTy, applyTyCon, mkSigmaTy,
-			  mkFunTys, maybeAppTyCon,
+			  mkFunTy, maybeAppTyCon,
 			  GenType(..), SYN_IE(ThetaType), SYN_IE(TauType) )
 import TyVar		( tyVarKind, alphaTyVar, betaTyVar )
 import Unique
@@ -130,6 +130,11 @@ pc_tycon new_or_data key mod str tyvars cons
   where
     tycon_kind = foldr (mkArrowKind . tyVarKind) mkBoxedTypeKind tyvars
 
+pcSynTyCon key mod str kind arity tyvars expansion
+  = mkSynTyCon
+     (mkWiredInName key (OrigName mod str) ExportAll)
+     kind arity tyvars expansion
+
 pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
 	  -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id
 pcDataCon key mod str tyvars context arg_tys tycon specenv
@@ -442,28 +447,27 @@ This is really just an ordinary synonym, except it is ABSTRACT.
 mkStateTransformerTy s a = applyTyCon stTyCon [s, a]
 
 stTyCon = pcNewTyCon stTyConKey gHC__ SLIT("ST") alpha_beta_tyvars [stDataCon]
-  where
-    ty = mkFunTys [mkStateTy alphaTy] (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
 
-    stDataCon = pcDataCon stDataConKey gHC__ SLIT("ST")
+stDataCon = pcDataCon stDataConKey gHC__ SLIT("ST")
 			alpha_beta_tyvars [] [ty] stTyCon nullSpecEnv
+  where
+    ty = mkFunTy (mkStateTy alphaTy) (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
 \end{code}
 
 %************************************************************************
 %*									*
-\subsection[TysWiredIn-IO]{The @PrimIO@ and @IO@ monadic-I/O types}
+\subsection[TysWiredIn-IO]{The @PrimIO@ monadic-I/O type}
 %*									*
 %************************************************************************
 
 \begin{code}
-mkPrimIoTy a = applyTyCon primIoTyCon [a]
+mkPrimIoTy a = mkStateTransformerTy realWorldTy a
 
-primIoTyCon = pcNewTyCon primIoTyConKey gHC__ SLIT("PrimIO") alpha_tyvar [primIoDataCon]
-
-primIoDataCon = pcDataCon primIoDataConKey gHC__ SLIT("PrimIO")
-		    alpha_tyvar [] [ty] primIoTyCon nullSpecEnv
-  where
-    ty = mkFunTys [mkStateTy realWorldTy] (mkTupleTy 2 [alphaTy, mkStateTy realWorldTy])
+primIoTyCon
+  = pcSynTyCon
+     primIoTyConKey gHC__ SLIT("PrimIO")
+     (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind)
+     1 alpha_tyvar (mkPrimIoTy alphaTy)
 \end{code}
 
 %************************************************************************