[project @ 1996-05-17 16:02:43 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 327b209..a4623c2 100644 (file)
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -42,7 +42,7 @@ module TysWiredIn (
        liftTyCon,
        listTyCon,
        ltDataCon,
-       mallocPtrTyCon,
+       foreignObjTyCon,
        mkLiftTy,
        mkListTy,
        mkPrimIoTy,
@@ -68,7 +68,7 @@ module TysWiredIn (
        stateAndDoublePrimTyCon,
        stateAndFloatPrimTyCon,
        stateAndIntPrimTyCon,
-       stateAndMallocPtrPrimTyCon,
+       stateAndForeignObjPrimTyCon,
        stateAndMutableArrayPrimTyCon,
        stateAndMutableByteArrayPrimTyCon,
        stateAndPtrPrimTyCon,
@@ -81,12 +81,20 @@ module TysWiredIn (
        stringTyCon,
        trueDataCon,
        unitTy,
+       voidTy, voidTyCon,
        wordDataCon,
        wordTy,
        wordTyCon
 
     ) where
 
+--ToDo:rm
+--import Pretty
+--import Util
+--import PprType
+--import PprStyle
+--import Kind
+
 import Ubiq
 import TyLoop          ( mkDataCon, StrictnessMark(..) )
 
@@ -103,9 +111,9 @@ import TyCon                ( mkDataTyCon, mkTupleTyCon, mkSynTyCon,
                          NewOrData(..), TyCon
                        )
 import Type            ( mkTyConTy, applyTyCon, mkSynTy, mkSigmaTy,
-                         mkFunTys, maybeAppDataTyCon,
+                         mkFunTys, maybeAppDataTyConExpandingDicts,
                          GenType(..), ThetaType(..), TauType(..) )
-import TyVar           ( getTyVarKind, alphaTyVar, betaTyVar )
+import TyVar           ( tyVarKind, alphaTyVar, betaTyVar )
 import Unique
 import Util            ( assoc, panic )
 
@@ -121,7 +129,7 @@ pcDataTyCon key mod str tyvars cons
                tyvars [{-no context-}] cons [{-no derivings-}]
                DataType
   where
-    tycon_kind = foldr (mkArrowKind . getTyVarKind) mkBoxedTypeKind tyvars
+    tycon_kind = foldr (mkArrowKind . tyVarKind) mkBoxedTypeKind tyvars
 
 pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
          -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> SpecEnv -> Id
@@ -146,6 +154,13 @@ pcGenerateDataSpecs ty
 %************************************************************************
 
 \begin{code}
+-- The Void type is represented as a data type with no constructors
+voidTy = mkTyConTy voidTyCon
+
+voidTyCon = pcDataTyCon voidTyConKey pRELUDE_BUILTIN SLIT("Void") [] []
+\end{code}
+
+\begin{code}
 charTy = mkTyConTy charTyCon
 
 charTyCon = pcDataTyCon charTyConKey pRELUDE_BUILTIN SLIT("Char") [] [charDataCon]
@@ -204,17 +219,17 @@ stablePtrTyCon
   where
     stablePtrDataCon
       = pcDataCon stablePtrDataConKey gLASGOW_MISC SLIT("_StablePtr")
-           [alphaTyVar] [] [applyTyCon stablePtrPrimTyCon [alphaTy]] stablePtrTyCon nullSpecEnv
+           [alphaTyVar] [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon nullSpecEnv
 \end{code}
 
 \begin{code}
-mallocPtrTyCon
-  = pcDataTyCon mallocPtrTyConKey gLASGOW_MISC SLIT("_MallocPtr")
-       [] [mallocPtrDataCon]
+foreignObjTyCon
+  = pcDataTyCon foreignObjTyConKey gLASGOW_MISC SLIT("_ForeignObj")
+       [] [foreignObjDataCon]
   where
-    mallocPtrDataCon
-      = pcDataCon mallocPtrDataConKey gLASGOW_MISC SLIT("_MallocPtr")
-           [] [] [applyTyCon mallocPtrPrimTyCon []] mallocPtrTyCon nullSpecEnv
+    foreignObjDataCon
+      = pcDataCon foreignObjDataConKey gLASGOW_MISC SLIT("_ForeignObj")
+           [] [] [foreignObjPrimTy] foreignObjTyCon nullSpecEnv
 \end{code}
 
 %************************************************************************
@@ -315,14 +330,14 @@ stateAndStablePtrPrimDataCon
                [mkStatePrimTy alphaTy, applyTyCon stablePtrPrimTyCon [betaTy]]
                stateAndStablePtrPrimTyCon nullSpecEnv
 
-stateAndMallocPtrPrimTyCon
-  = pcDataTyCon stateAndMallocPtrPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#")
-               [alphaTyVar] [stateAndMallocPtrPrimDataCon]
-stateAndMallocPtrPrimDataCon
-  = pcDataCon stateAndMallocPtrPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndMallocPtr#")
+stateAndForeignObjPrimTyCon
+  = pcDataTyCon stateAndForeignObjPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndForeignObj#")
+               [alphaTyVar] [stateAndForeignObjPrimDataCon]
+stateAndForeignObjPrimDataCon
+  = pcDataCon stateAndForeignObjPrimDataConKey pRELUDE_BUILTIN SLIT("StateAndForeignObj#")
                [alphaTyVar] []
-               [mkStatePrimTy alphaTy, applyTyCon mallocPtrPrimTyCon []]
-               stateAndMallocPtrPrimTyCon nullSpecEnv
+               [mkStatePrimTy alphaTy, applyTyCon foreignObjPrimTyCon []]
+               stateAndForeignObjPrimTyCon nullSpecEnv
 
 stateAndFloatPrimTyCon
   = pcDataTyCon stateAndFloatPrimTyConKey pRELUDE_BUILTIN SLIT("StateAndFloat#")
@@ -394,7 +409,7 @@ getStatePairingConInfo
            Type)       -- type of state pair
 
 getStatePairingConInfo prim_ty
-  = case (maybeAppDataTyCon prim_ty) of
+  = case (maybeAppDataTyConExpandingDicts prim_ty) of
       Nothing -> panic "getStatePairingConInfo:1"
       Just (prim_tycon, tys_applied, _) ->
        let
@@ -409,7 +424,7 @@ getStatePairingConInfo prim_ty
        (wordPrimTyCon, (stateAndWordPrimDataCon, stateAndWordPrimTyCon, 0)),
        (addrPrimTyCon, (stateAndAddrPrimDataCon, stateAndAddrPrimTyCon, 0)),
        (stablePtrPrimTyCon, (stateAndStablePtrPrimDataCon, stateAndStablePtrPrimTyCon, 0)),
-       (mallocPtrPrimTyCon, (stateAndMallocPtrPrimDataCon, stateAndMallocPtrPrimTyCon, 0)),
+       (foreignObjPrimTyCon, (stateAndForeignObjPrimDataCon, stateAndForeignObjPrimTyCon, 0)),
        (floatPrimTyCon, (stateAndFloatPrimDataCon, stateAndFloatPrimTyCon, 0)),
        (doublePrimTyCon, (stateAndDoublePrimDataCon, stateAndDoublePrimTyCon, 0)),
        (arrayPrimTyCon, (stateAndArrayPrimDataCon, stateAndArrayPrimTyCon, 0)),
@@ -433,11 +448,14 @@ This is really just an ordinary synonym, except it is ABSTRACT.
 mkStateTransformerTy s a = mkSynTy stTyCon [s, a]
 
 stTyCon
-  = mkSynTyCon
+  = let
+       ty = mkFunTys [mkStateTy alphaTy] (mkTupleTy 2 [betaTy, mkStateTy alphaTy])
+    in
+    mkSynTyCon
      (mkBuiltinName stTyConKey gLASGOW_ST SLIT("_ST"))
-     (panic "TysWiredIn.stTyCon:Kind")
+     (mkBoxedTypeKind `mkArrowKind` (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind))
      2 [alphaTyVar, betaTyVar]
-     (mkFunTys [mkStateTy alphaTy] (mkTupleTy 2 [betaTy, mkStateTy alphaTy]))
+     ty
 \end{code}
 
 %************************************************************************
@@ -452,10 +470,14 @@ stTyCon
 mkPrimIoTy a = mkSynTy primIoTyCon [a]
 
 primIoTyCon
-  = mkSynTyCon
+  = let
+       ty = mkStateTransformerTy realWorldTy alphaTy
+    in
+--  pprTrace "primIOTyCon:" (ppCat [pprType PprDebug ty, ppr PprDebug (typeKind ty)]) $
+    mkSynTyCon
      (mkBuiltinName primIoTyConKey pRELUDE_PRIMIO SLIT("PrimIO"))
-     (panic "TysWiredIn.primIoTyCon:Kind")
-     1 [alphaTyVar] (mkStateTransformerTy realWorldTy alphaTy)
+     (mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind)
+     1 [alphaTyVar] ty
 \end{code}
 
 %************************************************************************
@@ -509,10 +531,10 @@ primitive counterpart.
 \begin{code}
 boolTy = mkTyConTy boolTyCon
 
-boolTyCon = pcDataTyCon boolTyConKey pRELUDE_CORE SLIT("Bool") [] [falseDataCon, trueDataCon]
+boolTyCon = pcDataTyCon boolTyConKey pRELUDE SLIT("Bool") [] [falseDataCon, trueDataCon]
 
-falseDataCon = pcDataCon falseDataConKey pRELUDE_CORE SLIT("False") [] [] [] boolTyCon nullSpecEnv
-trueDataCon  = pcDataCon trueDataConKey         pRELUDE_CORE SLIT("True")  [] [] [] boolTyCon nullSpecEnv
+falseDataCon = pcDataCon falseDataConKey pRELUDE SLIT("False") [] [] [] boolTyCon nullSpecEnv
+trueDataCon  = pcDataCon trueDataConKey         pRELUDE SLIT("True")  [] [] [] boolTyCon nullSpecEnv
 \end{code}
 
 %************************************************************************
@@ -638,15 +660,15 @@ rationalTy :: GenType t u
 mkRatioTy ty = applyTyCon ratioTyCon [ty]
 rationalTy   = mkRatioTy integerTy
 
-ratioTyCon = pcDataTyCon ratioTyConKey pRELUDE_RATIO SLIT("Ratio") [alphaTyVar] [ratioDataCon]
+ratioTyCon = pcDataTyCon ratioTyConKey rATIO SLIT("Ratio") [alphaTyVar] [ratioDataCon]
 
-ratioDataCon = pcDataCon ratioDataConKey pRELUDE_RATIO SLIT(":%")
+ratioDataCon = pcDataCon ratioDataConKey rATIO SLIT(":%")
                [alphaTyVar] [{-(integralClass,alphaTy)-}] [alphaTy, alphaTy] ratioTyCon nullSpecEnv
        -- context omitted to match lib/prelude/ defn of "data Ratio ..."
 
 rationalTyCon
   = mkSynTyCon
-      (mkBuiltinName rationalTyConKey pRELUDE_RATIO SLIT("Rational"))
+      (mkBuiltinName rationalTyConKey rATIO SLIT("Rational"))
       mkBoxedTypeKind
       0        [] rationalTy -- == mkRatioTy integerTy
 \end{code}
@@ -669,7 +691,7 @@ mkLiftTy ty
     (tvs, theta, tau) = splitSigmaTy ty
 
 isLiftTy ty
-  = case maybeAppDataTyCon tau of
+  = case (maybeAppDataTyConExpandingDicts tau) of
       Just (tycon, tys, _) -> tycon == liftTyCon
       Nothing -> False
   where
@@ -703,7 +725,7 @@ stringTy = mkListTy charTy
 
 stringTyCon
  = mkSynTyCon
-     (mkBuiltinName stringTyConKey pRELUDE_CORE SLIT("String"))
+     (mkBuiltinName stringTyConKey pRELUDE SLIT("String"))
      mkBoxedTypeKind
      0 [] stringTy
 \end{code}