X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysWiredIn.lhs;h=a8bcf25ee4b2ad31307bfa4c4b72b655e26287f8;hb=111cee3f1ad93816cb828e38b38521d85c3bcebb;hp=894fd7d3ba4842613513d15cdace93548c8cc45b;hpb=bd3fdabc98a87e7ebf124e9c26f6a7f89cb214e1;p=ghc-hetmet.git

diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 894fd7d..a8bcf25 100644
--- 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}
 
 %************************************************************************