[project @ 2003-08-01 14:58:47 by panne]

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

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 5b6754e..2975922 100644 (file)
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -13,15 +13,6 @@ types and operations.''
 module TysWiredIn (
        wiredInTyCons, genericTyCons,
 
-       addrDataCon,
-       addrTy,
-       addrTyCon,
-       ptrDataCon,
-       ptrTy,
-       ptrTyCon,
-       funPtrDataCon,
-       funPtrTy,
-       funPtrTyCon,
        boolTy,
        boolTyCon,
        charDataCon,
@@ -62,7 +53,6 @@ module TysWiredIn (
        plusTyCon, inrDataCon, inlDataCon,
        crossTyCon, crossDataCon,
 
-       stablePtrTyCon,
        stringTy,
        trueDataCon, trueDataConId,
        unitTy,
@@ -78,7 +68,7 @@ module TysWiredIn (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} MkId( mkDataConId, mkDataConWrapId )
+import {-# SOURCE #-} MkId( mkDataConWorkId )
 import {-# SOURCE #-} Generics( mkTyConGenInfo )
 
 -- friends:
@@ -90,14 +80,14 @@ import Constants    ( mAX_TUPLE_SIZE )
 import Module          ( mkBasePkgModule )
 import Name            ( Name, nameUnique, nameOccName, 
                          nameModule, mkWiredInName )
-import OccName         ( mkOccFS, tcName, dataName, mkWorkerOcc, mkGenOcc1, mkGenOcc2 )
+import OccName         ( mkOccFS, tcName, dataName, mkDataConWorkerOcc, mkGenOcc1, mkGenOcc2 )
 import DataCon         ( DataCon, mkDataCon, dataConWorkId, dataConSourceArity )
 import Var             ( TyVar, tyVarKind )
 import TyCon           ( TyCon, AlgTyConFlavour(..), DataConDetails(..), tyConDataCons,
                          mkTupleTyCon, mkAlgTyCon, tyConName
                        )
 
-import BasicTypes      ( Arity, RecFlag(..), Boxity(..), isBoxed, StrictnessMark(..) )
+import BasicTypes      ( Arity, RecFlag(..), Boxity(..), isBoxed )
 
 import Type            ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys, 
                          mkArrowKinds, liftedTypeKind, unliftedTypeKind,
@@ -128,10 +118,7 @@ wiredInTyCons :: [TyCon]
 wiredInTyCons = data_tycons ++ tuple_tycons ++ unboxed_tuple_tycons
 
 data_tycons = genericTyCons ++
-             [ addrTyCon
-             , ptrTyCon
-             , funPtrTyCon
-             , boolTyCon
+             [ boolTyCon
              , charTyCon
              , doubleTyCon
              , floatTyCon
@@ -192,27 +179,28 @@ mk_tc_gen_info mod tc_uniq tc_name tycon
        name2       = mkWiredInName  mod occ_name2 fn2_key
 
 pcDataCon :: Name -> [TyVar] -> ThetaType -> [Type] -> TyCon -> DataCon
+-- The Name should be in the DataName name space; it's the name
+-- of the DataCon itself.
+--
 -- The unique is the first of two free uniques;
--- the first is used for the datacon itself and the worker;
--- the second is used for the wrapper.
+-- the first is used for the datacon itself,
+-- the second is used for the "worker name"
 
-pcDataCon name tyvars context arg_tys tycon
+pcDataCon dc_name tyvars context arg_tys tycon
   = data_con
   where
-    data_con = mkDataCon name
-                [ NotMarkedStrict | a <- arg_tys ]
-                [ {- no labelled fields -} ]
-                tyvars context [] [] arg_tys tycon work_id wrap_id
-
-    wrap_occ  = nameOccName name
-
-    mod       = nameModule name
-    wrap_id   = mkDataConWrapId data_con
-
-    work_occ  = mkWorkerOcc wrap_occ
-    work_key  = incrUnique (nameUnique name)
-    work_name = mkWiredInName mod work_occ work_key
-    work_id   = mkDataConId work_name data_con
+    data_con = mkDataCon dc_name       
+                [{- No strictness -}]
+                [{- No labelled fields -}]
+                tyvars context [] [] arg_tys tycon work_id 
+               Nothing {- No wrapper for wired-in things
+                          (they are too simple to need one) -}
+
+    mod      = nameModule dc_name
+    wrk_occ  = mkDataConWorkerOcc (nameOccName dc_name)
+    wrk_key  = incrUnique (nameUnique dc_name)
+    wrk_name = mkWiredInName mod wrk_occ wrk_key
+    work_id  = mkDataConWorkId wrk_name data_con
 \end{code}
 
 
@@ -234,8 +222,8 @@ tupleCon Boxed   i = snd (boxedTupleArr   ! i)
 tupleCon Unboxed i = snd (unboxedTupleArr ! i)
 
 boxedTupleArr, unboxedTupleArr :: Array Int (TyCon,DataCon)
-boxedTupleArr   = array (0,mAX_TUPLE_SIZE) [(i,mk_tuple Boxed i)   | i <- [0..mAX_TUPLE_SIZE]]
-unboxedTupleArr = array (0,mAX_TUPLE_SIZE) [(i,mk_tuple Unboxed i) | i <- [0..mAX_TUPLE_SIZE]]
+boxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed i | i <- [0..mAX_TUPLE_SIZE]]
+unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]
 
 mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
 mk_tuple boxity arity = (tycon, tuple_con)
@@ -317,27 +305,6 @@ wordDataCon = pcDataCon wordDataConName [] [] [wordPrimTy] wordTyCon
 \end{code}
 
 \begin{code}
-addrTy = mkTyConTy addrTyCon
-
-addrTyCon = pcNonRecDataTyCon addrTyConName [] [] [addrDataCon]
-addrDataCon = pcDataCon addrDataConName [] [] [addrPrimTy] addrTyCon
-\end{code}
-
-\begin{code}
-ptrTy = mkTyConTy ptrTyCon
-
-ptrTyCon = pcNonRecDataTyCon ptrTyConName alpha_tyvar [(True,False)] [ptrDataCon]
-ptrDataCon = pcDataCon ptrDataConName alpha_tyvar [] [addrPrimTy] ptrTyCon
-\end{code}
-
-\begin{code}
-funPtrTy = mkTyConTy funPtrTyCon
-
-funPtrTyCon = pcNonRecDataTyCon funPtrTyConName alpha_tyvar [(True,False)] [funPtrDataCon]
-funPtrDataCon = pcDataCon funPtrDataConName alpha_tyvar [] [addrPrimTy] funPtrTyCon
-\end{code}
-
-\begin{code}
 floatTy        = mkTyConTy floatTyCon
 
 floatTyCon   = pcNonRecDataTyCon floatTyConName   [] [] [floatDataCon]
@@ -347,19 +314,10 @@ floatDataCon = pcDataCon         floatDataConName [] [] [floatPrimTy] floatTyCon
 \begin{code}
 doubleTy = mkTyConTy doubleTyCon
 
-doubleTyCon   = pcNonRecDataTyCon doubleTyConName     [] [] [doubleDataCon]
+doubleTyCon   = pcNonRecDataTyCon doubleTyConName   [] [] [doubleDataCon]
 doubleDataCon = pcDataCon        doubleDataConName [] [] [doublePrimTy] doubleTyCon
 \end{code}
 
-\begin{code}
-stablePtrTyCon
-  = pcNonRecDataTyCon stablePtrTyConName
-       alpha_tyvar [(True,False)] [stablePtrDataCon]
-  where
-    stablePtrDataCon
-      = pcDataCon stablePtrDataConName
-           alpha_tyvar [] [mkStablePtrPrimTy alphaTy] stablePtrTyCon
-\end{code}
 
 %************************************************************************
 %*                                                                     *