- Add primops for {read,write,index}{Int,Word}{8,16,32,64}OffAddr.
This enables us to remove all the _casm_s from Int/Word.
- Replace new{Char,Int,etc.}Array# with newByteArray# (save a few primops,
at the cost of having to know the size of these types in PrelArr).
- Implement MArray/IArray support for sized types. finally.
- Move the guts of the sized types into ghc/lib/std, we'll need
them for doing more FFIish things in the Prelude.
pREL_MAIN_Name = mkModuleName "PrelMain"
mAIN_Name = mkModuleName "Main"
-iNT_Name = mkModuleName "Int"
-wORD_Name = mkModuleName "Word"
+pREL_INT_Name = mkModuleName "PrelInt"
+pREL_WORD_Name = mkModuleName "PrelWord"
pREL_GHC = mkPrelModule pREL_GHC_Name
pREL_BASE = mkPrelModule pREL_BASE_Name
returnIOName = varQual pREL_IO_BASE_Name SLIT("returnIO") returnIOIdKey
-- Int, Word, and Addr things
-int8TyConName = tcQual iNT_Name SLIT("Int8") int8TyConKey
-int16TyConName = tcQual iNT_Name SLIT("Int16") int16TyConKey
-int32TyConName = tcQual iNT_Name SLIT("Int32") int32TyConKey
+int8TyConName = tcQual pREL_INT_Name SLIT("Int8") int8TyConKey
+int16TyConName = tcQual pREL_INT_Name SLIT("Int16") int16TyConKey
+int32TyConName = tcQual pREL_INT_Name SLIT("Int32") int32TyConKey
int64TyConName = tcQual pREL_ADDR_Name SLIT("Int64") int64TyConKey
-wordTyConName = tcQual pREL_ADDR_Name SLIT("Word") wordTyConKey
-wordDataConName = dataQual pREL_ADDR_Name SLIT("W#") wordDataConKey
-word8TyConName = tcQual wORD_Name SLIT("Word8") word8TyConKey
-word16TyConName = tcQual wORD_Name SLIT("Word16") word16TyConKey
-word32TyConName = tcQual wORD_Name SLIT("Word32") word32TyConKey
+wordTyConName = tcQual pREL_ADDR_Name SLIT("Word") wordTyConKey
+wordDataConName = dataQual pREL_ADDR_Name SLIT("W#") wordDataConKey
+word8TyConName = tcQual pREL_WORD_Name SLIT("Word8") word8TyConKey
+word16TyConName = tcQual pREL_WORD_Name SLIT("Word16") word16TyConKey
+word32TyConName = tcQual pREL_WORD_Name SLIT("Word32") word32TyConKey
word64TyConName = tcQual pREL_ADDR_Name SLIT("Word64") word64TyConKey
addrTyConName = tcQual pREL_ADDR_Name SLIT("Addr") addrTyConKey
getPrimRepSize DoubleRep = dOUBLE_SIZE -- "words", of course
getPrimRepSize Word64Rep = wORD64_SIZE
getPrimRepSize Int64Rep = iNT64_SIZE
---getPrimRepSize FloatRep = 1
---getPrimRepSize CharRep = 1 -- ToDo: count in bytes?
---getPrimRepSize ArrayRep = 1 -- Listed specifically for *documentation*
---getPrimRepSize ByteArrayRep = 1
getPrimRepSize VoidRep = 0
getPrimRepSize other = 1
-----------------------------------------------------------------------
--- $Id: primops.txt,v 1.8 2000/12/11 12:56:14 simonmar Exp $
+-- $Id: primops.txt,v 1.9 2000/12/12 12:19:57 simonmar Exp $
--
-- Primitive Operations
--
--- Arrays ---
------------------------------------------------------------------------
-primop NewByteArrayOp_Char "newCharArray#" GenPrimOp
+primop NewByteArrayOp_Char "newByteArray#" GenPrimOp
Int# -> State# s -> (# State# s, MutByteArr# s #)
with out_of_line = True
-primop NewByteArrayOp_Int "newIntArray#" GenPrimOp
- Int# -> State# s -> (# State# s, MutByteArr# s #)
- with out_of_line = True
-
-primop NewByteArrayOp_Word "newWordArray#" GenPrimOp
- Int# -> State# s -> (# State# s, MutByteArr# s #)
- with out_of_line = True
-
-primop NewByteArrayOp_Addr "newAddrArray#" GenPrimOp
- Int# -> State# s -> (# State# s, MutByteArr# s #)
- with out_of_line = True
-
-primop NewByteArrayOp_Float "newFloatArray#" GenPrimOp
- Int# -> State# s -> (# State# s, MutByteArr# s #)
- with out_of_line = True
-
-primop NewByteArrayOp_Double "newDoubleArray#" GenPrimOp
- Int# -> State# s -> (# State# s, MutByteArr# s #)
- with out_of_line = True
-
-primop NewByteArrayOp_StablePtr "newStablePtrArray#" GenPrimOp
- Int# -> State# s -> (# State# s, MutByteArr# s #)
- with out_of_line = True
-
-
primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
primop ReadByteArrayOp_StablePtr "readStablePtrArray#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, StablePtr# a #)
+primop ReadByteArrayOp_Int8 "readInt8Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadByteArrayOp_Int16 "readInt16Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadByteArrayOp_Int32 "readInt32Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
+
primop ReadByteArrayOp_Int64 "readInt64Array#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, Int64# #)
+primop ReadByteArrayOp_Word8 "readWord8Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadByteArrayOp_Word16 "readWord16Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadByteArrayOp_Word32 "readWord32Array#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Word# #)
+
primop ReadByteArrayOp_Word64 "readWord64Array#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, Word64# #)
MutByteArr# s -> Int# -> StablePtr# a -> State# s -> State# s
with has_side_effects = True
+primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteByteArrayOp_Word16 "writeWord16Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp
MutByteArr# s -> Int# -> Int64# -> State# s -> State# s
with has_side_effects = True
primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp
ByteArr# -> Int# -> StablePtr# a
+primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
ByteArr# -> Int# -> Int64#
primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp
Addr# -> Int# -> StablePtr# a
+primop IndexOffAddrOp_Int8 "indexInt8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int#
+
+primop IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word#
+
+primop IndexOffAddrOp_Int16 "indexInt16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int#
+
+primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word#
+
+primop IndexOffAddrOp_Int32 "indexInt32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int#
+
+primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word#
+
primop IndexOffAddrOp_Int64 "indexInt64OffAddr#" GenPrimOp
Addr# -> Int# -> Int64#
primop IndexOffForeignObjOp_StablePtr "indexStablePtrOffForeignObj#" GenPrimOp
ForeignObj# -> Int# -> StablePtr# a
+primop IndexOffForeignObjOp_Int8 "indexInt8OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Int#
+
+primop IndexOffForeignObjOp_Word8 "indexWord8OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
+primop IndexOffForeignObjOp_Int16 "indexInt16OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Int#
+
+primop IndexOffForeignObjOp_Word16 "indexWord16OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
+primop IndexOffForeignObjOp_Int32 "indexInt32OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Int#
+
+primop IndexOffForeignObjOp_Word32 "indexWord32OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
primop IndexOffForeignObjOp_Int64 "indexInt64OffForeignObj#" GenPrimOp
ForeignObj# -> Int# -> Int64#
primop ReadOffAddrOp_ForeignObj "readForeignObjOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, ForeignObj# #)
+primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadOffAddrOp_Int16 "readInt16OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadOffAddrOp_Int32 "readInt32OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Int# #)
+
+primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
primop ReadOffAddrOp_Int64 "readInt64OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Int64# #)
Addr# -> Int# -> ForeignObj# -> State# s -> State# s
with has_side_effects = True
+primop WriteOffAddrOp_Int8 "writeInt8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int# -> State# s -> State# s
+ with has_side_effects = True
+
+primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word# -> State# s -> State# s
+ with has_side_effects = True
+
primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp
Addr# -> Int# -> Int64# -> State# s -> State# s
with has_side_effects = True
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.69 2000/12/11 12:56:14 simonmar Exp $
+ * $Id: PrimOps.h,v 1.70 2000/12/12 12:19:57 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#define readFloatOffAddrzh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i))
#define readDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i))
#define readStablePtrOffAddrzh(r,a,i) r= ((StgStablePtr *)(a))[i]
+#define readInt8OffAddrzh(r,a,i) r= ((StgInt8 *)(a))[i]
+#define readInt16OffAddrzh(r,a,i) r= ((StgInt16 *)(a))[i]
+#define readInt32OffAddrzh(r,a,i) r= ((StgInt32 *)(a))[i]
+#define readWord8OffAddrzh(r,a,i) r= ((StgWord8 *)(a))[i]
+#define readWord16OffAddrzh(r,a,i) r= ((StgWord16 *)(a))[i]
+#define readWord32OffAddrzh(r,a,i) r= ((StgWord32 *)(a))[i]
#ifdef SUPPORT_LONG_LONGS
#define readInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i]
#define readWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i]
#define writeFloatOffAddrzh(a,i,v) ASSIGN_FLT((P_) (((StgFloat *)(a)) + i),v)
#define writeDoubleOffAddrzh(a,i,v) ASSIGN_DBL((P_) (((StgDouble *)(a)) + i),v)
#define writeStablePtrOffAddrzh(a,i,v) ((StgStablePtr *)(a))[i] = (v)
+#define writeInt8OffAddrzh(a,i,v) ((StgInt8 *)(a))[i] = (v)
+#define writeInt16OffAddrzh(a,i,v) ((StgInt16 *)(a))[i] = (v)
+#define writeInt32OffAddrzh(a,i,v) ((StgInt32 *)(a))[i] = (v)
+#define writeWord8OffAddrzh(a,i,v) ((StgWord8 *)(a))[i] = (v)
+#define writeWord16OffAddrzh(a,i,v) ((StgWord16 *)(a))[i] = (v)
+#define writeWord32OffAddrzh(a,i,v) ((StgWord32 *)(a))[i] = (v)
#ifdef SUPPORT_LONG_LONGS
#define writeInt64OffAddrzh(a,i,v) ((LI_ *)(a))[i] = (v)
#define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v)
#define indexFloatOffAddrzh(r,a,i) r= PK_FLT((P_) (((StgFloat *)(a)) + i))
#define indexDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i))
#define indexStablePtrOffAddrzh(r,a,i) r= ((StgStablePtr *)(a))[i]
+#define indexInt8OffAddrzh(r,a,i) r= ((StgInt8 *)(a))[i]
+#define indexInt16OffAddrzh(r,a,i) r= ((StgInt16 *)(a))[i]
+#define indexInt32OffAddrzh(r,a,i) r= ((StgInt32 *)(a))[i]
+#define indexWord8OffAddrzh(r,a,i) r= ((StgWord8 *)(a))[i]
+#define indexWord16OffAddrzh(r,a,i) r= ((StgWord16 *)(a))[i]
+#define indexWord32OffAddrzh(r,a,i) r= ((StgWord32 *)(a))[i]
#ifdef SUPPORT_LONG_LONGS
#define indexInt64OffAddrzh(r,a,i) r= ((LI_ *)(a))[i]
#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i]
#define readFloatArrayzh(r,a,i) indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i)
#define readDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i)
#define readStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readInt8Arrayzh(r,a,i) indexInt8OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readInt16Arrayzh(r,a,i) indexInt16OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readInt32Arrayzh(r,a,i) indexInt32OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i)
#ifdef SUPPORT_LONG_LONGS
#define readInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define writeDoubleArrayzh(a,i,v) \
ASSIGN_DBL((P_) (((StgDouble *)(BYTE_ARR_CTS(a))) + i),v)
#define writeStablePtrArrayzh(a,i,v) ((StgStablePtr *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeInt8Arrayzh(a,i,v) ((StgInt8 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeInt16Arrayzh(a,i,v) ((StgInt16 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeInt32Arrayzh(a,i,v) ((StgInt32 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeWord8Arrayzh(a,i,v) ((StgWord8 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeWord16Arrayzh(a,i,v) ((StgWord16 *)(BYTE_ARR_CTS(a)))[i] = (v)
+#define writeWord32Arrayzh(a,i,v) ((StgWord32 *)(BYTE_ARR_CTS(a)))[i] = (v)
#ifdef SUPPORT_LONG_LONGS
#define writeInt64Arrayzh(a,i,v) ((LI_ *)(BYTE_ARR_CTS(a)))[i] = (v)
#define writeWord64Arrayzh(a,i,v) ((LW_ *)(BYTE_ARR_CTS(a)))[i] = (v)
#define indexFloatArrayzh(r,a,i) indexFloatOffAddrzh(r,BYTE_ARR_CTS(a),i)
#define indexDoubleArrayzh(r,a,i) indexDoubleOffAddrzh(r,BYTE_ARR_CTS(a),i)
#define indexStablePtrArrayzh(r,a,i) indexStablePtrOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexInt8Arrayzh(r,a,i) indexInt8OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexInt16Arrayzh(r,a,i) indexInt16OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexInt32Arrayzh(r,a,i) indexInt32OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWord8Arrayzh(r,a,i) indexWord8OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWord16Arrayzh(r,a,i) indexWord16OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWord32Arrayzh(r,a,i) indexWord32OffAddrzh(r,BYTE_ARR_CTS(a),i)
#ifdef SUPPORT_LONG_LONGS
#define indexInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
/* and the out-of-line ones... */
-EXTFUN_RTS(newCharArrayzh_fast);
-EXTFUN_RTS(newIntArrayzh_fast);
-EXTFUN_RTS(newWordArrayzh_fast);
-EXTFUN_RTS(newAddrArrayzh_fast);
-EXTFUN_RTS(newFloatArrayzh_fast);
-EXTFUN_RTS(newDoubleArrayzh_fast);
-EXTFUN_RTS(newStablePtrArrayzh_fast);
+EXTFUN_RTS(newByteArrayzh_fast);
EXTFUN_RTS(newArrayzh_fast);
/* encoding and decoding of floats/doubles. */
#define indexFloatOffForeignObjzh(r,fo,i) indexFloatOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#define indexDoubleOffForeignObjzh(r,fo,i) indexDoubleOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#define indexStablePtrOffForeignObjzh(r,fo,i) indexStablePtrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexInt8OffForeignObjzh(r,fo,i) indexInt8OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexInt16OffForeignObjzh(r,fo,i) indexInt16OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexInt32OffForeignObjzh(r,fo,i) indexInt32OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWord8OffForeignObjzh(r,fo,i) indexWord8OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWord16OffForeignObjzh(r,fo,i) indexWord16OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWord32OffForeignObjzh(r,fo,i) indexWord32OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#ifdef SUPPORT_LONG_LONGS
#define indexInt64OffForeignObjzh(r,fo,i) indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
% -----------------------------------------------------------------------------
-% $Id: PrelArrExtra.lhs,v 1.11 2000/08/29 16:36:23 simonpj Exp $
+% $Id: PrelArrExtra.lhs,v 1.12 2000/12/12 12:19:58 simonmar Exp $
%
% (c) The University of Glasgow, 1994-2000
%
-- only modifies its destination operand, which is already MutableByteArray.
freezeByteArray (MutableByteArray l u arr) = ST $ \ s ->
let n = sizeofMutableByteArray# arr in
- case (newCharArray# n s) of { (# s, newarr #) ->
+ case (newByteArray# n s) of { (# s, newarr #) ->
case ((unsafeCoerce# memcpy) newarr arr n s) of { (# s, () #) ->
case unsafeFreezeByteArray# newarr s of { (# s, frozen #) ->
(# s, ByteArray l u frozen #) }}}
% -----------------------------------------------------------------------------
-% $Id: PrelByteArr.lhs,v 1.8 2000/07/07 11:03:58 simonmar Exp $
+% $Id: PrelByteArr.lhs,v 1.9 2000/12/12 12:19:58 simonmar Exp $
%
% (c) The University of Glasgow, 1994-2000
%
newCharArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
- case (newCharArray# n# s#) of { (# s2#, barr# #) ->
+ case (newByteArray# (cHAR_SCALE n#) s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray l u barr# #) }}
newIntArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
- case (newIntArray# n# s#) of { (# s2#, barr# #) ->
+ case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray l u barr# #) }}
newWordArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
- case (newWordArray# n# s#) of { (# s2#, barr# #) ->
+ case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray l u barr# #) }}
newAddrArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
- case (newAddrArray# n# s#) of { (# s2#, barr# #) ->
+ case (newByteArray# (wORD_SCALE n#) s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray l u barr# #) }}
newFloatArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
- case (newFloatArray# n# s#) of { (# s2#, barr# #) ->
+ case (newByteArray# (fLOAT_SCALE n#) s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray l u barr# #) }}
newDoubleArray (l,u) = ST $ \ s# ->
case rangeSize (l,u) of { I# n# ->
- case (newDoubleArray# n# s#) of { (# s2#, barr# #) ->
+ case (newByteArray# (dOUBLE_SCALE n#) s#) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray l u barr# #) }}
+#include "config.h"
+
+ -- Char arrays really contain only 8-bit bytes for compatibility.
+cHAR_SCALE n = 1# *# n
+wORD_SCALE n = (case SIZEOF_VOID_P :: Int of I# x -> x *# n)
+dOUBLE_SCALE n = (case SIZEOF_DOUBLE :: Int of I# x -> x *# n)
+fLOAT_SCALE n = (case SIZEOF_FLOAT :: Int of I# x -> x *# n)
readCharArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Char
readIntArray :: Ix ix => MutableByteArray s ix -> ix -> ST s Int
sameMutableByteArrayzh
newArrayzh
- newCharArrayzh
- newIntArrayzh
- newWordArrayzh
- newFloatArrayzh
- newDoubleArrayzh
- newAddrArrayzh
- newStablePtrArrayzh
+ newByteArrayzh
indexArrayzh
indexCharArrayzh
indexDoubleArrayzh
indexAddrArrayzh
indexStablePtrArrayzh
+ indexInt8Arrayzh
+ indexInt16Arrayzh
+ indexInt32Arrayzh
indexInt64Arrayzh
+ indexWord8Arrayzh
+ indexWord16Arrayzh
+ indexWord32Arrayzh
indexWord64Arrayzh
-- indexOffAddrzh
indexFloatOffAddrzh
indexDoubleOffAddrzh
indexStablePtrOffAddrzh
+ indexInt8OffAddrzh
+ indexInt16OffAddrzh
+ indexInt32OffAddrzh
indexInt64OffAddrzh
+ indexWord8OffAddrzh
+ indexWord16OffAddrzh
+ indexWord32OffAddrzh
indexWord64OffAddrzh
readCharOffAddrzh
readFloatOffAddrzh
readDoubleOffAddrzh
readStablePtrOffAddrzh
+ readInt8OffAddrzh
+ readInt16OffAddrzh
+ readInt32OffAddrzh
readInt64OffAddrzh
+ readWord8OffAddrzh
+ readWord16OffAddrzh
+ readWord32OffAddrzh
readWord64OffAddrzh
writeCharOffAddrzh
writeFloatOffAddrzh
writeDoubleOffAddrzh
writeStablePtrOffAddrzh
+ writeInt8OffAddrzh
+ writeInt16OffAddrzh
+ writeInt32OffAddrzh
writeInt64OffAddrzh
+ writeWord8OffAddrzh
+ writeWord16OffAddrzh
+ writeWord32OffAddrzh
writeWord64OffAddrzh
-- indexOffForeignObjzh
indexFloatOffForeignObjzh
indexDoubleOffForeignObjzh
indexStablePtrOffForeignObjzh
+ indexInt8OffForeignObjzh
+ indexInt16OffForeignObjzh
+ indexInt32OffForeignObjzh
indexInt64OffForeignObjzh
+ indexWord8OffForeignObjzh
+ indexWord16OffForeignObjzh
+ indexWord32OffForeignObjzh
indexWord64OffForeignObjzh
writeArrayzh
writeDoubleArrayzh
writeAddrArrayzh
writeStablePtrArrayzh
+ writeInt8Arrayzh
+ writeInt16Arrayzh
+ writeInt32Arrayzh
writeInt64Arrayzh
+ writeWord8Arrayzh
+ writeWord16Arrayzh
+ writeWord32Arrayzh
writeWord64Arrayzh
readArrayzh
readDoubleArrayzh
readAddrArrayzh
readStablePtrArrayzh
+ readInt8Arrayzh
+ readInt16Arrayzh
+ readInt32Arrayzh
readInt64Arrayzh
+ readWord8Arrayzh
+ readWord16Arrayzh
+ readWord32Arrayzh
readWord64Arrayzh
unsafeFreezzeArrayzh -- Note zz in the middle
--- /dev/null
+%
+% (c) The University of Glasgow, 2000
+%
+\section[Int]{Module @PrelInt@}
+
+\begin{code}
+module PrelInt
+ (
+ Int8(..), Int16(..), Int32(..), Int64(..)
+
+ , intToInt8 -- :: Int -> Int8
+ , intToInt16 -- :: Int -> Int16
+ , intToInt32 -- :: Int -> Int32
+ , intToInt64 -- :: Int -> Int64
+
+ , integerToInt8 -- :: Integer -> Int8
+ , integerToInt16 -- :: Integer -> Int16
+ , integerToInt32 -- :: Integer -> Int32
+ , integerToInt64 -- :: Integer -> Int64
+
+ , int8ToInt -- :: Int8 -> Int
+ , int8ToInteger -- :: Int8 -> Integer
+ , int8ToInt16 -- :: Int8 -> Int16
+ , int8ToInt32 -- :: Int8 -> Int32
+ , int8ToInt64 -- :: Int8 -> Int64
+
+ , int16ToInt -- :: Int16 -> Int
+ , int16ToInteger -- :: Int16 -> Integer
+ , int16ToInt8 -- :: Int16 -> Int8
+ , int16ToInt32 -- :: Int16 -> Int32
+ , int16ToInt64 -- :: Int16 -> Int64
+
+ , int32ToInt -- :: Int32 -> Int
+ , int32ToInteger -- :: Int32 -> Integer
+ , int32ToInt8 -- :: Int32 -> Int8
+ , int32ToInt16 -- :: Int32 -> Int16
+ , int32ToInt64 -- :: Int32 -> Int64
+
+ , int64ToInt -- :: Int64 -> Int
+ , int64ToInteger -- :: Int64 -> Integer
+ , int64ToInt8 -- :: Int64 -> Int8
+ , int64ToInt16 -- :: Int64 -> Int16
+ , int64ToInt32 -- :: Int64 -> Int32
+
+ -- The "official" place to get these from is Addr, importing
+ -- them from Int is a non-standard thing to do.
+ -- SUP: deprecated in the new FFI, subsumed by the Storable class
+ , indexInt8OffAddr
+ , indexInt16OffAddr
+ , indexInt32OffAddr
+ , indexInt64OffAddr
+
+ , readInt8OffAddr
+ , readInt16OffAddr
+ , readInt32OffAddr
+ , readInt64OffAddr
+
+ , writeInt8OffAddr
+ , writeInt16OffAddr
+ , writeInt32OffAddr
+ , writeInt64OffAddr
+
+ -- internal stuff
+ , intToInt8#, i8ToInt#, intToInt16#, i16ToInt#, intToInt32#, i32ToInt#,
+ , intToInt64#, plusInt64#, minusInt64#, negateInt64#
+ ) where
+
+import PrelWord
+import PrelArr
+import PrelRead
+import PrelIOBase
+import PrelAddr
+import PrelReal
+import PrelNum
+import PrelBase
+
+-- ---------------------------------------------------------------------------
+-- Coercion functions (DEPRECATED)
+-- ---------------------------------------------------------------------------
+
+intToInt8 :: Int -> Int8
+intToInt16 :: Int -> Int16
+intToInt32 :: Int -> Int32
+intToInt64 :: Int -> Int64
+
+integerToInt8 :: Integer -> Int8
+integerToInt16 :: Integer -> Int16
+integerToInt32 :: Integer -> Int32
+integerToInt64 :: Integer -> Int64
+
+int8ToInt :: Int8 -> Int
+int8ToInteger :: Int8 -> Integer
+int8ToInt16 :: Int8 -> Int16
+int8ToInt32 :: Int8 -> Int32
+int8ToInt64 :: Int8 -> Int64
+
+int16ToInt :: Int16 -> Int
+int16ToInteger :: Int16 -> Integer
+int16ToInt8 :: Int16 -> Int8
+int16ToInt32 :: Int16 -> Int32
+int16ToInt64 :: Int16 -> Int64
+
+int32ToInt :: Int32 -> Int
+int32ToInteger :: Int32 -> Integer
+int32ToInt8 :: Int32 -> Int8
+int32ToInt16 :: Int32 -> Int16
+int32ToInt64 :: Int32 -> Int64
+
+int64ToInt :: Int64 -> Int
+int64ToInteger :: Int64 -> Integer
+int64ToInt8 :: Int64 -> Int8
+int64ToInt16 :: Int64 -> Int16
+int64ToInt32 :: Int64 -> Int32
+
+integerToInt8 = fromInteger
+integerToInt16 = fromInteger
+integerToInt32 = fromInteger
+
+int8ToInt16 (I8# x) = I16# x
+int8ToInt32 (I8# x) = I32# x
+
+int16ToInt8 (I16# x) = I8# x
+int16ToInt32 (I16# x) = I32# x
+
+int32ToInt8 (I32# x) = I8# x
+int32ToInt16 (I32# x) = I16# x
+
+int8ToInteger = toInteger
+int8ToInt64 = int32ToInt64 . int8ToInt32
+
+int16ToInteger = toInteger
+int16ToInt64 = int32ToInt64 . int16ToInt32
+
+int32ToInteger = toInteger
+
+int64ToInt8 = int32ToInt8 . int64ToInt32
+int64ToInt16 = int32ToInt16 . int64ToInt32
+
+-----------------------------------------------------------------------------
+-- The following rules for fromIntegral remove the need to export specialized
+-- conversion functions.
+-----------------------------------------------------------------------------
+
+{-# RULES
+ "fromIntegral/Int->Int8" fromIntegral = intToInt8;
+ "fromIntegral/Int->Int16" fromIntegral = intToInt16;
+ "fromIntegral/Int->Int32" fromIntegral = intToInt32;
+ "fromIntegral/Int->Int64" fromIntegral = intToInt64;
+
+ "fromIntegral/Integer->Int8" fromIntegral = integerToInt8;
+ "fromIntegral/Integer->Int16" fromIntegral = integerToInt16;
+ "fromIntegral/Integer->Int32" fromIntegral = integerToInt32;
+ "fromIntegral/Integer->Int64" fromIntegral = integerToInt64;
+
+ "fromIntegral/Int8->Int" fromIntegral = int8ToInt;
+ "fromIntegral/Int8->Integer" fromIntegral = int8ToInteger;
+ "fromIntegral/Int8->Int16" fromIntegral = int8ToInt16;
+ "fromIntegral/Int8->Int32" fromIntegral = int8ToInt32;
+ "fromIntegral/Int8->Int64" fromIntegral = int8ToInt64;
+
+ "fromIntegral/Int16->Int" fromIntegral = int16ToInt;
+ "fromIntegral/Int16->Integer" fromIntegral = int16ToInteger;
+ "fromIntegral/Int16->Int8" fromIntegral = int16ToInt8;
+ "fromIntegral/Int16->Int32" fromIntegral = int16ToInt32;
+ "fromIntegral/Int16->Int64" fromIntegral = int16ToInt64;
+
+ "fromIntegral/Int32->Int" fromIntegral = int32ToInt;
+ "fromIntegral/Int32->Integer" fromIntegral = int32ToInteger;
+ "fromIntegral/Int32->Int8" fromIntegral = int32ToInt8;
+ "fromIntegral/Int32->Int16" fromIntegral = int32ToInt16;
+ "fromIntegral/Int32->Int64" fromIntegral = int32ToInt64;
+
+ "fromIntegral/Int64->Int" fromIntegral = int64ToInt;
+ "fromIntegral/Int64->Integer" fromIntegral = int64ToInteger;
+ "fromIntegral/Int64->Int8" fromIntegral = int64ToInt8;
+ "fromIntegral/Int64->Int16" fromIntegral = int64ToInt16;
+ "fromIntegral/Int64->Int32" fromIntegral = int64ToInt32
+ #-}
+
+-- -----------------------------------------------------------------------------
+-- Int8
+-- -----------------------------------------------------------------------------
+
+data Int8 = I8# Int#
+
+instance CCallable Int8
+instance CReturnable Int8
+
+int8ToInt (I8# x) = I# (i8ToInt# x)
+
+i8ToInt# :: Int# -> Int#
+i8ToInt# x = if x' <=# 0x7f# then x' else x' -# 0x100#
+ where x' = word2Int# (int2Word# x `and#` int2Word# 0xff#)
+
+-- This doesn't perform any bounds checking on the value it is passed,
+-- nor its sign, i.e., show (intToInt8 511) => "-1"
+intToInt8 (I# x) = I8# (intToInt8# x)
+
+intToInt8# :: Int# -> Int#
+intToInt8# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xff#)
+
+instance Eq Int8 where
+ (I8# x#) == (I8# y#) = x# ==# y#
+ (I8# x#) /= (I8# y#) = x# /=# y#
+
+instance Ord Int8 where
+ compare (I8# x#) (I8# y#) = compareInt# (i8ToInt# x#) (i8ToInt# y#)
+
+compareInt# :: Int# -> Int# -> Ordering
+compareInt# x# y#
+ | x# <# y# = LT
+ | x# ==# y# = EQ
+ | otherwise = GT
+
+instance Num Int8 where
+ (I8# x#) + (I8# y#) = I8# (intToInt8# (x# +# y#))
+ (I8# x#) - (I8# y#) = I8# (intToInt8# (x# -# y#))
+ (I8# x#) * (I8# y#) = I8# (intToInt8# (x# *# y#))
+ negate i@(I8# x#) =
+ if x# ==# 0#
+ then i
+ else I8# (0x100# -# x#)
+
+ abs = absReal
+ signum = signumReal
+ fromInteger (S# i#) = I8# (intToInt8# i#)
+ fromInteger (J# s# d#) = I8# (intToInt8# (integer2Int# s# d#))
+ fromInt = intToInt8
+
+instance Bounded Int8 where
+ minBound = 0x80
+ maxBound = 0x7f
+
+instance Real Int8 where
+ toRational x = toInteger x % 1
+
+instance Integral Int8 where
+ div x y
+ | x > 0 && y < 0 = quotInt8 (x-y-1) y
+ | x < 0 && y > 0 = quotInt8 (x-y+1) y
+ | otherwise = quotInt8 x y
+ quot x@(I8# _) y@(I8# y#)
+ | y# /=# 0# = x `quotInt8` y
+ | otherwise = divZeroError "quot{Int8}" x
+ rem x@(I8# _) y@(I8# y#)
+ | y# /=# 0# = x `remInt8` y
+ | otherwise = divZeroError "rem{Int8}" x
+ mod x y
+ | x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
+ | otherwise = r
+ where r = remInt8 x y
+
+ a@(I8# _) `quotRem` b@(I8# _) = (a `quotInt8` b, a `remInt8` b)
+ toInteger i8 = toInteger (int8ToInt i8)
+ toInt i8 = int8ToInt i8
+
+
+remInt8, quotInt8 :: Int8 -> Int8 -> Int8
+remInt8 (I8# x) (I8# y) = I8# (intToInt8# ((i8ToInt# x) `remInt#` (i8ToInt# y)))
+quotInt8 (I8# x) (I8# y) = I8# (intToInt8# ((i8ToInt# x) `quotInt#` (i8ToInt# y)))
+
+instance Ix Int8 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = int8ToInt (i - m)
+ | otherwise = indexError b i "Int8"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Enum Int8 where
+ succ i
+ | i == maxBound = succError "Int8"
+ | otherwise = i+1
+ pred i
+ | i == minBound = predError "Int8"
+ | otherwise = i-1
+
+ toEnum x
+ | x >= toInt (minBound::Int8) && x <= toInt (maxBound::Int8)
+ = intToInt8 x
+ | otherwise
+ = toEnumError "Int8" x (minBound::Int8,maxBound::Int8)
+
+ fromEnum = int8ToInt
+ enumFrom e1 = map toEnum [fromEnum e1 .. fromEnum (maxBound::Int8)]
+ enumFromThen e1 e2 =
+ map toEnum [fromEnum e1, fromEnum e2 .. fromEnum (last::Int8)]
+ where
+ last
+ | e2 < e1 = minBound
+ | otherwise = maxBound
+
+instance Read Int8 where
+ readsPrec p s = [ (intToInt8 x,r) | (x,r) <- readsPrec p s ]
+
+instance Show Int8 where
+ showsPrec p i8 = showsPrec p (int8ToInt i8)
+
+-- -----------------------------------------------------------------------------
+-- Int16
+-- -----------------------------------------------------------------------------
+
+data Int16 = I16# Int#
+
+instance CCallable Int16
+instance CReturnable Int16
+
+int16ToInt (I16# x) = I# (i16ToInt# x)
+
+i16ToInt# :: Int# -> Int#
+i16ToInt# x = if x' <=# 0x7fff# then x' else x' -# 0x10000#
+ where x' = word2Int# (int2Word# x `and#` int2Word# 0xffff#)
+
+-- This doesn't perform any bounds checking on the value it is passed,
+-- nor its sign, i.e., show (intToInt8 131071) => "-1"
+intToInt16 (I# x) = I16# (intToInt16# x)
+
+intToInt16# :: Int# -> Int#
+intToInt16# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xffff#)
+
+instance Eq Int16 where
+ (I16# x#) == (I16# y#) = x# ==# y#
+ (I16# x#) /= (I16# y#) = x# /=# y#
+
+instance Ord Int16 where
+ compare (I16# x#) (I16# y#) = compareInt# (i16ToInt# x#) (i16ToInt# y#)
+
+instance Num Int16 where
+ (I16# x#) + (I16# y#) = I16# (intToInt16# (x# +# y#))
+ (I16# x#) - (I16# y#) = I16# (intToInt16# (x# -# y#))
+ (I16# x#) * (I16# y#) = I16# (intToInt16# (x# *# y#))
+ negate i@(I16# x#) =
+ if x# ==# 0#
+ then i
+ else I16# (0x10000# -# x#)
+ abs = absReal
+ signum = signumReal
+ fromInteger (S# i#) = I16# (intToInt16# i#)
+ fromInteger (J# s# d#) = I16# (intToInt16# (integer2Int# s# d#))
+ fromInt = intToInt16
+
+instance Bounded Int16 where
+ minBound = 0x8000
+ maxBound = 0x7fff
+
+instance Real Int16 where
+ toRational x = toInteger x % 1
+
+instance Integral Int16 where
+ div x y
+ | x > 0 && y < 0 = quotInt16 (x-y-1) y
+ | x < 0 && y > 0 = quotInt16 (x-y+1) y
+ | otherwise = quotInt16 x y
+ quot x@(I16# _) y@(I16# y#)
+ | y# /=# 0# = x `quotInt16` y
+ | otherwise = divZeroError "quot{Int16}" x
+ rem x@(I16# _) y@(I16# y#)
+ | y# /=# 0# = x `remInt16` y
+ | otherwise = divZeroError "rem{Int16}" x
+ mod x y
+ | x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
+ | otherwise = r
+ where r = remInt16 x y
+
+ a@(I16# _) `quotRem` b@(I16# _) = (a `quotInt16` b, a `remInt16` b)
+ toInteger i16 = toInteger (int16ToInt i16)
+ toInt i16 = int16ToInt i16
+
+remInt16, quotInt16 :: Int16 -> Int16 -> Int16
+remInt16 (I16# x) (I16# y) = I16# (intToInt16# ((i16ToInt# x) `remInt#` (i16ToInt# y)))
+quotInt16 (I16# x) (I16# y) = I16# (intToInt16# ((i16ToInt# x) `quotInt#` (i16ToInt# y)))
+
+instance Ix Int16 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = int16ToInt (i - m)
+ | otherwise = indexError b i "Int16"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Enum Int16 where
+ succ i
+ | i == maxBound = succError "Int16"
+ | otherwise = i+1
+
+ pred i
+ | i == minBound = predError "Int16"
+ | otherwise = i-1
+
+ toEnum x
+ | x >= toInt (minBound::Int16) && x <= toInt (maxBound::Int16)
+ = intToInt16 x
+ | otherwise
+ = toEnumError "Int16" x (minBound::Int16, maxBound::Int16)
+
+ fromEnum = int16ToInt
+
+ enumFrom e1 = map toEnum [fromEnum e1 .. fromEnum (maxBound::Int16)]
+ enumFromThen e1 e2 = map toEnum [fromEnum e1, fromEnum e2 .. fromEnum (last::Int16)]
+ where last
+ | e2 < e1 = minBound
+ | otherwise = maxBound
+
+instance Read Int16 where
+ readsPrec p s = [ (intToInt16 x,r) | (x,r) <- readsPrec p s ]
+
+instance Show Int16 where
+ showsPrec p i16 = showsPrec p (int16ToInt i16)
+
+-- -----------------------------------------------------------------------------
+-- Int32
+-- -----------------------------------------------------------------------------
+
+data Int32 = I32# Int#
+
+instance CCallable Int32
+instance CReturnable Int32
+
+int32ToInt (I32# x) = I# (i32ToInt# x)
+
+i32ToInt# :: Int# -> Int#
+#if WORD_SIZE_IN_BYTES > 4
+i32ToInt# x = if x' <=# 0x7fffffff# then x' else x' -# 0x100000000#
+ where x' = word2Int# (int2Word# x `and#` int2Word# 0xffffffff#)
+#else
+i32ToInt# x = x
+#endif
+
+intToInt32 (I# x) = I32# (intToInt32# x)
+
+intToInt32# :: Int# -> Int#
+#if WORD_SIZE_IN_BYTES > 4
+intToInt32# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xffffffff#)
+#else
+intToInt32# i# = i#
+#endif
+
+instance Eq Int32 where
+ (I32# x#) == (I32# y#) = x# ==# y#
+ (I32# x#) /= (I32# y#) = x# /=# y#
+
+instance Ord Int32 where
+ compare (I32# x#) (I32# y#) = compareInt# (i32ToInt# x#) (i32ToInt# y#)
+
+instance Num Int32 where
+ (I32# x#) + (I32# y#) = I32# (intToInt32# (x# +# y#))
+ (I32# x#) - (I32# y#) = I32# (intToInt32# (x# -# y#))
+ (I32# x#) * (I32# y#) = I32# (intToInt32# (x# *# y#))
+#if WORD_SIZE_IN_BYTES > 4
+ negate i@(I32# x) =
+ if x ==# 0#
+ then i
+ else I32# (intToInt32# (0x100000000# -# x'))
+#else
+ negate (I32# x) = I32# (negateInt# x)
+#endif
+ abs = absReal
+ signum = signumReal
+ fromInteger (S# i#) = I32# (intToInt32# i#)
+ fromInteger (J# s# d#) = I32# (intToInt32# (integer2Int# s# d#))
+ fromInt = intToInt32
+
+
+instance Bounded Int32 where
+ minBound = fromInt minBound
+ maxBound = fromInt maxBound
+
+instance Real Int32 where
+ toRational x = toInteger x % 1
+
+instance Integral Int32 where
+ div x y
+ | x > 0 && y < 0 = quotInt32 (x-y-1) y
+ | x < 0 && y > 0 = quotInt32 (x-y+1) y
+ | otherwise = quotInt32 x y
+ quot x@(I32# _) y@(I32# y#)
+ | y# /=# 0# = x `quotInt32` y
+ | otherwise = divZeroError "quot{Int32}" x
+ rem x@(I32# _) y@(I32# y#)
+ | y# /=# 0# = x `remInt32` y
+ | otherwise = divZeroError "rem{Int32}" x
+ mod x y
+ | x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
+ | otherwise = r
+ where r = remInt32 x y
+
+ a@(I32# _) `quotRem` b@(I32# _) = (a `quotInt32` b, a `remInt32` b)
+ toInteger i32 = toInteger (int32ToInt i32)
+ toInt i32 = int32ToInt i32
+
+remInt32, quotInt32 :: Int32 -> Int32 -> Int32
+remInt32 (I32# x) (I32# y) = I32# (intToInt32# ((i32ToInt# x) `remInt#` (i32ToInt# y)))
+quotInt32 (I32# x) (I32# y) = I32# (intToInt32# ((i32ToInt# x) `quotInt#` (i32ToInt# y)))
+
+instance Ix Int32 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = int32ToInt (i - m)
+ | otherwise = indexError b i "Int32"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Enum Int32 where
+ succ i
+ | i == maxBound = succError "Int32"
+ | otherwise = i+1
+
+ pred i
+ | i == minBound = predError "Int32"
+ | otherwise = i-1
+
+ toEnum x
+ -- with Int having the same range as Int32, the following test
+ -- shouldn't fail. However, having it here
+ | x >= toInt (minBound::Int32) && x <= toInt (maxBound::Int32)
+ = intToInt32 x
+ | otherwise
+ = toEnumError "Int32" x (minBound::Int32, maxBound::Int32)
+
+ fromEnum = int32ToInt
+
+ enumFrom e1 = map toEnum [fromEnum e1 .. fromEnum (maxBound::Int32)]
+ enumFromThen e1 e2 = map toEnum [fromEnum e1, fromEnum e2 .. fromEnum (last::Int32)]
+ where
+ last
+ | e2 < e1 = minBound
+ | otherwise = maxBound
+
+
+instance Read Int32 where
+ readsPrec p s = [ (intToInt32 x,r) | (x,r) <- readsPrec p s ]
+
+instance Show Int32 where
+ showsPrec p i32 = showsPrec p (int32ToInt i32)
+
+-- -----------------------------------------------------------------------------
+-- Int64
+-- -----------------------------------------------------------------------------
+
+#if WORD_SIZE_IN_BYTES == 8
+
+--data Int64 = I64# Int#
+
+int32ToInt64 (I32# i#) = I64# i#
+
+intToInt32# :: Int# -> Int#
+intToInt32# i# = word2Int# ((int2Word# i#) `and#` (case (maxBound::Word32) of W# x# -> x#))
+
+int64ToInt32 (I64# i#) = I32# (intToInt32# w#)
+
+instance Eq Int64 where
+ (I64# x) == (I64# y) = x `eqInt#` y
+ (I64# x) /= (I64# y) = x `neInt#` y
+
+instance Ord Int32 where
+ compare (I64# x#) (I64# y#) = compareInt# x# y#
+
+instance Num Int64 where
+ (I64# x) + (I64# y) = I64# (x +# y)
+ (I64# x) - (I64# y) = I64# (x -# y)
+ (I64# x) * (I64# y) = I64# (x *# y)
+ negate w@(I64# x) = I64# (negateInt# x)
+ abs x = absReal
+ signum = signumReal
+ fromInteger (S# i#) = I64# i#
+ fromInteger (J# s# d#) = I64# (integer2Int# s# d#)
+ fromInt = intToInt64
+
+instance Bounded Int64 where
+ minBound = integerToInt64 (-0x8000000000000000)
+ maxBound = integerToInt64 0x7fffffffffffffff
+
+instance Integral Int64 where
+ div x y
+ | x > 0 && y < 0 = quotInt64 (x-y-1) y
+ | x < 0 && y > 0 = quotInt64 (x-y+1) y
+ | otherwise = quotInt64 x y
+
+ quot x@(I64# _) y@(I64# y#)
+ | y# /=# 0# = x `quotInt64` y
+ | otherwise = divZeroError "quot{Int64}" x
+
+ rem x@(I64# _) y@(I64# y#)
+ | y# /=# 0# = x `remInt64` y
+ | otherwise = divZeroError "rem{Int64}" x
+
+ mod x y
+ | x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
+ | otherwise = r
+ where r = remInt64 x y
+
+ a@(I64# _) `quotRem` b@(I64# _) = (a `quotInt64` b, a `remInt64` b)
+ toInteger (I64# i#) = toInteger (I# i#)
+ toInt (I64# i#) = I# i#
+
+remInt64 (I64# x) (I64# y) = I64# (x `remInt#` y)
+quotInt64 (I64# x) (I64# y) = I64# (x `quotInt#` y)
+
+int64ToInteger (I64# i#) = toInteger (I# i#)
+integerToInt64 i = case fromInteger i of { I# i# -> I64# i# }
+
+intToInt64 (I# i#) = I64# i#
+int64ToInt (I64# i#) = I# i#
+
+#else
+--assume: support for long-longs
+--data Int64 = I64 Int64# deriving (Eq, Ord, Bounded)
+
+int32ToInt64 (I32# i#) = I64# (intToInt64# i#)
+int64ToInt32 (I64# i#) = I32# (int64ToInt# i#)
+
+int64ToInteger (I64# x#) =
+ case int64ToInteger# x# of
+ (# s#, p# #) -> J# s# p#
+
+integerToInt64 (S# i#) = I64# (intToInt64# i#)
+integerToInt64 (J# s# d#) = I64# (integerToInt64# s# d#)
+
+instance Eq Int64 where
+ (I64# x) == (I64# y) = x `eqInt64#` y
+ (I64# x) /= (I64# y) = x `neInt64#` y
+
+instance Ord Int64 where
+ compare (I64# x) (I64# y) = compareInt64# x y
+ (<) (I64# x) (I64# y) = x `ltInt64#` y
+ (<=) (I64# x) (I64# y) = x `leInt64#` y
+ (>=) (I64# x) (I64# y) = x `geInt64#` y
+ (>) (I64# x) (I64# y) = x `gtInt64#` y
+ max x@(I64# x#) y@(I64# y#) =
+ case (compareInt64# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
+ min x@(I64# x#) y@(I64# y#) =
+ case (compareInt64# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
+
+instance Num Int64 where
+ (I64# x) + (I64# y) = I64# (x `plusInt64#` y)
+ (I64# x) - (I64# y) = I64# (x `minusInt64#` y)
+ (I64# x) * (I64# y) = I64# (x `timesInt64#` y)
+ negate (I64# x) = I64# (negateInt64# x)
+ abs x = absReal x
+ signum = signumReal
+ fromInteger i = integerToInt64 i
+ fromInt i = intToInt64 i
+
+compareInt64# :: Int64# -> Int64# -> Ordering
+compareInt64# i# j#
+ | i# `ltInt64#` j# = LT
+ | i# `eqInt64#` j# = EQ
+ | otherwise = GT
+
+instance Bounded Int64 where
+ minBound = integerToInt64 (-0x8000000000000000)
+ maxBound = integerToInt64 0x7fffffffffffffff
+
+instance Integral Int64 where
+ div x y
+ | x > 0 && y < 0 = quotInt64 (x-y-1) y
+ | x < 0 && y > 0 = quotInt64 (x-y+1) y
+ | otherwise = quotInt64 x y
+
+ quot x@(I64# _) y@(I64# y#)
+ | y# `neInt64#` (intToInt64# 0#) = x `quotInt64` y
+ | otherwise = divZeroError "quot{Int64}" x
+
+ rem x@(I64# _) y@(I64# y#)
+ | y# `neInt64#` (intToInt64# 0#) = x `remInt64` y
+ | otherwise = divZeroError "rem{Int64}" x
+
+ mod x y
+ | x > 0 && y < 0 || x < 0 && y > 0 = if r/=0 then r+y else 0
+ | otherwise = r
+ where r = remInt64 x y
+
+ a@(I64# _) `quotRem` b@(I64# _) = (a `quotInt64` b, a `remInt64` b)
+ toInteger i = int64ToInteger i
+ toInt i = int64ToInt i
+
+remInt64, quotInt64 :: Int64 -> Int64 -> Int64
+remInt64 (I64# x) (I64# y) = I64# (x `remInt64#` y)
+quotInt64 (I64# x) (I64# y) = I64# (x `quotInt64#` y)
+
+intToInt64 (I# i#) = I64# (intToInt64# i#)
+int64ToInt (I64# i#) = I# (int64ToInt# i#)
+
+-- Word64# primop wrappers:
+
+ltInt64# :: Int64# -> Int64# -> Bool
+ltInt64# x# y# = stg_ltInt64 x# y# /= 0
+
+leInt64# :: Int64# -> Int64# -> Bool
+leInt64# x# y# = stg_leInt64 x# y# /= 0
+
+eqInt64# :: Int64# -> Int64# -> Bool
+eqInt64# x# y# = stg_eqInt64 x# y# /= 0
+
+neInt64# :: Int64# -> Int64# -> Bool
+neInt64# x# y# = stg_neInt64 x# y# /= 0
+
+geInt64# :: Int64# -> Int64# -> Bool
+geInt64# x# y# = stg_geInt64 x# y# /= 0
+
+gtInt64# :: Int64# -> Int64# -> Bool
+gtInt64# x# y# = stg_gtInt64 x# y# /= 0
+
+plusInt64# :: Int64# -> Int64# -> Int64#
+plusInt64# a# b# = case stg_plusInt64 a# b# of { I64# i# -> i# }
+
+minusInt64# :: Int64# -> Int64# -> Int64#
+minusInt64# a# b# = case stg_minusInt64 a# b# of { I64# i# -> i# }
+
+timesInt64# :: Int64# -> Int64# -> Int64#
+timesInt64# a# b# = case stg_timesInt64 a# b# of { I64# i# -> i# }
+
+quotInt64# :: Int64# -> Int64# -> Int64#
+quotInt64# a# b# = case stg_quotInt64 a# b# of { I64# i# -> i# }
+
+remInt64# :: Int64# -> Int64# -> Int64#
+remInt64# a# b# = case stg_remInt64 a# b# of { I64# i# -> i# }
+
+negateInt64# :: Int64# -> Int64#
+negateInt64# a# = case stg_negateInt64 a# of { I64# i# -> i# }
+
+int64ToInt# :: Int64# -> Int#
+int64ToInt# i64# = case stg_int64ToInt i64# of { I# i# -> i# }
+
+intToInt64# :: Int# -> Int64#
+intToInt64# i# = case stg_intToInt64 i# of { I64# i64# -> i64# }
+
+foreign import "stg_intToInt64" unsafe stg_intToInt64 :: Int# -> Int64
+foreign import "stg_int64ToInt" unsafe stg_int64ToInt :: Int64# -> Int
+foreign import "stg_negateInt64" unsafe stg_negateInt64 :: Int64# -> Int64
+foreign import "stg_remInt64" unsafe stg_remInt64 :: Int64# -> Int64# -> Int64
+foreign import "stg_quotInt64" unsafe stg_quotInt64 :: Int64# -> Int64# -> Int64
+foreign import "stg_timesInt64" unsafe stg_timesInt64 :: Int64# -> Int64# -> Int64
+foreign import "stg_minusInt64" unsafe stg_minusInt64 :: Int64# -> Int64# -> Int64
+foreign import "stg_plusInt64" unsafe stg_plusInt64 :: Int64# -> Int64# -> Int64
+foreign import "stg_gtInt64" unsafe stg_gtInt64 :: Int64# -> Int64# -> Int
+foreign import "stg_geInt64" unsafe stg_geInt64 :: Int64# -> Int64# -> Int
+foreign import "stg_neInt64" unsafe stg_neInt64 :: Int64# -> Int64# -> Int
+foreign import "stg_eqInt64" unsafe stg_eqInt64 :: Int64# -> Int64# -> Int
+foreign import "stg_leInt64" unsafe stg_leInt64 :: Int64# -> Int64# -> Int
+foreign import "stg_ltInt64" unsafe stg_ltInt64 :: Int64# -> Int64# -> Int
+
+#endif
+
+--
+-- Code that's independent of Int64 rep.
+--
+instance Enum Int64 where
+ succ i
+ | i == maxBound = succError "Int64"
+ | otherwise = i+1
+
+ pred i
+ | i == minBound = predError "Int64"
+ | otherwise = i-1
+
+ toEnum i = intToInt64 i
+ fromEnum x
+ | x >= intToInt64 (minBound::Int) && x <= intToInt64 (maxBound::Int)
+ = int64ToInt x
+ | otherwise
+ = fromEnumError "Int64" x
+
+ enumFrom e1 = map integerToInt64 [int64ToInteger e1 .. int64ToInteger (maxBound::Int64)]
+ enumFromTo e1 e2 = map integerToInt64 [int64ToInteger e1 .. int64ToInteger e2]
+ enumFromThen e1 e2 = map integerToInt64 [int64ToInteger e1, int64ToInteger e2 .. int64ToInteger last]
+ where
+ last :: Int64
+ last
+ | e2 < e1 = minBound
+ | otherwise = maxBound
+
+ enumFromThenTo e1 e2 e3 = map integerToInt64 [int64ToInteger e1, int64ToInteger e2 .. int64ToInteger e3]
+
+instance Show Int64 where
+ showsPrec p i64 = showsPrec p (int64ToInteger i64)
+
+instance Read Int64 where
+ readsPrec _ s = [ (integerToInt64 x,r) | (x,r) <- readDec s ]
+
+instance Ix Int64 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = int64ToInt (i-m)
+ | otherwise = indexError b i "Int64"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Real Int64 where
+ toRational x = toInteger x % 1
+
+-- ---------------------------------------------------------------------------
+-- Reading/writing Ints from memory
+-- ---------------------------------------------------------------------------
+
+indexInt8OffAddr :: Addr -> Int -> Int8
+indexInt8OffAddr (A# a#) (I# i#) = I8# (indexInt8OffAddr# a# i#)
+
+indexInt16OffAddr :: Addr -> Int -> Int16
+indexInt16OffAddr (A# a#) (I# i#) = I16# (indexInt16OffAddr# a# i#)
+
+indexInt32OffAddr :: Addr -> Int -> Int32
+indexInt32OffAddr (A# a#) (I# i#) = I32# (indexInt32OffAddr# a# i#)
+
+indexInt64OffAddr :: Addr -> Int -> Int64
+#if WORD_SIZE_IN_BYTES==8
+indexInt64OffAddr (A# a#) (I# i#) = I64# (indexIntOffAddr# a# i#)
+#else
+indexInt64OffAddr (A# a#) (I# i#) = I64# (indexInt64OffAddr# a# i#)
+#endif
+
+
+readInt8OffAddr :: Addr -> Int -> IO Int8
+readInt8OffAddr (A# a) (I# i)
+ = IO $ \s -> case readInt8OffAddr# a i s of (# s, w #) -> (# s, I8# w #)
+
+readInt16OffAddr :: Addr -> Int -> IO Int16
+readInt16OffAddr (A# a) (I# i)
+ = IO $ \s -> case readInt16OffAddr# a i s of (# s, w #) -> (# s, I16# w #)
+
+readInt32OffAddr :: Addr -> Int -> IO Int32
+readInt32OffAddr (A# a) (I# i)
+ = IO $ \s -> case readInt32OffAddr# a i s of (# s, w #) -> (# s, I32# w #)
+
+readInt64OffAddr :: Addr -> Int -> IO Int64
+#if WORD_SIZE_IN_BYTES == 8
+readInt64OffAddr (A# a) (I# i)
+ = IO $ \s -> case readIntOffAddr# a i s of (# s, w #) -> (# s, I64# w #)
+#else
+readInt64OffAddr (A# a) (I# i)
+ = IO $ \s -> case readInt64OffAddr# a i s of (# s, w #) -> (# s, I64# w #)
+#endif
+
+
+writeInt8OffAddr :: Addr -> Int -> Int8 -> IO ()
+writeInt8OffAddr (A# a#) (I# i#) (I8# w#) = IO $ \ s# ->
+ case (writeInt8OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+
+writeInt16OffAddr :: Addr -> Int -> Int16 -> IO ()
+writeInt16OffAddr (A# a#) (I# i#) (I16# w#) = IO $ \ s# ->
+ case (writeInt16OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+
+writeInt32OffAddr :: Addr -> Int -> Int32 -> IO ()
+writeInt32OffAddr (A# a#) (I# i#) (I32# w#) = IO $ \ s# ->
+ case (writeInt32OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+
+writeInt64OffAddr :: Addr -> Int -> Int64 -> IO ()
+#if WORD_SIZE_IN_BYTES == 8
+writeInt64OffAddr (A# a#) (I# i#) (I64# w#) = IO $ \ s# ->
+ case (writeIntOffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+#else
+writeInt64OffAddr (A# a#) (I# i#) (I64# w#) = IO $ \ s# ->
+ case (writeInt64OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+#endif
+\end{code}
+
+Miscellaneous Utilities
+
+\begin{code}
+absReal :: (Ord a, Num a) => a -> a
+absReal x | x >= 0 = x
+ | otherwise = -x
+
+signumReal :: (Ord a, Num a) => a -> a
+signumReal x | x == 0 = 0
+ | x > 0 = 1
+ | otherwise = -1
+\end{code}
% ------------------------------------------------------------------------------
-% $Id: PrelPack.lhs,v 1.14 2000/07/07 11:03:58 simonmar Exp $
+% $Id: PrelPack.lhs,v 1.15 2000/12/12 12:19:58 simonmar Exp $
%
% (c) The University of Glasgow, 1997-2000
%
freeze_ps_array :: MutableByteArray s Int -> Int# -> ST s (ByteArray Int)
new_ps_array size = ST $ \ s ->
- case (newCharArray# size s) of { (# s2#, barr# #) ->
+ case (newByteArray# size s) of { (# s2#, barr# #) ->
(# s2#, MutableByteArray bot bot barr# #) }
where
bot = error "new_ps_array"
--- /dev/null
+%
+% (c) The University of Glasgow, 1997-2000
+%
+\section[PrelWord]{Module @PrelWord@}
+
+\begin{code}
+#include "MachDeps.h"
+
+module PrelWord (
+ Word8(..), Word16(..), Word32(..), Word64(..),
+
+ -- SUP: deprecated in the new FFI, subsumed by fromIntegral
+ , intToWord8 -- :: Int -> Word8
+ , intToWord16 -- :: Int -> Word16
+ , intToWord32 -- :: Int -> Word32
+ , intToWord64 -- :: Int -> Word64
+
+ , integerToWord8 -- :: Integer -> Word8
+ , integerToWord16 -- :: Integer -> Word16
+ , integerToWord32 -- :: Integer -> Word32
+ , integerToWord64 -- :: Integer -> Word64
+
+ , word8ToInt -- :: Word8 -> Int
+ , word8ToInteger -- :: Word8 -> Integer
+ , word8ToWord16 -- :: Word8 -> Word16
+ , word8ToWord32 -- :: Word8 -> Word32
+ , word8ToWord64 -- :: Word8 -> Word64
+
+ , word16ToInt -- :: Word16 -> Int
+ , word16ToInteger -- :: Word16 -> Integer
+ , word16ToWord8 -- :: Word16 -> Word8
+ , word16ToWord32 -- :: Word16 -> Word32
+ , word16ToWord64 -- :: Word16 -> Word64
+
+ , word32ToInt -- :: Word32 -> Int
+ , word32ToInteger -- :: Word32 -> Integer
+ , word32ToWord8 -- :: Word32 -> Word8
+ , word32ToWord16 -- :: Word32 -> Word16
+ , word32ToWord64 -- :: Word32 -> Word64
+
+ , word64ToInt -- :: Word64 -> Int
+ , word64ToInteger -- :: Word64 -> Integer
+ , word64ToWord8 -- :: Word64 -> Word8
+ , word64ToWord16 -- :: Word64 -> Word16
+ , word64ToWord32 -- :: Word64 -> Word32
+
+ -- NB! GHC SPECIFIC:
+ , wordToWord8 -- :: Word -> Word8
+ , wordToWord16 -- :: Word -> Word16
+ , wordToWord32 -- :: Word -> Word32
+ , wordToWord64 -- :: Word -> Word64
+
+ , word8ToWord -- :: Word8 -> Word
+ , word16ToWord -- :: Word16 -> Word
+ , word32ToWord -- :: Word32 -> Word
+ , word64ToWord -- :: Word64 -> Word
+
+ -- The "official" place to get these from is Addr.
+ -- SUP: deprecated in the new FFI, subsumed by the Storable class
+ , indexWord8OffAddr
+ , indexWord16OffAddr
+ , indexWord32OffAddr
+ , indexWord64OffAddr
+
+ , readWord8OffAddr
+ , readWord16OffAddr
+ , readWord32OffAddr
+ , readWord64OffAddr
+
+ , writeWord8OffAddr
+ , writeWord16OffAddr
+ , writeWord32OffAddr
+ , writeWord64OffAddr
+
+ -- internal stuff
+ , wordToInt
+ , wordToWord8#, wordToWord16#, wordToWord32#, wordToWord64#
+
+ , word64ToInt64#, int64ToWord64#
+ , wordToWord64#, word64ToWord#
+
+ , toEnumError, fromEnumError, succError, predError, divZeroError
+ ) where
+
+import Numeric ( showInt )
+
+import PrelArr
+import PrelRead
+import PrelIOBase
+import PrelEnum
+import PrelAddr
+import PrelReal
+import PrelNum
+import PrelBase
+
+-- ---------------------------------------------------------------------------
+-- Coercion functions (DEPRECATED)
+-- ---------------------------------------------------------------------------
+
+intToWord8 :: Int -> Word8
+intToWord16 :: Int -> Word16
+intToWord32 :: Int -> Word32
+intToWord64 :: Int -> Word64
+
+integerToWord8 :: Integer -> Word8
+integerToWord16 :: Integer -> Word16
+integerToWord32 :: Integer -> Word32
+integerToWord64 :: Integer -> Word64
+
+word8ToInt :: Word8 -> Int
+word8ToInteger :: Word8 -> Integer
+word8ToWord16 :: Word8 -> Word16
+word8ToWord32 :: Word8 -> Word32
+word8ToWord64 :: Word8 -> Word64
+
+word16ToInt :: Word16 -> Int
+word16ToInteger :: Word16 -> Integer
+word16ToWord8 :: Word16 -> Word8
+word16ToWord32 :: Word16 -> Word32
+word16ToWord64 :: Word16 -> Word64
+
+word32ToInt :: Word32 -> Int
+word32ToInteger :: Word32 -> Integer
+word32ToWord8 :: Word32 -> Word8
+word32ToWord16 :: Word32 -> Word16
+word32ToWord64 :: Word32 -> Word64
+
+word64ToInt :: Word64 -> Int
+word64ToInteger :: Word64 -> Integer
+word64ToWord8 :: Word64 -> Word8
+word64ToWord16 :: Word64 -> Word16
+word64ToWord32 :: Word64 -> Word32
+
+wordToWord8 :: Word -> Word8
+wordToWord16 :: Word -> Word16
+wordToWord32 :: Word -> Word32
+wordToWord64 :: Word -> Word64
+
+word8ToWord :: Word8 -> Word
+word16ToWord :: Word16 -> Word
+word32ToWord :: Word32 -> Word
+word64ToWord :: Word64 -> Word
+
+intToWord8 = word32ToWord8 . intToWord32
+intToWord16 = word32ToWord16 . intToWord32
+
+integerToWord8 = fromInteger
+integerToWord16 = fromInteger
+
+word8ToInt = word32ToInt . word8ToWord32
+word8ToInteger = word32ToInteger . word8ToWord32
+
+word16ToInt = word32ToInt . word16ToWord32
+word16ToInteger = word32ToInteger . word16ToWord32
+
+#if WORD_SIZE_IN_BYTES > 4
+intToWord32 (I# x) = W32# ((int2Word# x) `and#` (case (maxBound::Word32) of W32# x# -> x#))
+#else
+intToWord32 (I# x) = W32# (int2Word# x)
+#endif
+
+word32ToInt (W32# x) = I# (word2Int# x)
+
+word32ToInteger (W32# x) = word2Integer x
+integerToWord32 = fromInteger
+
+-----------------------------------------------------------------------------
+-- The following rules for fromIntegral remove the need to export specialized
+-- conversion functions.
+-----------------------------------------------------------------------------
+
+{-# RULES
+ "fromIntegral/Int->Word8" fromIntegral = intToWord8;
+ "fromIntegral/Int->Word16" fromIntegral = intToWord16;
+ "fromIntegral/Int->Word32" fromIntegral = intToWord32;
+ "fromIntegral/Int->Word64" fromIntegral = intToWord64;
+
+ "fromIntegral/Integer->Word8" fromIntegral = integerToWord8;
+ "fromIntegral/Integer->Word16" fromIntegral = integerToWord16;
+ "fromIntegral/Integer->Word32" fromIntegral = integerToWord32;
+ "fromIntegral/Integer->Word64" fromIntegral = integerToWord64;
+
+ "fromIntegral/Word8->Int" fromIntegral = word8ToInt;
+ "fromIntegral/Word8->Integer" fromIntegral = word8ToInteger;
+ "fromIntegral/Word8->Word16" fromIntegral = word8ToWord16;
+ "fromIntegral/Word8->Word32" fromIntegral = word8ToWord32;
+ "fromIntegral/Word8->Word64" fromIntegral = word8ToWord64;
+
+ "fromIntegral/Word16->Int" fromIntegral = word16ToInt;
+ "fromIntegral/Word16->Integer" fromIntegral = word16ToInteger;
+ "fromIntegral/Word16->Word8" fromIntegral = word16ToWord8;
+ "fromIntegral/Word16->Word32" fromIntegral = word16ToWord32;
+ "fromIntegral/Word16->Word64" fromIntegral = word16ToWord64;
+
+ "fromIntegral/Word32->Int" fromIntegral = word32ToInt;
+ "fromIntegral/Word32->Integer" fromIntegral = word32ToInteger;
+ "fromIntegral/Word32->Word8" fromIntegral = word32ToWord8;
+ "fromIntegral/Word32->Word16" fromIntegral = word32ToWord16;
+ "fromIntegral/Word32->Word64" fromIntegral = word32ToWord64;
+
+ "fromIntegral/Word64->Int" fromIntegral = word64ToInt;
+ "fromIntegral/Word64->Integer" fromIntegral = word64ToInteger;
+ "fromIntegral/Word64->Word8" fromIntegral = word64ToWord8;
+ "fromIntegral/Word64->Word16" fromIntegral = word64ToWord16;
+ "fromIntegral/Word64->Word32" fromIntegral = word64ToWord32
+ #-}
+
+\end{code}
+
+\subsection[Word8]{The @Word8@ interface}
+
+
+The byte type @Word8@ is represented in the Haskell
+heap by boxing up a 32-bit quantity, @Word#@. An invariant
+for this representation is that the higher 24 bits are
+*always* zeroed out. A consequence of this is that
+operations that could possibly overflow have to mask
+out the top three bytes before building the resulting @Word8@.
+
+\begin{code}
+data Word8 = W8# Word#
+
+instance CCallable Word8
+instance CReturnable Word8
+
+word8ToWord32 (W8# x) = W32# x
+word8ToWord16 (W8# x) = W16# x
+word32ToWord8 (W32# x) = W8# (wordToWord8# x)
+
+-- mask out upper three bytes.
+intToWord8# :: Int# -> Word#
+intToWord8# i# = (int2Word# i#) `and#` (int2Word# 0xff#)
+
+wordToWord8# :: Word# -> Word#
+wordToWord8# w# = w# `and#` (int2Word# 0xff#)
+
+instance Eq Word8 where
+ (W8# x) == (W8# y) = x `eqWord#` y
+ (W8# x) /= (W8# y) = x `neWord#` y
+
+instance Ord Word8 where
+ compare (W8# x#) (W8# y#) = compareWord# x# y#
+ (<) (W8# x) (W8# y) = x `ltWord#` y
+ (<=) (W8# x) (W8# y) = x `leWord#` y
+ (>=) (W8# x) (W8# y) = x `geWord#` y
+ (>) (W8# x) (W8# y) = x `gtWord#` y
+ max x@(W8# x#) y@(W8# y#) =
+ case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
+ min x@(W8# x#) y@(W8# y#) =
+ case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
+
+-- Helper function, used by Ord Word* instances.
+compareWord# :: Word# -> Word# -> Ordering
+compareWord# x# y#
+ | x# `ltWord#` y# = LT
+ | x# `eqWord#` y# = EQ
+ | otherwise = GT
+
+instance Num Word8 where
+ (W8# x) + (W8# y) =
+ W8# (intToWord8# (word2Int# x +# word2Int# y))
+ (W8# x) - (W8# y) =
+ W8# (intToWord8# (word2Int# x -# word2Int# y))
+ (W8# x) * (W8# y) =
+ W8# (intToWord8# (word2Int# x *# word2Int# y))
+ negate w@(W8# x) =
+ if x' ==# 0#
+ then w
+ else W8# (int2Word# (0x100# -# x'))
+ where
+ x' = word2Int# x
+ abs x = x
+ signum = signumReal
+ fromInteger (S# i#) = W8# (wordToWord8# (int2Word# i#))
+ fromInteger (J# s# d#) = W8# (wordToWord8# (integer2Word# s# d#))
+ fromInt = intToWord8
+
+instance Bounded Word8 where
+ minBound = 0
+ maxBound = 0xff
+
+instance Real Word8 where
+ toRational x = toInteger x % 1
+
+-- Note: no need to mask results here
+-- as they cannot overflow.
+instance Integral Word8 where
+ div x@(W8# x#) (W8# y#)
+ | y# `neWord#` (int2Word# 0#) = W8# (x# `quotWord#` y#)
+ | otherwise = divZeroError "div{Word8}" x
+
+ quot x@(W8# x#) (W8# y#)
+ | y# `neWord#` (int2Word# 0#) = W8# (x# `quotWord#` y#)
+ | otherwise = divZeroError "quot{Word8}" x
+
+ rem x@(W8# x#) (W8# y#)
+ | y# `neWord#` (int2Word# 0#) = W8# (x# `remWord#` y#)
+ | otherwise = divZeroError "rem{Word8}" x
+
+ mod x@(W8# x#) (W8# y#)
+ | y# `neWord#` (int2Word# 0#) = W8# (x# `remWord#` y#)
+ | otherwise = divZeroError "mod{Word8}" x
+
+ quotRem (W8# x) (W8# y) = (W8# (x `quotWord#` y), W8# (x `remWord#` y))
+ divMod (W8# x) (W8# y) = (W8# (x `quotWord#` y), W8# (x `remWord#` y))
+
+ toInteger = toInteger . toInt
+ toInt = word8ToInt
+
+instance Ix Word8 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = word8ToInt (i-m)
+ | otherwise = indexError b i "Word8"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Enum Word8 where
+ succ w
+ | w == maxBound = succError "Word8"
+ | otherwise = w+1
+ pred w
+ | w == minBound = predError "Word8"
+ | otherwise = w-1
+
+ toEnum i@(I# i#)
+ | i >= toInt (minBound::Word8) && i <= toInt (maxBound::Word8)
+ = W8# (intToWord8# i#)
+ | otherwise
+ = toEnumError "Word8" i (minBound::Word8,maxBound::Word8)
+
+ fromEnum (W8# w) = I# (word2Int# w)
+
+ enumFrom = boundedEnumFrom
+ enumFromThen = boundedEnumFromThen
+
+instance Read Word8 where
+ readsPrec _ = readDec
+
+instance Show Word8 where
+ showsPrec _ = showInt
+\end{code}
+
+\subsection[Word16]{The @Word16@ interface}
+
+The double byte type @Word16@ is represented in the Haskell
+heap by boxing up a machine word, @Word#@. An invariant
+for this representation is that only the lower 16 bits are
+`active', any bits above are {\em always} zeroed out.
+A consequence of this is that operations that could possibly
+overflow have to mask out anything above the lower two bytes
+before putting together the resulting @Word16@.
+
+\begin{code}
+data Word16 = W16# Word#
+
+instance CCallable Word16
+instance CReturnable Word16
+
+word16ToWord8 (W16# x) = W8# (wordToWord8# x)
+word16ToWord32 (W16# x) = W32# x
+
+word32ToWord16 (W32# x) = W16# (wordToWord16# x)
+
+-- mask out upper 16 bits.
+intToWord16# :: Int# -> Word#
+intToWord16# i# = ((int2Word# i#) `and#` (int2Word# 0xffff#))
+
+wordToWord16# :: Word# -> Word#
+wordToWord16# w# = w# `and#` (int2Word# 0xffff#)
+
+instance Eq Word16 where
+ (W16# x) == (W16# y) = x `eqWord#` y
+ (W16# x) /= (W16# y) = x `neWord#` y
+
+instance Ord Word16 where
+ compare (W16# x#) (W16# y#) = compareWord# x# y#
+ (<) (W16# x) (W16# y) = x `ltWord#` y
+ (<=) (W16# x) (W16# y) = x `leWord#` y
+ (>=) (W16# x) (W16# y) = x `geWord#` y
+ (>) (W16# x) (W16# y) = x `gtWord#` y
+ max x@(W16# x#) y@(W16# y#) =
+ case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
+ min x@(W16# x#) y@(W16# y#) =
+ case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
+
+
+
+instance Num Word16 where
+ (W16# x) + (W16# y) =
+ W16# (intToWord16# (word2Int# x +# word2Int# y))
+ (W16# x) - (W16# y) =
+ W16# (intToWord16# (word2Int# x -# word2Int# y))
+ (W16# x) * (W16# y) =
+ W16# (intToWord16# (word2Int# x *# word2Int# y))
+ negate w@(W16# x) =
+ if x' ==# 0#
+ then w
+ else W16# (int2Word# (0x10000# -# x'))
+ where
+ x' = word2Int# x
+ abs x = x
+ signum = signumReal
+ fromInteger (S# i#) = W16# (wordToWord16# (int2Word# i#))
+ fromInteger (J# s# d#) = W16# (wordToWord16# (integer2Word# s# d#))
+ fromInt = intToWord16
+
+instance Bounded Word16 where
+ minBound = 0
+ maxBound = 0xffff
+
+instance Real Word16 where
+ toRational x = toInteger x % 1
+
+instance Integral Word16 where
+ div x@(W16# x#) (W16# y#)
+ | y# `neWord#` (int2Word# 0#) = W16# (x# `quotWord#` y#)
+ | otherwise = divZeroError "div{Word16}" x
+
+ quot x@(W16# x#) (W16# y#)
+ | y# `neWord#`(int2Word# 0#) = W16# (x# `quotWord#` y#)
+ | otherwise = divZeroError "quot{Word16}" x
+
+ rem x@(W16# x#) (W16# y#)
+ | y# `neWord#` (int2Word# 0#) = W16# (x# `remWord#` y#)
+ | otherwise = divZeroError "rem{Word16}" x
+
+ mod x@(W16# x#) (W16# y#)
+ | y# `neWord#` (int2Word# 0#) = W16# (x# `remWord#` y#)
+ | otherwise = divZeroError "mod{Word16}" x
+
+ quotRem (W16# x) (W16# y) = (W16# (x `quotWord#` y), W16# (x `remWord#` y))
+ divMod (W16# x) (W16# y) = (W16# (x `quotWord#` y), W16# (x `remWord#` y))
+
+ toInteger = toInteger . toInt
+ toInt = word16ToInt
+
+instance Ix Word16 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = word16ToInt (i - m)
+ | otherwise = indexError b i "Word16"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Enum Word16 where
+ succ w
+ | w == maxBound = succError "Word16"
+ | otherwise = w+1
+ pred w
+ | w == minBound = predError "Word16"
+ | otherwise = w-1
+
+ toEnum i@(I# i#)
+ | i >= toInt (minBound::Word16) && i <= toInt (maxBound::Word16)
+ = W16# (intToWord16# i#)
+ | otherwise
+ = toEnumError "Word16" i (minBound::Word16,maxBound::Word16)
+
+ fromEnum (W16# w) = I# (word2Int# w)
+ enumFrom = boundedEnumFrom
+ enumFromThen = boundedEnumFromThen
+
+instance Read Word16 where
+ readsPrec _ = readDec
+
+instance Show Word16 where
+ showsPrec _ = showInt
+\end{code}
+
+\subsection[Word32]{The @Word32@ interface}
+
+The quad byte type @Word32@ is represented in the Haskell
+heap by boxing up a machine word, @Word#@. An invariant
+for this representation is that any bits above the lower
+32 are {\em always} zeroed out. A consequence of this is that
+operations that could possibly overflow have to mask
+the result before building the resulting @Word16@.
+
+\begin{code}
+data Word32 = W32# Word#
+
+instance CCallable Word32
+instance CReturnable Word32
+
+instance Eq Word32 where
+ (W32# x) == (W32# y) = x `eqWord#` y
+ (W32# x) /= (W32# y) = x `neWord#` y
+
+instance Ord Word32 where
+ compare (W32# x#) (W32# y#) = compareWord# x# y#
+ (<) (W32# x) (W32# y) = x `ltWord#` y
+ (<=) (W32# x) (W32# y) = x `leWord#` y
+ (>=) (W32# x) (W32# y) = x `geWord#` y
+ (>) (W32# x) (W32# y) = x `gtWord#` y
+ max x@(W32# x#) y@(W32# y#) =
+ case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
+ min x@(W32# x#) y@(W32# y#) =
+ case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
+
+instance Num Word32 where
+ (W32# x) + (W32# y) =
+ W32# (intToWord32# (word2Int# x +# word2Int# y))
+ (W32# x) - (W32# y) =
+ W32# (intToWord32# (word2Int# x -# word2Int# y))
+ (W32# x) * (W32# y) =
+ W32# (intToWord32# (word2Int# x *# word2Int# y))
+#if WORD_SIZE_IN_BYTES == 8
+ negate w@(W32# x) =
+ if x' ==# 0#
+ then w
+ else W32# (intToWord32# (0x100000000# -# x'))
+ where
+ x' = word2Int# x
+#else
+ negate (W32# x) = W32# (intToWord32# (negateInt# (word2Int# x)))
+#endif
+ abs x = x
+ signum = signumReal
+ fromInteger (S# i#) = W32# (intToWord32# i#)
+ fromInteger (J# s# d#) = W32# (wordToWord32# (integer2Word# s# d#))
+ fromInt (I# x) = W32# (intToWord32# x)
+ -- ToDo: restrict fromInt{eger} range.
+
+intToWord32# :: Int# -> Word#
+wordToWord32# :: Word# -> Word#
+
+#if WORD_SIZE_IN_BYTES == 8
+intToWord32# i# = (int2Word# i#) `and#` (int2Word# 0xffffffff#)
+wordToWord32# w# = w# `and#` (int2Word# 0xffffffff#)
+wordToWord64# w# = w#
+#else
+intToWord32# i# = int2Word# i#
+wordToWord32# w# = w#
+#endif
+
+instance Bounded Word32 where
+ minBound = 0
+#if WORD_SIZE_IN_BYTES == 8
+ maxBound = 0xffffffff
+#else
+ maxBound = minBound - 1
+#endif
+
+instance Real Word32 where
+ toRational x = toInteger x % 1
+
+instance Integral Word32 where
+ div x y
+ | y /= 0 = quotWord32 x y
+ | otherwise = divZeroError "div{Word32}" x
+
+ quot x y
+ | y /= 0 = quotWord32 x y
+ | otherwise = divZeroError "quot{Word32}" x
+
+ rem x y
+ | y /= 0 = remWord32 x y
+ | otherwise = divZeroError "rem{Word32}" x
+
+ mod x y
+ | y /= 0 = remWord32 x y
+ | otherwise = divZeroError "mod{Word32}" x
+
+ quotRem a b = (a `quot` b, a `rem` b)
+ divMod x y = quotRem x y
+
+ toInteger = word32ToInteger
+ toInt = word32ToInt
+
+
+{-# INLINE quotWord32 #-}
+{-# INLINE remWord32 #-}
+remWord32, quotWord32 :: Word32 -> Word32 -> Word32
+(W32# x) `quotWord32` (W32# y) = W32# (x `quotWord#` y)
+(W32# x) `remWord32` (W32# y) = W32# (x `remWord#` y)
+
+
+instance Ix Word32 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = word32ToInt (i - m)
+ | otherwise = indexError b i "Word32"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Enum Word32 where
+ succ w
+ | w == maxBound = succError "Word32"
+ | otherwise = w+1
+ pred w
+ | w == minBound = predError "Word32"
+ | otherwise = w-1
+
+ -- the toEnum/fromEnum will fail if the mapping isn't legal,
+ -- use the intTo* & *ToInt coercion functions to 'bypass' these range checks.
+ toEnum x
+ | x >= 0 = intToWord32 x
+ | otherwise
+ = toEnumError "Word32" x (minBound::Word32,maxBound::Word32)
+
+ fromEnum x
+ | x <= intToWord32 (maxBound::Int)
+ = word32ToInt x
+ | otherwise
+ = fromEnumError "Word32" x
+
+ enumFrom w = [w .. maxBound]
+ enumFromTo w1 w2
+ | w1 <= w2 = eftt32 True{-increasing-} w1 diff_f last
+ | otherwise = []
+ where
+ last = (> w2)
+ diff_f x = x + 1
+
+ enumFromThen w1 w2 = [w1,w2 .. last]
+ where
+ last :: Word32
+ last
+ | w1 <=w2 = maxBound
+ | otherwise = minBound
+
+ enumFromThenTo w1 w2 wend = eftt32 increasing w1 step_f last
+ where
+ increasing = w1 <= w2
+ diff1 = w2 - w1
+ diff2 = w1 - w2
+
+ last
+ | increasing = (> wend)
+ | otherwise = (< wend)
+
+ step_f
+ | increasing = \ x -> x + diff1
+ | otherwise = \ x -> x - diff2
+
+eftt32 :: Bool -> Word32 -> (Word32 -> Word32) -> (Word32-> Bool) -> [Word32]
+eftt32 increasing init stepper done = go init
+ where
+ go now
+ | done now = []
+ | increasing && now > nxt = [now] -- oflow
+ | not increasing && now < nxt = [now] -- uflow
+ | otherwise = now : go nxt
+ where
+ nxt = stepper now
+
+instance Read Word32 where
+ readsPrec _ = readDec
+
+instance Show Word32 where
+ showsPrec _ = showInt
+
+-- -----------------------------------------------------------------------------
+-- Word64
+-- -----------------------------------------------------------------------------
+
+#if WORD_SIZE_IN_BYTES == 8
+--data Word64 = W64# Word#
+
+word32ToWord64 (W32 w#) = W64# w#
+
+word8ToWord64 (W8# w#) = W64# w#
+word64ToWord8 (W64# w#) = W8# (w# `and#` (int2Word# 0xff#))
+
+word16ToWord64 (W16# w#) = W64# w#
+word64ToWord16 (W64# w#) = W16# (w# `and#` (int2Word# 0xffff#))
+
+wordToWord32# :: Word# -> Word#
+wordToWord32# w# = w# `and#` (case (maxBound::Word32) of W# x# -> x#)
+
+word64ToWord32 :: Word64 -> Word32
+word64ToWord32 (W64# w#) = W32# (wordToWord32# w#)
+
+wordToWord64# w# = w#
+word64ToWord# w# = w#
+
+instance Eq Word64 where
+ (W64# x) == (W64# y) = x `eqWord#` y
+ (W64# x) /= (W64# y) = x `neWord#` y
+
+instance Ord Word64 where
+ compare (W64# x#) (W64# y#) = compareWord# x# y#
+ (<) (W64# x) (W64# y) = x `ltWord#` y
+ (<=) (W64# x) (W64# y) = x `leWord#` y
+ (>=) (W64# x) (W64# y) = x `geWord#` y
+ (>) (W64# x) (W64# y) = x `gtWord#` y
+ max x@(W64# x#) y@(W64# y#) =
+ case (compareWord# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
+ min x@(W64# x#) y@(W64# y#) =
+ case (compareWord# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
+
+instance Num Word64 where
+ (W64# x) + (W64# y) =
+ W64# (intToWord64# (word2Int# x +# word2Int# y))
+ (W64# x) - (W64# y) =
+ W64# (intToWord64# (word2Int# x -# word2Int# y))
+ (W64# x) * (W64# y) =
+ W64# (intToWord64# (word2Int# x *# word2Int# y))
+ negate w@(W64# x) =
+ if x' ==# 0#
+ then w
+ else W64# (int2Word# (0x100# -# x'))
+ where
+ x' = word2Int# x
+ abs x = x
+ signum = signumReal
+ fromInteger (S# i#) = W64# (int2Word# i#)
+ fromInteger (J# s# d#) = W64# (integer2Word# s# d#)
+ fromInt = intToWord64
+
+-- Note: no need to mask results here
+-- as they cannot overflow.
+instance Integral Word64 where
+ div x@(W64# x#) (W64# y#)
+ | y# `neWord#` (int2Word# 0#) = W64# (x# `quotWord#` y#)
+ | otherwise = divZeroError "div{Word64}" x
+
+ quot x@(W64# x#) (W64# y#)
+ | y# `neWord#` (int2Word# 0#) = W64# (x# `quotWord#` y#)
+ | otherwise = divZeroError "quot{Word64}" x
+
+ rem x@(W64# x#) (W64# y#)
+ | y# `neWord#` (int2Word# 0#) = W64# (x# `remWord#` y#)
+ | otherwise = divZeroError "rem{Word64}" x
+
+ mod (W64# x) (W64# y)
+ | y# `neWord#` (int2Word# 0#) = W64# (x `remWord#` y)
+ | otherwise = divZeroError "mod{Word64}" x
+
+ quotRem (W64# x) (W64# y) = (W64# (x `quotWord#` y), W64# (x `remWord#` y))
+ divMod (W64# x) (W64# y) = (W64# (x `quotWord#` y), W64# (x `remWord#` y))
+
+ toInteger (W64# x) = word2Integer# x
+ toInt x = word64ToInt x
+
+#else /* WORD_SIZE_IN_BYTES < 8 */
+
+--defined in PrelCCall: data Word64 = W64 Word64# deriving (Eq, Ord, Bounded)
+
+-- for completeness sake
+word32ToWord64 (W32# w#) = W64# (wordToWord64# w#)
+word64ToWord32 (W64# w#) = W32# (word64ToWord# w#)
+
+word8ToWord64 (W8# w#) = W64# (wordToWord64# w#)
+word64ToWord8 (W64# w#) = W8# ((word64ToWord# w#) `and#` (int2Word# 0xff#))
+
+word16ToWord64 (W16# w#) = W64# (wordToWord64# w#)
+word64ToWord16 (W64# w#) = W16# ((word64ToWord# w#) `and#` (int2Word# 0xffff#))
+
+word64ToInteger (W64# w#) =
+ case word64ToInteger# w# of
+ (# s#, p# #) -> J# s# p#
+word64ToInt w =
+ case w `quotRem` 0x100000000 of
+ (_,l) -> toInt (word64ToWord32 l)
+
+intToWord64# :: Int# -> Word64#
+intToWord64# i# = wordToWord64# (int2Word# i#)
+
+intToWord64 (I# i#) = W64# (intToWord64# i#)
+
+integerToWord64 (S# i#) = W64# (intToWord64# i#)
+integerToWord64 (J# s# d#) = W64# (integerToWord64# s# d#)
+
+instance Eq Word64 where
+ (W64# x) == (W64# y) = x `eqWord64#` y
+ (W64# x) /= (W64# y) = not (x `eqWord64#` y)
+
+instance Ord Word64 where
+ compare (W64# x#) (W64# y#) = compareWord64# x# y#
+ (<) (W64# x) (W64# y) = x `ltWord64#` y
+ (<=) (W64# x) (W64# y) = x `leWord64#` y
+ (>=) (W64# x) (W64# y) = x `geWord64#` y
+ (>) (W64# x) (W64# y) = x `gtWord64#` y
+ max x@(W64# x#) y@(W64# y#) =
+ case (compareWord64# x# y#) of { LT -> y ; EQ -> x ; GT -> x }
+ min x@(W64# x#) y@(W64# y#) =
+ case (compareWord64# x# y#) of { LT -> x ; EQ -> x ; GT -> y }
+
+instance Num Word64 where
+ (W64# x) + (W64# y) =
+ W64# (int64ToWord64# (word64ToInt64# x `plusInt64#` word64ToInt64# y))
+ (W64# x) - (W64# y) =
+ W64# (int64ToWord64# (word64ToInt64# x `minusInt64#` word64ToInt64# y))
+ (W64# x) * (W64# y) =
+ W64# (int64ToWord64# (word64ToInt64# x `timesInt64#` word64ToInt64# y))
+ negate w
+ | w == 0 = w
+ | otherwise = maxBound - w
+
+ abs x = x
+ signum = signumReal
+ fromInteger i = integerToWord64 i
+ fromInt = intToWord64
+
+-- Note: no need to mask results here as they cannot overflow.
+-- ToDo: protect against div by zero.
+instance Integral Word64 where
+ div (W64# x) (W64# y) = W64# (x `quotWord64#` y)
+ quot (W64# x) (W64# y) = W64# (x `quotWord64#` y)
+ rem (W64# x) (W64# y) = W64# (x `remWord64#` y)
+ mod (W64# x) (W64# y) = W64# (x `remWord64#` y)
+ quotRem (W64# x) (W64# y) = (W64# (x `quotWord64#` y), W64# (x `remWord64#` y))
+ divMod (W64# x) (W64# y) = (W64# (x `quotWord64#` y), W64# (x `remWord64#` y))
+ toInteger w64 = word64ToInteger w64
+ toInt x = word64ToInt x
+
+compareWord64# :: Word64# -> Word64# -> Ordering
+compareWord64# i# j#
+ | i# `ltWord64#` j# = LT
+ | i# `eqWord64#` j# = EQ
+ | otherwise = GT
+
+-- Word64# primop wrappers:
+
+ltWord64# :: Word64# -> Word64# -> Bool
+ltWord64# x# y# = stg_ltWord64 x# y# /= 0
+
+leWord64# :: Word64# -> Word64# -> Bool
+leWord64# x# y# = stg_leWord64 x# y# /= 0
+
+eqWord64# :: Word64# -> Word64# -> Bool
+eqWord64# x# y# = stg_eqWord64 x# y# /= 0
+
+neWord64# :: Word64# -> Word64# -> Bool
+neWord64# x# y# = stg_neWord64 x# y# /= 0
+
+geWord64# :: Word64# -> Word64# -> Bool
+geWord64# x# y# = stg_geWord64 x# y# /= 0
+
+gtWord64# :: Word64# -> Word64# -> Bool
+gtWord64# x# y# = stg_gtWord64 x# y# /= 0
+
+plusInt64# :: Int64# -> Int64# -> Int64#
+plusInt64# a# b# = case stg_plusInt64 a# b# of { I64# i# -> i# }
+
+minusInt64# :: Int64# -> Int64# -> Int64#
+minusInt64# a# b# = case stg_minusInt64 a# b# of { I64# i# -> i# }
+
+timesInt64# :: Int64# -> Int64# -> Int64#
+timesInt64# a# b# = case stg_timesInt64 a# b# of { I64# i# -> i# }
+
+quotWord64# :: Word64# -> Word64# -> Word64#
+quotWord64# a# b# = case stg_quotWord64 a# b# of { W64# w# -> w# }
+
+remWord64# :: Word64# -> Word64# -> Word64#
+remWord64# a# b# = case stg_remWord64 a# b# of { W64# w# -> w# }
+
+negateInt64# :: Int64# -> Int64#
+negateInt64# a# = case stg_negateInt64 a# of { I64# i# -> i# }
+
+word64ToWord# :: Word64# -> Word#
+word64ToWord# w64# = case stg_word64ToWord w64# of { W# w# -> w# }
+
+wordToWord64# :: Word# -> Word64#
+wordToWord64# w# = case stg_wordToWord64 w# of { W64# w64# -> w64# }
+
+word64ToInt64# :: Word64# -> Int64#
+word64ToInt64# w64# = case stg_word64ToInt64 w64# of { I64# i# -> i# }
+
+int64ToWord64# :: Int64# -> Word64#
+int64ToWord64# i64# = case stg_int64ToWord64 i64# of { W64# w# -> w# }
+
+intToInt64# :: Int# -> Int64#
+intToInt64# i# = case stg_intToInt64 i# of { I64# i64# -> i64# }
+
+foreign import "stg_intToInt64" unsafe stg_intToInt64 :: Int# -> Int64
+foreign import "stg_int64ToWord64" unsafe stg_int64ToWord64 :: Int64# -> Word64
+foreign import "stg_word64ToInt64" unsafe stg_word64ToInt64 :: Word64# -> Int64
+foreign import "stg_wordToWord64" unsafe stg_wordToWord64 :: Word# -> Word64
+foreign import "stg_word64ToWord" unsafe stg_word64ToWord :: Word64# -> Word
+foreign import "stg_negateInt64" unsafe stg_negateInt64 :: Int64# -> Int64
+foreign import "stg_remWord64" unsafe stg_remWord64 :: Word64# -> Word64# -> Word64
+foreign import "stg_quotWord64" unsafe stg_quotWord64 :: Word64# -> Word64# -> Word64
+foreign import "stg_timesInt64" unsafe stg_timesInt64 :: Int64# -> Int64# -> Int64
+foreign import "stg_minusInt64" unsafe stg_minusInt64 :: Int64# -> Int64# -> Int64
+foreign import "stg_plusInt64" unsafe stg_plusInt64 :: Int64# -> Int64# -> Int64
+foreign import "stg_gtWord64" unsafe stg_gtWord64 :: Word64# -> Word64# -> Int
+foreign import "stg_geWord64" unsafe stg_geWord64 :: Word64# -> Word64# -> Int
+foreign import "stg_neWord64" unsafe stg_neWord64 :: Word64# -> Word64# -> Int
+foreign import "stg_eqWord64" unsafe stg_eqWord64 :: Word64# -> Word64# -> Int
+foreign import "stg_leWord64" unsafe stg_leWord64 :: Word64# -> Word64# -> Int
+foreign import "stg_ltWord64" unsafe stg_ltWord64 :: Word64# -> Word64# -> Int
+
+#endif
+
+instance Enum Word64 where
+ succ w
+ | w == maxBound = succError "Word64"
+ | otherwise = w+1
+ pred w
+ | w == minBound = predError "Word64"
+ | otherwise = w-1
+
+ toEnum i
+ | i >= 0 = intToWord64 i
+ | otherwise
+ = toEnumError "Word64" i (minBound::Word64,maxBound::Word64)
+
+ fromEnum w
+ | w <= intToWord64 (maxBound::Int)
+ = word64ToInt w
+ | otherwise
+ = fromEnumError "Word64" w
+
+ enumFrom e1 = map integerToWord64 [word64ToInteger e1 .. word64ToInteger maxBound]
+ enumFromTo e1 e2 = map integerToWord64 [word64ToInteger e1 .. word64ToInteger e2]
+ enumFromThen e1 e2 = map integerToWord64 [word64ToInteger e1, word64ToInteger e2 .. word64ToInteger last]
+ where
+ last :: Word64
+ last
+ | e2 < e1 = minBound
+ | otherwise = maxBound
+
+ enumFromThenTo e1 e2 e3 = map integerToWord64 [word64ToInteger e1, word64ToInteger e2 .. word64ToInteger e3]
+
+instance Show Word64 where
+ showsPrec p x = showsPrec p (word64ToInteger x)
+
+instance Read Word64 where
+ readsPrec _ s = [ (integerToWord64 x,r) | (x,r) <- readDec s ]
+
+instance Ix Word64 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = word64ToInt (i-m)
+ | otherwise = indexError b i "Word64"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Bounded Word64 where
+ minBound = 0
+ maxBound = minBound - 1
+
+instance Real Word64 where
+ toRational x = toInteger x % 1
+
+-- -----------------------------------------------------------------------------
+-- Reading/writing words to/from memory
+-- -----------------------------------------------------------------------------
+
+indexWord8OffAddr :: Addr -> Int -> Word8
+indexWord8OffAddr (A# a#) (I# i#) = W8# (indexWord8OffAddr# a# i#)
+
+indexWord16OffAddr :: Addr -> Int -> Word16
+indexWord16OffAddr (A# a#) (I# i#) = W16# (indexWord16OffAddr# a# i#)
+
+indexWord32OffAddr :: Addr -> Int -> Word32
+indexWord32OffAddr (A# a#) (I# i#) = W32# (indexWord32OffAddr# a# i#)
+
+indexWord64OffAddr :: Addr -> Int -> Word64
+#if WORD_SIZE_IN_BYTES == 8
+indexWord64OffAddr (A# a#) (I# i#) = W64# (indexWordOffAddr# a# i#)
+#else
+indexWord64OffAddr (A# a#) (I# i#) = W64# (indexWord64OffAddr# a# i#)
+#endif
+
+
+readWord8OffAddr :: Addr -> Int -> IO Word8
+readWord8OffAddr (A# a) (I# i)
+ = IO $ \s -> case readWord8OffAddr# a i s of (# s, w #) -> (# s, W8# w #)
+
+readWord16OffAddr :: Addr -> Int -> IO Word16
+readWord16OffAddr (A# a) (I# i)
+ = IO $ \s -> case readWord16OffAddr# a i s of (# s, w #) -> (# s, W16# w #)
+
+readWord32OffAddr :: Addr -> Int -> IO Word32
+readWord32OffAddr (A# a) (I# i)
+ = IO $ \s -> case readWord32OffAddr# a i s of (# s, w #) -> (# s, W32# w #)
+
+readWord64OffAddr :: Addr -> Int -> IO Word64
+#if WORD_SIZE_IN_BYTES == 8
+readWord64OffAddr (A# a) (I# i)
+ = IO $ \s -> case readWordOffAddr# a i s of (# s, w #) -> (# s, W64# w #)
+#else
+readWord64OffAddr (A# a) (I# i)
+ = IO $ \s -> case readWord64OffAddr# a i s of (# s, w #) -> (# s, W64# w #)
+#endif
+
+
+writeWord8OffAddr :: Addr -> Int -> Word8 -> IO ()
+writeWord8OffAddr (A# a#) (I# i#) (W8# w#) = IO $ \ s# ->
+ case (writeWord8OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+
+writeWord16OffAddr :: Addr -> Int -> Word16 -> IO ()
+writeWord16OffAddr (A# a#) (I# i#) (W16# w#) = IO $ \ s# ->
+ case (writeWord16OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+
+writeWord32OffAddr :: Addr -> Int -> Word32 -> IO ()
+writeWord32OffAddr (A# a#) (I# i#) (W32# w#) = IO $ \ s# ->
+ case (writeWord32OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+
+writeWord64OffAddr :: Addr -> Int -> Word64 -> IO ()
+#if WORD_SIZE_IN_BYTES == 8
+writeWord64OffAddr (A# a#) (I# i#) (W64# w#) = IO $ \ s# ->
+ case (writeWordOffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+#else
+writeWord64OffAddr (A# a#) (I# i#) (W64# w#) = IO $ \ s# ->
+ case (writeWord64OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
+#endif
+\end{code}
+
+The Hugs-GHC extension libraries provide functions for going between
+Int and the various (un)signed ints. Here we provide the same for
+the GHC specific Word type:
+
+\begin{code}
+word8ToWord (W8# w#) = W# w#
+wordToWord8 (W# w#) = W8# (w# `and#` (case (maxBound::Word8) of W8# x# -> x#))
+
+word16ToWord (W16# w#) = W# w#
+wordToWord16 (W# w#) = W16# (w# `and#` (case (maxBound::Word16) of W16# x# -> x#))
+
+word32ToWord (W32# w#) = W# w#
+wordToWord32 (W# w#) = W32# (w# `and#` (case (maxBound::Word32) of W32# x# -> x#))
+
+wordToWord64 (W# w#) = W64# (wordToWord64# w#)
+-- lossy on 32-bit platforms, but provided nontheless.
+word64ToWord (W64# w#) = W# (word64ToWord# w#)
+
+word2Integer :: Word# -> Integer
+word2Integer w | i >=# 0# = S# i
+ | otherwise = case word2Integer# w of
+ (# s, d #) -> J# s d
+ where i = word2Int# w
+\end{code}
+
+Misc utils.
+
+\begin{code}
+signumReal :: (Ord a, Num a) => a -> a
+signumReal x | x == 0 = 0
+ | x > 0 = 1
+ | otherwise = -1
+\end{code}
+
+Utils for generating friendly error messages.
+
+\begin{code}
+toEnumError :: (Show a,Show b) => String -> a -> (b,b) -> c
+toEnumError inst_ty tag bnds
+ = error ("Enum.toEnum{" ++ inst_ty ++ "}: tag " ++
+ (showParen True (showsPrec 0 tag) $
+ " is outside of bounds " ++
+ show bnds))
+
+fromEnumError :: (Show a,Show b) => String -> a -> b
+fromEnumError inst_ty tag
+ = error ("Enum.fromEnum{" ++ inst_ty ++ "}: value " ++
+ (showParen True (showsPrec 0 tag) $
+ " is outside of Int's bounds " ++
+ show (minBound::Int,maxBound::Int)))
+
+succError :: String -> a
+succError inst_ty
+ = error ("Enum.succ{" ++ inst_ty ++ "}: tried to take `succ' of maxBound")
+
+predError :: String -> a
+predError inst_ty
+ = error ("Enum.pred{" ++ inst_ty ++ "}: tried to take `pred' of minBound")
+
+divZeroError :: (Show a) => String -> a -> b
+divZeroError meth v
+ = error ("Integral." ++ meth ++ ": divide by 0 (" ++ show v ++ " / 0)")
+\end{code}
% ------------------------------------------------------------------------------
-% $Id: Time.lhs,v 1.23 2000/08/29 16:38:04 simonpj Exp $
+% $Id: Time.lhs,v 1.24 2000/12/12 12:19:58 simonmar Exp $
%
% (c) The University of Glasgow, 1995-2000
%
import PreludeBuiltin
#else
import PrelGHC ( RealWorld, (>#), (<#), (==#),
- newIntArray#, readIntArray#,
+ newByteArray#, readIntArray#,
unsafeFreezeByteArray#,
int2Integer#, negateInt# )
import PrelBase ( Int(..) )
import PrelPack ( unpackCString, unpackCStringBA,
new_ps_array, freeze_ps_array
)
-import PrelByteArr ( MutableByteArray(..) )
+import PrelByteArr ( MutableByteArray(..), wORD_SCALE )
import PrelHandle ( Bytes )
import PrelAddr ( Addr )
#else
malloc1 :: IO (MutableByteArray RealWorld Int)
malloc1 = IO $ \ s# ->
- case newIntArray# 1# s# of
+ case newByteArray# 1# s# of
(# s2#, barr# #) -> (# s2#, MutableByteArray bot bot barr# #)
where
bot = error "Time.malloc1"
allocWords :: Int -> IO (MutableByteArray RealWorld Int)
allocWords (I# size#) = IO $ \ s# ->
- case newIntArray# size# s# of
+ case newByteArray# (wORD_SCALE size#) s# of
(# s2#, barr# #) ->
(# s2#, MutableByteArray bot bot barr# #)
where
/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.2 2000/11/13 14:40:37 simonmar Exp $
+ * $Id: Linker.c,v 1.3 2000/12/12 12:19:57 simonmar Exp $
*
* (c) The GHC Team, 2000
*
SymX(gcdIntegerzh_fast) \
SymX(newArrayzh_fast) \
SymX(unsafeThawArrayzh_fast) \
- SymX(newDoubleArrayzh_fast) \
- SymX(newFloatArrayzh_fast) \
- SymX(newAddrArrayzh_fast) \
- SymX(newWordArrayzh_fast) \
- SymX(newIntArrayzh_fast) \
- SymX(newCharArrayzh_fast) \
+ SymX(newByteArrayzh_fast) \
SymX(newMutVarzh_fast) \
SymX(quotRemIntegerzh_fast) \
SymX(quotIntegerzh_fast) \
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.62 2000/12/11 12:59:25 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.63 2000/12/12 12:19:57 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
#define BYTES_TO_STGWORDS(n) ((n) + sizeof(W_) - 1)/sizeof(W_)
-#define newByteArray(ty,scale) \
- FN_(new##ty##Arrayzh_fast) \
+FN_(newByteArrayzh_fast) \
{ \
- W_ stuff_size, size, n; \
+ W_ size, stuff_size, n; \
StgArrWords* p; \
FB_ \
- MAYBE_GC(NO_PTRS,new##ty##Arrayzh_fast); \
+ MAYBE_GC(NO_PTRS,newByteArrayzh_fast); \
n = R1.w; \
- stuff_size = BYTES_TO_STGWORDS(n*scale); \
+ stuff_size = BYTES_TO_STGWORDS(n); \
size = sizeofW(StgArrWords)+ stuff_size; \
p = (StgArrWords *)RET_STGCALL1(P_,allocate,size); \
TICK_ALLOC_PRIM(sizeofW(StgArrWords),stuff_size,0); \
FE_ \
}
-newByteArray(Char, 1)
-/* Char arrays really contain only 8-bit bytes for compatibility. */
-newByteArray(Int, sizeof(I_))
-newByteArray(Word, sizeof(W_))
-newByteArray(Addr, sizeof(P_))
-newByteArray(Float, sizeof(StgFloat))
-newByteArray(Double, sizeof(StgDouble))
-newByteArray(StablePtr, sizeof(StgStablePtr))
-
FN_(newArrayzh_fast)
{
W_ size, n, init;
projects / ghc-hetmet.git / commitdiff