[project @ 1996-07-19 18:36:04 by partain]

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

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 27a16da..5b1e3d0 100644 (file)
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -43,6 +43,7 @@ module TysWiredIn (
        mkLiftTy,
        mkListTy,
        mkPrimIoTy,
+       mkStateTy,
        mkStateTransformerTy,
        mkTupleTy,
        nilDataCon,
@@ -51,6 +52,7 @@ module TysWiredIn (
        return2GMPsTyCon,
        returnIntAndGMPTyCon,
        stTyCon,
+       stDataCon,
        stablePtrTyCon,
        stateAndAddrPrimTyCon,
        stateAndArrayPrimTyCon,
@@ -84,23 +86,23 @@ 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         ( SpecEnv(..) )
 import Kind            ( mkBoxedTypeKind, mkArrowKind )
-import Name            ( mkWiredInName )
+import Name            ( mkWiredInName, ExportFlag(..) )
 import SrcLoc          ( mkBuiltinSrcLoc )
 import TyCon           ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
                          NewOrData(..), TyCon
                        )
 import Type            ( mkTyConTy, applyTyCon, mkSigmaTy,
-                         mkFunTys, maybeAppTyCon,
-                         GenType(..), ThetaType(..), TauType(..) )
+                         mkFunTy, maybeAppTyCon,
+                         GenType(..), SYN_IE(ThetaType), SYN_IE(TauType) )
 import TyVar           ( tyVarKind, alphaTyVar, betaTyVar )
 import Unique
 import Util            ( assoc, panic )
@@ -122,16 +124,21 @@ pcDataTyCon = pc_tycon DataType
 pcNewTyCon  = pc_tycon NewType
 
 pc_tycon new_or_data key mod str tyvars cons
-  = mkDataTyCon (mkWiredInName key (OrigName mod str)) tycon_kind 
+  = mkDataTyCon (mkWiredInName key (OrigName mod str) ExportAll) tycon_kind 
                tyvars [{-no context-}] cons [{-no derivings-}]
                new_or_data
   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
-  = mkDataCon (mkWiredInName key (OrigName mod str))
+  = mkDataCon (mkWiredInName key (OrigName mod str) ExportAll)
        [ NotMarkedStrict | a <- arg_tys ]
        [ {- no labelled fields -} ]
        tyvars context arg_tys tycon
@@ -440,30 +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}
 %*                                                                     *
 %************************************************************************
 
-@PrimIO@ and @IO@ really are just plain synonyms.
-
 \begin{code}
-mkPrimIoTy a = applyTyCon primIoTyCon [a]
+mkPrimIoTy a = mkStateTransformerTy realWorldTy a
 
-primIoTyCon = pcNewTyCon primIoTyConKey gHC__ SLIT("PrimIO") alpha_tyvar [primIoDataCon]
-  where
-    ty = mkFunTys [mkStateTy realWorldTy] (mkTupleTy 2 [alphaTy, mkStateTy realWorldTy])
-
-    primIoDataCon = pcDataCon primIoDataConKey gHC__ SLIT("PrimIO")
-                       alpha_tyvar [] [ty] primIoTyCon nullSpecEnv
+primIoTyCon
+  = pcSynTyCon
+     primIoTyConKey gHC__ SLIT("PrimIO")
+     (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind)
+     1 alpha_tyvar (mkPrimIoTy alphaTy)
 \end{code}
 
 %************************************************************************
@@ -530,12 +534,12 @@ trueDataCon  = pcDataCon trueDataConKey    pRELUDE SLIT("True")  [] [] [] boolTyCo
 %************************************************************************
 
 Special syntax, deeply wired in, but otherwise an ordinary algebraic
-data type:
+data types:
 \begin{verbatim}
-data List a = Nil | a : (List a)
-ToDo: data [] a = [] | a : (List a)
-ToDo: data () = ()
-      data (,,) a b c = (,,) a b c
+data [] a = [] | a : (List a)
+data () = ()
+data (,) a b = (,,) a b
+...
 \end{verbatim}
 
 \begin{code}