[project @ 2000-03-23 17:45:17 by simonpj]

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

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 894fd7d..a8bcf25 100644 (file)
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -24,7 +24,7 @@ module TysWiredIn (
        doubleTy,
        isDoubleTy,
        doubleTyCon,
-       falseDataCon,
+       falseDataCon, falseDataConId,
        floatDataCon,
        floatTy,
        isFloatTy,
@@ -34,7 +34,6 @@ module TysWiredIn (
        intTy,
        intTyCon,
        isIntTy,
-       inIntRange,
 
        integerTy,
        integerTyCon,
@@ -49,7 +48,7 @@ module TysWiredIn (
 
        -- tuples
        mkTupleTy,
-       tupleTyCon, tupleCon, unitTyCon, unitDataCon, pairTyCon, pairDataCon,
+       tupleTyCon, tupleCon, unitTyCon, unitDataConId, pairTyCon, 
 
        -- unboxed tuples
        mkUnboxedTupleTy,
@@ -58,7 +57,7 @@ module TysWiredIn (
 
        stablePtrTyCon,
        stringTy,
-       trueDataCon,
+       trueDataCon, trueDataConId,
        unitTy,
        voidTy,
        wordDataCon,
@@ -75,7 +74,7 @@ module TysWiredIn (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} MkId( mkDataConId )
+import {-# SOURCE #-} MkId( mkDataConId, mkDataConWrapId )
 
 -- friends:
 import PrelMods
@@ -84,8 +83,8 @@ import TysPrim
 -- others:
 import Constants       ( mAX_TUPLE_SIZE )
 import Module          ( Module, mkPrelModule )
-import Name            ( mkWiredInTyConName, mkWiredInIdName, mkSrcOccFS, dataName )
-import DataCon         ( DataCon, StrictnessMark(..),  mkDataCon )
+import Name            ( mkWiredInTyConName, mkWiredInIdName, mkSrcOccFS, mkWorkerOcc, dataName )
+import DataCon         ( DataCon, StrictnessMark(..),  mkDataCon, dataConId )
 import Var             ( TyVar, tyVarKind )
 import TyCon           ( TyCon, ArgVrcs, mkAlgTyCon, mkSynTyCon, mkTupleTyCon )
 import BasicTypes      ( Arity, NewOrData(..), RecFlag(..) )
@@ -93,7 +92,7 @@ import Type           ( Type, mkTyConTy, mkTyConApp, mkSigmaTy, mkTyVarTys,
                          mkArrowKinds, boxedTypeKind, unboxedTypeKind,
                          mkFunTy, mkFunTys, isUnLiftedType,
                          splitTyConApp_maybe, splitAlgTyConApp_maybe,
-                         ThetaType, TauType )
+                         TauType, ClassContext )
 import PrimRep         ( PrimRep(..) )
 import Unique
 import CmdLineOpts      ( opt_GlasgowExts )
@@ -136,16 +135,26 @@ pcSynTyCon key mod str kind arity tyvars expansion argvrcs  -- this fun never us
     name  = mkWiredInTyConName key mod str tycon
 
 pcDataCon :: Unique{-DataConKey-} -> Module -> FAST_STRING
-         -> [TyVar] -> ThetaType -> [TauType] -> TyCon -> DataCon
-pcDataCon key mod str tyvars context arg_tys tycon
+         -> [TyVar] -> ClassContext -> [TauType] -> TyCon -> DataCon
+-- 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.
+pcDataCon wrap_key mod str tyvars context arg_tys tycon
   = data_con
   where
-    data_con = mkDataCon name 
+    data_con = mkDataCon wrap_name 
                [ NotMarkedStrict | a <- arg_tys ]
                [ {- no labelled fields -} ]
-               tyvars context [] [] arg_tys tycon id
-    name = mkWiredInIdName key mod (mkSrcOccFS dataName str) id
-    id   = mkDataConId data_con
+               tyvars context [] [] arg_tys tycon work_id wrap_id
+
+    work_occ  = mkWorkerOcc wrap_occ
+    work_key  = incrUnique wrap_key
+    work_name = mkWiredInIdName work_key mod work_occ work_id
+    work_id   = mkDataConId work_name data_con
+    
+    wrap_occ  = mkSrcOccFS dataName str
+    wrap_name = mkWiredInIdName wrap_key mod wrap_occ wrap_id
+    wrap_id   = mkDataConWrapId data_con
 \end{code}
 
 %************************************************************************
@@ -193,8 +202,7 @@ mk_tuple arity = (tycon, tuple_con)
 unitTyCon = tupleTyCon 0
 pairTyCon = tupleTyCon 2
 
-unitDataCon = tupleCon 0
-pairDataCon = tupleCon 2
+unitDataConId = dataConId (tupleCon 0)
 \end{code}
 
 %************************************************************************
@@ -282,14 +290,6 @@ isIntTy ty
   = case (splitAlgTyConApp_maybe ty) of
        Just (tycon, [], _) -> getUnique tycon == intTyConKey
        _                   -> False
-
-inIntRange :: Integer -> Bool  -- Tells if an integer lies in the legal range of Ints
-inIntRange i = (min_int <= i) && (i <= max_int)
-
-max_int, min_int :: Integer
-max_int = toInteger maxInt  
-min_int = toInteger minInt
-
 \end{code}
 
 \begin{code}
@@ -317,8 +317,8 @@ isAddrTy ty
 \begin{code}
 floatTy        = mkTyConTy floatTyCon
 
-floatTyCon = pcNonRecDataTyCon floatTyConKey pREL_BASE SLIT("Float") [] [] [floatDataCon]
-floatDataCon = pcDataCon floatDataConKey pREL_BASE SLIT("F#") [] [] [floatPrimTy] floatTyCon
+floatTyCon = pcNonRecDataTyCon floatTyConKey pREL_FLOAT SLIT("Float") [] [] [floatDataCon]
+floatDataCon = pcDataCon floatDataConKey pREL_FLOAT SLIT("F#") [] [] [floatPrimTy] floatTyCon
 
 isFloatTy :: Type -> Bool
 isFloatTy ty
@@ -337,8 +337,8 @@ isDoubleTy ty
        Just (tycon, [], _) -> getUnique tycon == doubleTyConKey
        _                   -> False
 
-doubleTyCon = pcNonRecDataTyCon doubleTyConKey pREL_BASE SLIT("Double") [] [] [doubleDataCon]
-doubleDataCon = pcDataCon doubleDataConKey pREL_BASE SLIT("D#") [] [] [doublePrimTy] doubleTyCon
+doubleTyCon = pcNonRecDataTyCon doubleTyConKey pREL_FLOAT SLIT("Double") [] [] [doubleDataCon]
+doubleDataCon = pcDataCon doubleDataConKey pREL_FLOAT SLIT("D#") [] [] [doublePrimTy] doubleTyCon
 \end{code}
 
 \begin{code}
@@ -372,12 +372,12 @@ foreignObjTyCon
 integerTy :: Type
 integerTy = mkTyConTy integerTyCon
 
-integerTyCon = pcNonRecDataTyCon integerTyConKey pREL_BASE SLIT("Integer")
+integerTyCon = pcNonRecDataTyCon integerTyConKey pREL_NUM SLIT("Integer")
                    [] [] [smallIntegerDataCon, largeIntegerDataCon]
 
-smallIntegerDataCon = pcDataCon smallIntegerDataConKey pREL_BASE SLIT("S#")
+smallIntegerDataCon = pcDataCon smallIntegerDataConKey pREL_NUM SLIT("S#")
                [] [] [intPrimTy] integerTyCon
-largeIntegerDataCon = pcDataCon largeIntegerDataConKey pREL_BASE SLIT("J#")
+largeIntegerDataCon = pcDataCon largeIntegerDataConKey pREL_NUM SLIT("J#")
                [] [] [intPrimTy, byteArrayPrimTy] integerTyCon
 
 
@@ -526,6 +526,9 @@ boolTyCon = pcTyCon EnumType NonRecursive boolTyConKey
 
 falseDataCon = pcDataCon falseDataConKey pREL_BASE SLIT("False") [] [] [] boolTyCon
 trueDataCon  = pcDataCon trueDataConKey         pREL_BASE SLIT("True")  [] [] [] boolTyCon
+
+falseDataConId = dataConId falseDataCon
+trueDataConId  = dataConId trueDataCon
 \end{code}
 
 %************************************************************************