%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: CLabel.lhs,v 1.44 2000/12/04 12:31:19 simonmar Exp $
+% $Id: CLabel.lhs,v 1.45 2001/02/28 00:01:01 qrczak Exp $
%
\section[CLabel]{@CLabel@: Information to make C Labels}
import Name ( Name, getName, isDllName, isExternallyVisibleName )
import TyCon ( TyCon )
import Unique ( pprUnique, Unique )
-import PrimOp ( PrimOp, pprPrimOp )
+import PrimOp ( PrimOp )
import CostCentre ( CostCentre, CostCentreStack )
import Outputable
\end{code}
]
pprCLbl (RtsLabel (RtsPrimOp primop))
- = pprPrimOp primop <> ptext SLIT("_fast")
+ = ppr primop <> ptext SLIT("_fast")
pprCLbl (RtsLabel RtsModuleRegd)
= ptext SLIT("module_registered")
import Name ( NamedThing(..) )
import DataCon ( dataConWrapId )
import Maybes ( maybeToBool, catMaybes )
-import PrimOp ( primOpNeedsWrapper, pprPrimOp, pprCCallOp,
+import PrimOp ( primOpNeedsWrapper, pprCCallOp,
PrimOp(..), CCall(..), CCallTarget(..), isDynamicTarget )
-import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize, showPrimRep )
+import PrimRep ( isFloatingRep, PrimRep(..), getPrimRepSize )
import SMRep ( pprSMRep )
import Unique ( pprUnique, Unique{-instance NamedThing-} )
import UniqSet ( emptyUniqSet, elementOfUniqSet,
the_op
where
ppr_op_call results args
- = hcat [ pprPrimOp op, lparen,
+ = hcat [ ppr op, lparen,
hcat (punctuate comma (map ppr_op_result results)),
if null results || null args then empty else comma,
hcat (punctuate comma (map pprAmode args)),
ccall_res_ty =
case non_void_results of
[] -> ptext SLIT("void")
- [amode] -> text (showPrimRep (getAmodeRep amode))
+ [amode] -> ppr (getAmodeRep amode)
_ -> panic "pprAbsC{CCallTypedef}: ccall_res_ty"
ccall_decl_ty_args
| is_tdef = tail ccall_arg_tys
| otherwise = ccall_arg_tys
- ccall_arg_tys = map (text.showPrimRep.getAmodeRep) non_void_args
+ ccall_arg_tys = map (ppr . getAmodeRep) non_void_args
-- the first argument will be the "I/O world" token (a VoidRep)
-- all others should be non-void
getData (StString s) = panic "MachCode.stmtToInstrs: unlifted StString"
-- the linker can handle simple arithmetic...
getData (StIndex rep (StCLbl lbl) (StInt off)) =
- returnNat (nilOL,
- ImmIndex lbl (fromInteger (off * sizeOf rep)))
+ returnNat (nilOL,
+ ImmIndex lbl (fromInteger off * sizeOf rep))
-- Top-level lifted-out string. The segment will already have been set
-- (see liftStrings above).
mangleIndexTree (StIndex pk base (StInt i))
= StPrim IntAddOp [base, off]
where
- off = StInt (i * sizeOf pk)
+ off = StInt (i * toInteger (sizeOf pk))
mangleIndexTree (StIndex pk base off)
= StPrim IntAddOp [
]
where
shift :: PrimRep -> Int
- shift rep = case (fromInteger (sizeOf rep) :: Int) of
+ shift rep = case sizeOf rep of
1 -> 0
2 -> 1
4 -> 2
maybeImm (StCLbl l)
= Just (ImmCLbl l)
maybeImm (StIndex rep (StCLbl l) (StInt off))
- = Just (ImmIndex l (fromInteger (off * sizeOf rep)))
+ = Just (ImmIndex l (fromInteger off * sizeOf rep))
maybeImm (StInt i)
| i >= toInteger minInt && i <= toInteger maxInt
= Just (ImmInt (fromInteger i))
IntQuotOp -> trivialCode (DIV Q False) x y
IntRemOp -> trivialCode (REM Q False) x y
+ WordAddOp -> trivialCode (ADD Q False) x y
+ WordSubOp -> trivialCode (SUB Q False) x y
+ WordMulOp -> trivialCode (MUL Q False) x y
WordQuotOp -> trivialCode (DIV Q True) x y
WordRemOp -> trivialCode (REM Q True) x y
Double2IntOp -> coerceFP2Int x
Int2DoubleOp -> coerceInt2FP DoubleRep x
+ IntToInt8Op -> extendIntCode Int8Rep IntRep x
+ IntToInt16Op -> extendIntCode Int16Rep IntRep x
+ IntToInt32Op -> getRegister x
+ WordToWord8Op -> extendIntCode Word8Rep WordRep x
+ WordToWord16Op -> extendIntCode Word16Rep WordRep x
+ WordToWord32Op -> getRegister x
+
other_op ->
getRegister (StCall fn cCallConv DoubleRep [x])
where
DoubleLtOp -> condFltReg LTT x y
DoubleLeOp -> condFltReg LE x y
- IntAddOp -> add_code L x y
- IntSubOp -> sub_code L x y
+ IntAddOp -> add_code L x y
+ IntSubOp -> sub_code L x y
IntQuotOp -> trivialCode (IQUOT L) Nothing x y
IntRemOp -> trivialCode (IREM L) Nothing x y
IntMulOp -> let op = IMUL L in trivialCode op (Just op) x y
+ WordAddOp -> add_code L x y
+ WordSubOp -> sub_code L x y
+ WordMulOp -> let op = IMUL L in trivialCode op (Just op) x y
+
FloatAddOp -> trivialFCode FloatRep GADD x y
FloatSubOp -> trivialFCode FloatRep GSUB x y
FloatMulOp -> trivialFCode FloatRep GMUL x y
code__2 dst = code `snocOL`
if pk == DoubleRep || pk == FloatRep
then GLD size src dst
- else case size of
- L -> MOV L (OpAddr src) (OpReg dst)
- BU -> MOVZxL BU (OpAddr src) (OpReg dst)
+ else (case size of
+ B -> MOVSxL B
+ Bu -> MOVZxL Bu
+ W -> MOVSxL W
+ Wu -> MOVZxL Wu
+ L -> MOV L
+ Lu -> MOV L)
+ (OpAddr src) (OpReg dst)
in
returnNat (Any pk code__2)
IntSubOp -> trivialCode (SUB False False) x y
-- ToDo: teach about V8+ SPARC mul/div instructions
- IntMulOp -> imul_div SLIT(".umul") x y
- IntQuotOp -> imul_div SLIT(".div") x y
- IntRemOp -> imul_div SLIT(".rem") x y
+ IntMulOp -> imul_div SLIT(".umul") x y
+ IntQuotOp -> imul_div SLIT(".div") x y
+ IntRemOp -> imul_div SLIT(".rem") x y
+
+ WordAddOp -> trivialCode (ADD False False) x y
+ WordSubOp -> trivialCode (SUB False False) x y
+ WordMulOp -> imul_div SLIT(".umul") x y
FloatAddOp -> trivialFCode FloatRep FADD x y
FloatSubOp -> trivialFCode FloatRep FSUB x y
SllOp -> trivialCode SLL x y
SrlOp -> trivialCode SRL x y
- ISllOp -> trivialCode SLL x y --was: panic "SparcGen:isll"
- ISraOp -> trivialCode SRA x y --was: panic "SparcGen:isra"
- ISrlOp -> trivialCode SRL x y --was: panic "SparcGen:isrl"
+ ISllOp -> trivialCode SLL x y
+ ISraOp -> trivialCode SRA x y
+ ISrlOp -> trivialCode SRL x y
FloatPowerOp -> getRegister (StCall SLIT("pow") cCallConv DoubleRep
[promote x, promote y])
c_dst = registerCode reg_dst tmp -- should be empty
r_dst = registerName reg_dst tmp
szs = primRepToSize pks
- opc = case szs of L -> MOV L ; BU -> MOVZxL BU
+ opc = case szs of
+ B -> MOVSxL B
+ Bu -> MOVZxL Bu
+ W -> MOVSxL W
+ Wu -> MOVZxL Wu
+ L -> MOV L
+ Lu -> MOV L
code | isNilOL c_dst
= c_addr `snocOL`
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if i386_TARGET_ARCH
+extendIntCode :: PrimRep -> PrimRep -> StixTree -> NatM Register
+extendIntCode pks pkd x
+ = coerceIntCode pks x `thenNat` \ register ->
+ getNewRegNCG pks `thenNat` \ reg ->
+ let
+ code = registerCode register reg
+ src = registerName register reg
+ opc = case pkd of IntRep -> MOVSxL ; WordRep -> MOVZxL
+ sz = primRepToSize pks
+ code__2 dst = code `snocOL` opc sz (OpReg src) (OpReg dst)
+ in
+ returnNat (Any pkd code__2)
+
+------------
coerceInt2FP pk x
= getRegister x `thenNat` \ register ->
getNewRegNCG IntRep `thenNat` \ reg ->
Size of a @PrimRep@, in bytes.
\begin{code}
-sizeOf :: PrimRep -> Integer{-in bytes-}
- -- the result is an Integer only because it's more convenient
-
-sizeOf pr = case (primRepToSize pr) of
- IF_ARCH_alpha({B -> 1; BU -> 1; {-W -> 2; WU -> 2;-} L -> 4; {-SF -> 4;-} _ -> 8},)
- IF_ARCH_sparc({B -> 1; BU -> 1; W -> 4; F -> 4; DF -> 8},)
- IF_ARCH_i386( {B -> 1; BU -> 1; L -> 4; F -> 4; DF -> 8 },)
+sizeOf :: PrimRep -> Int{-in bytes-}
+sizeOf pr = case primRepToSize pr of
+ IF_ARCH_alpha({B->1; Bu->1; {-W->2; Wu->2;-} L->4; {-SF->4;-} Q->8; TF->8},)
+ IF_ARCH_i386 ({B->1; Bu->1; W->2; Wu->2; L->4; Lu->4; F->4; DF->8; F80->10},)
+ IF_ARCH_sparc({B->1; Bu->1; W->4; F->4; DF->8},)
\end{code}
% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
data Size
#if alpha_TARGET_ARCH
= B -- byte
- | BU
+ | Bu
-- | W -- word (2 bytes): UNUSED
--- | WU -- : UNUSED
+-- | Wu -- : UNUSED
| L -- longword (4 bytes)
| Q -- quadword (8 bytes)
-- | FF -- VAX F-style floating pt: UNUSED
| TF -- IEEE double-precision floating pt
#endif
#if i386_TARGET_ARCH
- = B -- byte (signed, JRS:??lower??)
- | BU -- byte, unsigned
- | L -- word32
+ = B -- byte (signed)
+ | Bu -- byte (unsigned)
+ | W -- word (signed)
+ | Wu -- word (unsigned)
+ | L -- longword (signed)
+ | Lu -- longword (unsigned)
| F -- IEEE single-precision floating pt
| DF -- IEEE single-precision floating pt
| F80 -- Intel 80-bit internal FP format; only used for spilling
#endif
#if sparc_TARGET_ARCH
= B -- byte (signed)
- | BU -- byte (unsigned)
- | W -- word, 4 bytes
+ | Bu -- byte (unsigned)
+ | W -- word (4 bytes)
| F -- IEEE single-precision floating pt
| DF -- IEEE single-precision floating pt
#endif
primRepToSize :: PrimRep -> Size
-primRepToSize PtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CodePtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize DataPtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize RetRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CostCentreRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize CharRep = IF_ARCH_alpha( L, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-
-primRepToSize Int8Rep = IF_ARCH_alpha( B, IF_ARCH_i386( B, IF_ARCH_sparc( B ,)))
-primRepToSize Word8Rep = IF_ARCH_alpha( BU, IF_ARCH_i386( BU, IF_ARCH_sparc( BU,)))
-
-primRepToSize IntRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize WordRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize AddrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize FloatRep = IF_ARCH_alpha( TF, IF_ARCH_i386( F, IF_ARCH_sparc( F ,)))
-primRepToSize DoubleRep = IF_ARCH_alpha( TF, IF_ARCH_i386( DF,IF_ARCH_sparc( DF,)))
-primRepToSize ArrayRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize ByteArrayRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize PrimPtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize WeakPtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize ForeignObjRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize BCORep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize StablePtrRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
-primRepToSize ThreadIdRep = IF_ARCH_alpha( Q, IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
+primRepToSize PtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize CodePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize DataPtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize RetRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize CostCentreRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize CharRep = IF_ARCH_alpha(L, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+
+primRepToSize Int8Rep = IF_ARCH_alpha(B, IF_ARCH_i386(B, IF_ARCH_sparc(B, )))
+primRepToSize Int16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(W, IF_ARCH_sparc(err,)))
+ where err = panic "primRepToSize Int16Rep"
+primRepToSize Int32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize Word8Rep = IF_ARCH_alpha(Bu, IF_ARCH_i386(Bu, IF_ARCH_sparc(Bu, )))
+primRepToSize Word16Rep = IF_ARCH_alpha(err,IF_ARCH_i386(Wu, IF_ARCH_sparc(err,)))
+ where err = panic "primRepToSize Word16Rep"
+primRepToSize Word32Rep = IF_ARCH_alpha(L, IF_ARCH_i386(Lu, IF_ARCH_sparc(W, )))
+
+primRepToSize IntRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize WordRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize AddrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize FloatRep = IF_ARCH_alpha(TF, IF_ARCH_i386(F, IF_ARCH_sparc(F, )))
+primRepToSize DoubleRep = IF_ARCH_alpha(TF, IF_ARCH_i386(DF, IF_ARCH_sparc(DF, )))
+primRepToSize ArrayRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize ByteArrayRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize PrimPtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize WeakPtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize ForeignObjRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize BCORep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize StablePtrRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
+primRepToSize ThreadIdRep = IF_ARCH_alpha(Q, IF_ARCH_i386(L, IF_ARCH_sparc(W, )))
-- SUP: Wrong!!! Only for testing the rest of the NCG
primRepToSize Word64Rep = trace "primRepToSize: Word64Rep not handled" B
primRepToSize Int64Rep = trace "primRepToSize: Int64Rep not handled" B
For x86, the way we print a register name depends
on which bit of it we care about. Yurgh.
\begin{code}
-pprUserReg:: Reg -> SDoc
+pprUserReg :: Reg -> SDoc
pprUserReg = pprReg IF_ARCH_i386(L,)
#endif
#if i386_TARGET_ARCH
ppr_reg_no :: Size -> Int -> SDoc
- ppr_reg_no B i= ptext
+ ppr_reg_no B = ppr_reg_byte
+ ppr_reg_no Bu = ppr_reg_byte
+ ppr_reg_no W = ppr_reg_word
+ ppr_reg_no Wu = ppr_reg_word
+ ppr_reg_no _ = ppr_reg_long
+
+ ppr_reg_byte i = ptext
(case i of {
- 0 -> SLIT("%al"); 1 -> SLIT("%bl");
- 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
+ 0 -> SLIT("%al"); 1 -> SLIT("%bl");
+ 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
_ -> SLIT("very naughty I386 byte register")
})
- ppr_reg_no _ i = ptext
+ ppr_reg_word i = ptext
(case i of {
- 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
- 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
- 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
- 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
- 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
- 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
- 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
+ 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
+ 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
+ 4 -> SLIT("%si"); 5 -> SLIT("%di");
+ 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
+ _ -> SLIT("very naughty I386 word register")
+ })
+
+ ppr_reg_long i = ptext
+ (case i of {
+ 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
+ 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
+ 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
+ 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
+ 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
+ 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
+ 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
_ -> SLIT("very naughty I386 register")
})
#endif
pprSize x = ptext (case x of
#if alpha_TARGET_ARCH
B -> SLIT("b")
- BU -> SLIT("bu")
+ Bu -> SLIT("bu")
-- W -> SLIT("w") UNUSED
--- WU -> SLIT("wu") UNUSED
+-- Wu -> SLIT("wu") UNUSED
L -> SLIT("l")
Q -> SLIT("q")
-- FF -> SLIT("f") UNUSED
TF -> SLIT("t")
#endif
#if i386_TARGET_ARCH
- BU -> SLIT("b")
+ B -> SLIT("b")
+ Bu -> SLIT("b")
+ W -> SLIT("w")
+ Wu -> SLIT("w")
L -> SLIT("l")
+ Lu -> SLIT("l")
F -> SLIT("s")
DF -> SLIT("l")
F80 -> SLIT("t")
#endif
#if sparc_TARGET_ARCH
B -> SLIT("sb")
- BU -> SLIT("ub")
+ Bu -> SLIT("ub")
W -> SLIT("")
F -> SLIT("")
DF -> SLIT("d")
pprStSize :: Size -> SDoc
pprStSize x = ptext (case x of
B -> SLIT("b")
- BU -> SLIT("b")
+ Bu -> SLIT("b")
W -> SLIT("")
F -> SLIT("")
DF -> SLIT("d")
regUsage instr = case instr of
LD B reg addr -> usage (regAddr addr, [reg, t9])
- LD BU reg addr -> usage (regAddr addr, [reg, t9])
+ LD Bu reg addr -> usage (regAddr addr, [reg, t9])
-- LD W reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
--- LD WU reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
+-- LD Wu reg addr -> usage (regAddr addr, [reg, t9]) : UNUSED
LD sz reg addr -> usage (regAddr addr, [reg])
LDA reg addr -> usage (regAddr addr, [reg])
LDAH reg addr -> usage (regAddr addr, [reg])
import AbsCSyn ( node, tagreg, MagicId(..) )
import CallConv ( CallConv, pprCallConv )
import CLabel ( mkAsmTempLabel, CLabel, pprCLabel )
-import PrimRep ( PrimRep(..), showPrimRep )
-import PrimOp ( PrimOp, pprPrimOp )
+import PrimRep ( PrimRep(..) )
+import PrimOp ( PrimOp )
import Unique ( Unique )
import SMRep ( fixedHdrSize, arrWordsHdrSize, arrPtrsHdrSize )
import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply,
StCLbl lbl -> pprCLabel lbl
StReg reg -> ppStixReg reg
StIndex k b o -> paren (pprStixTree b <+> char '+' <>
- pprPrimRep k <+> pprStixTree o)
- StInd k t -> pprPrimRep k <> char '[' <> pprStixTree t <> char ']'
- StAssign k d s -> pprStixTree d <> text " :=" <> pprPrimRep k
+ ppr k <+> pprStixTree o)
+ StInd k t -> ppr k <> char '[' <> pprStixTree t <> char ']'
+ StAssign k d s -> pprStixTree d <> text " :=" <> ppr k
<> text " " <> pprStixTree s
StLabel ll -> pprCLabel ll <+> char ':'
StFunBegin ll -> char ' ' $$ paren (text "FunBegin" <+> pprCLabel ll)
StFallThrough ll -> paren (text "FallThru" <+> pprCLabel ll)
StCondJump l t -> paren (text "JumpC" <+> pprCLabel l
<+> pprStixTree t)
- StData k ds -> paren (text "Data" <+> pprPrimRep k <+>
+ StData k ds -> paren (text "Data" <+> ppr k <+>
hsep (map pprStixTree ds))
- StPrim op ts -> paren (text "Prim" <+> pprPrimOp op <+>
+ StPrim op ts -> paren (text "Prim" <+> ppr op <+>
hsep (map pprStixTree ts))
StCall nm cc k args
-> paren (text "Call" <+> ptext nm <+>
- pprCallConv cc <+> pprPrimRep k <+>
+ pprCallConv cc <+> ppr k <+>
hsep (map pprStixTree args))
StScratchWord i -> text "ScratchWord" <> paren (int i)
-
-pprPrimRep = text . showPrimRep
\end{code}
Stix registers can have two forms. They {\em may} or {\em may not}
ppMId BaseReg = text "BaseReg"
-ppMId (VanillaReg kind n) = hcat [pprPrimRep kind, text "IntReg(",
+ppMId (VanillaReg kind n) = hcat [ppr kind, text "IntReg(",
int (iBox n), char ')']
ppMId (FloatReg n) = hcat [text "FltReg(", int (iBox n), char ')']
ppMId (DoubleReg n) = hcat [text "DblReg(", int (iBox n), char ')']
-ppMId (LongReg kind n) = hcat [pprPrimRep kind, text "LongReg(",
+ppMId (LongReg kind n) = hcat [ppr kind, text "LongReg(",
int (iBox n), char ')']
ppMId Sp = text "Sp"
ppMId Su = text "Su"
-- NB: indexing in "pk" units, *not* in bytes (WDP 95/09)
primCode ls IndexByteArrayOp_Char rs = primCode_ReadByteArrayOp Word8Rep ls rs
+primCode ls IndexByteArrayOp_WideChar rs = primCode_ReadByteArrayOp CharRep ls rs
primCode ls IndexByteArrayOp_Int rs = primCode_ReadByteArrayOp IntRep ls rs
primCode ls IndexByteArrayOp_Word rs = primCode_ReadByteArrayOp WordRep ls rs
primCode ls IndexByteArrayOp_Addr rs = primCode_ReadByteArrayOp AddrRep ls rs
primCode ls IndexByteArrayOp_Float rs = primCode_ReadByteArrayOp FloatRep ls rs
primCode ls IndexByteArrayOp_Double rs = primCode_ReadByteArrayOp DoubleRep ls rs
primCode ls IndexByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs
+primCode ls IndexByteArrayOp_Int8 rs = primCode_ReadByteArrayOp Int8Rep ls rs
+primCode ls IndexByteArrayOp_Int16 rs = primCode_ReadByteArrayOp Int16Rep ls rs
+primCode ls IndexByteArrayOp_Int32 rs = primCode_ReadByteArrayOp Int32Rep ls rs
primCode ls IndexByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs
+primCode ls IndexByteArrayOp_Word8 rs = primCode_ReadByteArrayOp Word8Rep ls rs
+primCode ls IndexByteArrayOp_Word16 rs = primCode_ReadByteArrayOp Word16Rep ls rs
+primCode ls IndexByteArrayOp_Word32 rs = primCode_ReadByteArrayOp Word32Rep ls rs
primCode ls IndexByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep ls rs
primCode ls ReadByteArrayOp_Char rs = primCode_ReadByteArrayOp Word8Rep ls rs
+primCode ls ReadByteArrayOp_WideChar rs = primCode_ReadByteArrayOp CharRep ls rs
primCode ls ReadByteArrayOp_Int rs = primCode_ReadByteArrayOp IntRep ls rs
primCode ls ReadByteArrayOp_Word rs = primCode_ReadByteArrayOp WordRep ls rs
primCode ls ReadByteArrayOp_Addr rs = primCode_ReadByteArrayOp AddrRep ls rs
primCode ls ReadByteArrayOp_Float rs = primCode_ReadByteArrayOp FloatRep ls rs
primCode ls ReadByteArrayOp_Double rs = primCode_ReadByteArrayOp DoubleRep ls rs
primCode ls ReadByteArrayOp_StablePtr rs = primCode_ReadByteArrayOp StablePtrRep ls rs
+primCode ls ReadByteArrayOp_Int8 rs = primCode_ReadByteArrayOp Int8Rep ls rs
+primCode ls ReadByteArrayOp_Int16 rs = primCode_ReadByteArrayOp Int16Rep ls rs
+primCode ls ReadByteArrayOp_Int32 rs = primCode_ReadByteArrayOp Int32Rep ls rs
primCode ls ReadByteArrayOp_Int64 rs = primCode_ReadByteArrayOp Int64Rep ls rs
+primCode ls ReadByteArrayOp_Word8 rs = primCode_ReadByteArrayOp Word8Rep ls rs
+primCode ls ReadByteArrayOp_Word16 rs = primCode_ReadByteArrayOp Word16Rep ls rs
+primCode ls ReadByteArrayOp_Word32 rs = primCode_ReadByteArrayOp Word32Rep ls rs
primCode ls ReadByteArrayOp_Word64 rs = primCode_ReadByteArrayOp Word64Rep ls rs
-primCode ls ReadOffAddrOp_Char rs = primCode_IndexOffAddrOp Word8Rep ls rs
-primCode ls ReadOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs
-primCode ls ReadOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs
-primCode ls ReadOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs
-primCode ls ReadOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs
-primCode ls ReadOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs
-primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
-primCode ls ReadOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs
-primCode ls ReadOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs
+primCode ls WriteByteArrayOp_Char rs = primCode_WriteByteArrayOp Word8Rep ls rs
+primCode ls WriteByteArrayOp_WideChar rs = primCode_WriteByteArrayOp CharRep ls rs
+primCode ls WriteByteArrayOp_Int rs = primCode_WriteByteArrayOp IntRep ls rs
+primCode ls WriteByteArrayOp_Word rs = primCode_WriteByteArrayOp WordRep ls rs
+primCode ls WriteByteArrayOp_Addr rs = primCode_WriteByteArrayOp AddrRep ls rs
+primCode ls WriteByteArrayOp_Float rs = primCode_WriteByteArrayOp FloatRep ls rs
+primCode ls WriteByteArrayOp_Double rs = primCode_WriteByteArrayOp DoubleRep ls rs
+primCode ls WriteByteArrayOp_StablePtr rs = primCode_WriteByteArrayOp StablePtrRep ls rs
+primCode ls WriteByteArrayOp_Int8 rs = primCode_WriteByteArrayOp Int8Rep ls rs
+primCode ls WriteByteArrayOp_Int16 rs = primCode_WriteByteArrayOp Int16Rep ls rs
+primCode ls WriteByteArrayOp_Int32 rs = primCode_WriteByteArrayOp Int32Rep ls rs
+primCode ls WriteByteArrayOp_Int64 rs = primCode_WriteByteArrayOp Int64Rep ls rs
+primCode ls WriteByteArrayOp_Word8 rs = primCode_WriteByteArrayOp Word8Rep ls rs
+primCode ls WriteByteArrayOp_Word16 rs = primCode_WriteByteArrayOp Word16Rep ls rs
+primCode ls WriteByteArrayOp_Word32 rs = primCode_WriteByteArrayOp Word32Rep ls rs
+primCode ls WriteByteArrayOp_Word64 rs = primCode_WriteByteArrayOp Word64Rep ls rs
primCode ls IndexOffAddrOp_Char rs = primCode_IndexOffAddrOp Word8Rep ls rs
+primCode ls IndexOffAddrOp_WideChar rs = primCode_IndexOffAddrOp CharRep ls rs
primCode ls IndexOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs
primCode ls IndexOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs
primCode ls IndexOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs
primCode ls IndexOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs
primCode ls IndexOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs
primCode ls IndexOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
+primCode ls IndexOffAddrOp_Int8 rs = primCode_IndexOffAddrOp Int8Rep ls rs
+primCode ls IndexOffAddrOp_Int16 rs = primCode_IndexOffAddrOp Int16Rep ls rs
+primCode ls IndexOffAddrOp_Int32 rs = primCode_IndexOffAddrOp Int32Rep ls rs
primCode ls IndexOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs
+primCode ls IndexOffAddrOp_Word8 rs = primCode_IndexOffAddrOp Word8Rep ls rs
+primCode ls IndexOffAddrOp_Word16 rs = primCode_IndexOffAddrOp Word16Rep ls rs
+primCode ls IndexOffAddrOp_Word32 rs = primCode_IndexOffAddrOp Word32Rep ls rs
primCode ls IndexOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs
primCode ls IndexOffForeignObjOp_Char rs = primCode_IndexOffForeignObjOp Word8Rep ls rs
+primCode ls IndexOffForeignObjOp_WideChar rs = primCode_IndexOffForeignObjOp CharRep ls rs
primCode ls IndexOffForeignObjOp_Int rs = primCode_IndexOffForeignObjOp IntRep ls rs
primCode ls IndexOffForeignObjOp_Word rs = primCode_IndexOffForeignObjOp WordRep ls rs
primCode ls IndexOffForeignObjOp_Addr rs = primCode_IndexOffForeignObjOp AddrRep ls rs
primCode ls IndexOffForeignObjOp_Float rs = primCode_IndexOffForeignObjOp FloatRep ls rs
primCode ls IndexOffForeignObjOp_Double rs = primCode_IndexOffForeignObjOp DoubleRep ls rs
primCode ls IndexOffForeignObjOp_StablePtr rs = primCode_IndexOffForeignObjOp StablePtrRep ls rs
+primCode ls IndexOffForeignObjOp_Int8 rs = primCode_IndexOffForeignObjOp Int8Rep ls rs
+primCode ls IndexOffForeignObjOp_Int16 rs = primCode_IndexOffForeignObjOp Int16Rep ls rs
+primCode ls IndexOffForeignObjOp_Int32 rs = primCode_IndexOffForeignObjOp Int32Rep ls rs
primCode ls IndexOffForeignObjOp_Int64 rs = primCode_IndexOffForeignObjOp Int64Rep ls rs
+primCode ls IndexOffForeignObjOp_Word8 rs = primCode_IndexOffForeignObjOp Word8Rep ls rs
+primCode ls IndexOffForeignObjOp_Word16 rs = primCode_IndexOffForeignObjOp Word16Rep ls rs
+primCode ls IndexOffForeignObjOp_Word32 rs = primCode_IndexOffForeignObjOp Word32Rep ls rs
primCode ls IndexOffForeignObjOp_Word64 rs = primCode_IndexOffForeignObjOp Word64Rep ls rs
-primCode ls WriteOffAddrOp_Word8 rs = primCode_WriteOffAddrOp Word8Rep ls rs
+primCode ls ReadOffAddrOp_Char rs = primCode_IndexOffAddrOp Word8Rep ls rs
+primCode ls ReadOffAddrOp_WideChar rs = primCode_IndexOffAddrOp CharRep ls rs
+primCode ls ReadOffAddrOp_Int rs = primCode_IndexOffAddrOp IntRep ls rs
+primCode ls ReadOffAddrOp_Word rs = primCode_IndexOffAddrOp WordRep ls rs
+primCode ls ReadOffAddrOp_Addr rs = primCode_IndexOffAddrOp AddrRep ls rs
+primCode ls ReadOffAddrOp_Float rs = primCode_IndexOffAddrOp FloatRep ls rs
+primCode ls ReadOffAddrOp_Double rs = primCode_IndexOffAddrOp DoubleRep ls rs
+primCode ls ReadOffAddrOp_StablePtr rs = primCode_IndexOffAddrOp StablePtrRep ls rs
+primCode ls ReadOffAddrOp_Int8 rs = primCode_IndexOffAddrOp Int8Rep ls rs
+primCode ls ReadOffAddrOp_Int16 rs = primCode_IndexOffAddrOp Int16Rep ls rs
+primCode ls ReadOffAddrOp_Int32 rs = primCode_IndexOffAddrOp Int32Rep ls rs
+primCode ls ReadOffAddrOp_Int64 rs = primCode_IndexOffAddrOp Int64Rep ls rs
+primCode ls ReadOffAddrOp_Word8 rs = primCode_IndexOffAddrOp Word8Rep ls rs
+primCode ls ReadOffAddrOp_Word16 rs = primCode_IndexOffAddrOp Word16Rep ls rs
+primCode ls ReadOffAddrOp_Word32 rs = primCode_IndexOffAddrOp Word32Rep ls rs
+primCode ls ReadOffAddrOp_Word64 rs = primCode_IndexOffAddrOp Word64Rep ls rs
+
primCode ls WriteOffAddrOp_Char rs = primCode_WriteOffAddrOp Word8Rep ls rs
+primCode ls WriteOffAddrOp_WideChar rs = primCode_WriteOffAddrOp CharRep ls rs
primCode ls WriteOffAddrOp_Int rs = primCode_WriteOffAddrOp IntRep ls rs
primCode ls WriteOffAddrOp_Word rs = primCode_WriteOffAddrOp WordRep ls rs
primCode ls WriteOffAddrOp_Addr rs = primCode_WriteOffAddrOp AddrRep ls rs
primCode ls WriteOffAddrOp_Float rs = primCode_WriteOffAddrOp FloatRep ls rs
primCode ls WriteOffAddrOp_Double rs = primCode_WriteOffAddrOp DoubleRep ls rs
primCode ls WriteOffAddrOp_StablePtr rs = primCode_WriteOffAddrOp StablePtrRep ls rs
+primCode ls WriteOffAddrOp_Int8 rs = primCode_WriteOffAddrOp Int8Rep ls rs
+primCode ls WriteOffAddrOp_Int16 rs = primCode_WriteOffAddrOp Int16Rep ls rs
+primCode ls WriteOffAddrOp_Int32 rs = primCode_WriteOffAddrOp Int32Rep ls rs
primCode ls WriteOffAddrOp_Int64 rs = primCode_WriteOffAddrOp Int64Rep ls rs
+primCode ls WriteOffAddrOp_Word8 rs = primCode_WriteOffAddrOp Word8Rep ls rs
+primCode ls WriteOffAddrOp_Word16 rs = primCode_WriteOffAddrOp Word16Rep ls rs
+primCode ls WriteOffAddrOp_Word32 rs = primCode_WriteOffAddrOp Word32Rep ls rs
primCode ls WriteOffAddrOp_Word64 rs = primCode_WriteOffAddrOp Word64Rep ls rs
-primCode ls WriteByteArrayOp_Char rs = primCode_WriteByteArrayOp Word8Rep ls rs
-primCode ls WriteByteArrayOp_Int rs = primCode_WriteByteArrayOp IntRep ls rs
-primCode ls WriteByteArrayOp_Word rs = primCode_WriteByteArrayOp WordRep ls rs
-primCode ls WriteByteArrayOp_Addr rs = primCode_WriteByteArrayOp AddrRep ls rs
-primCode ls WriteByteArrayOp_Float rs = primCode_WriteByteArrayOp FloatRep ls rs
-primCode ls WriteByteArrayOp_Double rs = primCode_WriteByteArrayOp DoubleRep ls rs
-primCode ls WriteByteArrayOp_StablePtr rs = primCode_WriteByteArrayOp StablePtrRep ls rs
-primCode ls WriteByteArrayOp_Int64 rs = primCode_WriteByteArrayOp Int64Rep ls rs
-primCode ls WriteByteArrayOp_Word64 rs = primCode_WriteByteArrayOp Word64Rep ls rs
-
\end{code}
ToDo: saving/restoring of volatile regs around ccalls.
mutArrPtrsFrozen_info = StCLbl mkMAP_FROZEN_infoLabel
-- these are the sizes of charLike and intLike closures, in _bytes_.
-charLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
-intLikeSize = (fixedHdrSize + 1) * (fromInteger (sizeOf PtrRep))
+charLikeSize = (fixedHdrSize + 1) * (sizeOf PtrRep)
+intLikeSize = (fixedHdrSize + 1) * (sizeOf PtrRep)
\end{code}
getPrimOpResultInfo, PrimOpResultInfo(..),
- pprPrimOp,
-
CCall(..), CCallTarget(..), ccallMayGC, ccallIsCasm, pprCCallOp,
isDynamicTarget, dynamicTarget, setCCallUnique
) where
, getPrimRepSize
, getPrimRepSizeInBytes
, retPrimRepSize
- , showPrimRep
- , primRepString
- , showPrimRepToUser
) where
#include "HsVersions.h"
| CostCentreRep -- Pointer to a cost centre
| CharRep -- Machine characters
- | IntRep -- integers (same size as ptr on this arch)
- | WordRep -- ditto (but *unsigned*)
- | AddrRep -- addresses ("C pointers")
+ | IntRep -- signed integers (same size as ptr on this arch)
+ | WordRep -- unsigned integers (same size as ptr on this arch)
+ | AddrRep -- addresses (C pointers)
| FloatRep -- floats
| DoubleRep -- doubles
- | Word64Rep -- guaranteed to be 64 bits (no more, no less.)
- | Int64Rep -- guaranteed to be 64 bits (no more, no less.)
-
- -- These are not expected to appear in the front end. They are
- -- only here to help the native code generator, and should appear
- -- nowhere else.
- | Int8Rep -- 8 bit signed integers
- | Word8Rep -- 8 bit unsigned integers
+
+ | Int8Rep -- 8 bit signed integers
| Int16Rep -- 16 bit signed integers
- | Word16Rep -- 16 bit unsigned integers
| Int32Rep -- 32 bit signed integers
+ | Int64Rep -- 64 bit signed integers
+ | Word8Rep -- 8 bit unsigned integers
+ | Word16Rep -- 16 bit unsigned integers
| Word32Rep -- 32 bit unsigned integers
-
- -- Perhaps all sized integers and words should be primitive types.
-
- -- Word8Rep is currently used to simulate some old CharRep usages
- -- when Char changed size from 8 to 31 bits. It does not correspond
- -- to a Haskell unboxed type, in particular it's not used by Word8.
-
+ | Word64Rep -- 64 bit unsigned integers
+
| WeakPtrRep
| ForeignObjRep
| BCORep
\begin{code}
isFloatingRep :: PrimRep -> Bool
-
isFloatingRep DoubleRep = True
isFloatingRep FloatRep = True
-isFloatingRep other = False
-
+isFloatingRep _ = False
\end{code}
\begin{code}
is64BitRep :: PrimRep -> Bool
-
is64BitRep Int64Rep = True
is64BitRep Word64Rep = True
-is64BitRep other = False
-
+is64BitRep _ = False
\end{code}
-
-
\begin{code}
getPrimRepSize :: PrimRep -> Int
+getPrimRepSize DoubleRep = dOUBLE_SIZE -- "words", of course
+getPrimRepSize Word64Rep = wORD64_SIZE
+getPrimRepSize Int64Rep = iNT64_SIZE
+getPrimRepSize VoidRep = 0
+getPrimRepSize _ = 1
-getPrimRepSize DoubleRep = dOUBLE_SIZE -- "words", of course
-getPrimRepSize Word64Rep = wORD64_SIZE
-getPrimRepSize Int64Rep = iNT64_SIZE
-getPrimRepSize VoidRep = 0
-getPrimRepSize other = 1
-
+retPrimRepSize :: Int
retPrimRepSize = getPrimRepSize RetRep
-- sizes in bytes.
-- we have to push onto the stack when calling external
-- entry points (e.g., stdcalling on win32)
getPrimRepSizeInBytes :: PrimRep -> Int
-getPrimRepSizeInBytes pr =
- case pr of
- Int8Rep -> 1
- Word8Rep -> 1
- Int16Rep -> 2
- Word16Rep -> 2
- Int32Rep -> 4
- Word32Rep -> 4
-
- CharRep -> 4
- IntRep -> wORD_SIZE
- AddrRep -> wORD_SIZE
- FloatRep -> wORD_SIZE
- DoubleRep -> dOUBLE_SIZE * wORD_SIZE
- Word64Rep -> wORD64_SIZE * wORD_SIZE
- Int64Rep -> iNT64_SIZE * wORD_SIZE
- WeakPtrRep -> wORD_SIZE
- ForeignObjRep -> wORD_SIZE
- StablePtrRep -> wORD_SIZE
- StableNameRep -> wORD_SIZE
- ArrayRep -> wORD_SIZE
- ByteArrayRep -> wORD_SIZE
- _ -> panic "getPrimRepSize: ouch - this wasn't supposed to happen!"
+getPrimRepSizeInBytes CharRep = 4
+getPrimRepSizeInBytes IntRep = wORD_SIZE
+getPrimRepSizeInBytes WordRep = wORD_SIZE
+getPrimRepSizeInBytes AddrRep = wORD_SIZE
+getPrimRepSizeInBytes FloatRep = wORD_SIZE
+getPrimRepSizeInBytes DoubleRep = dOUBLE_SIZE * wORD_SIZE
+getPrimRepSizeInBytes Int8Rep = 1
+getPrimRepSizeInBytes Int16Rep = 2
+getPrimRepSizeInBytes Int32Rep = 4
+getPrimRepSizeInBytes Int64Rep = 8
+getPrimRepSizeInBytes Word8Rep = 1
+getPrimRepSizeInBytes Word16Rep = 2
+getPrimRepSizeInBytes Word32Rep = 4
+getPrimRepSizeInBytes Word64Rep = 8
+getPrimRepSizeInBytes WeakPtrRep = wORD_SIZE
+getPrimRepSizeInBytes ForeignObjRep = wORD_SIZE
+getPrimRepSizeInBytes StablePtrRep = wORD_SIZE
+getPrimRepSizeInBytes StableNameRep = wORD_SIZE
+getPrimRepSizeInBytes ArrayRep = wORD_SIZE
+getPrimRepSizeInBytes ByteArrayRep = wORD_SIZE
+getPrimRepSizeInBytes _ = panic "getPrimRepSize: ouch - this wasn't supposed to happen!"
\end{code}
ppr kind = text (showPrimRep kind)
showPrimRep :: PrimRep -> String
-showPrimRepToUser :: PrimRep -> String
-
showPrimRep PtrRep = "P_" -- short for StgPtr
showPrimRep CodePtrRep = "P_" -- DEATH to StgFunPtr! (94/02/22 WDP)
showPrimRep DataPtrRep = "D_"
showPrimRep ForeignObjRep = "StgAddr"
showPrimRep VoidRep = "!!VOID_KIND!!"
showPrimRep BCORep = "P_" -- not sure -- JRS 000708
-
-primRepString CharRep = "Char"
-primRepString Int8Rep = "Char" -- To have names like newCharArray#
-primRepString IntRep = "Int"
-primRepString WordRep = "Word"
-primRepString Int64Rep = "Int64"
-primRepString Word64Rep = "Word64"
-primRepString AddrRep = "Addr"
-primRepString FloatRep = "Float"
-primRepString DoubleRep = "Double"
-primRepString WeakPtrRep = "Weak"
-primRepString ForeignObjRep = "ForeignObj"
-primRepString StablePtrRep = "StablePtr"
-primRepString StableNameRep = "StableName"
-primRepString other = pprPanic "primRepString" (ppr other)
-
-showPrimRepToUser pr = primRepString pr
\end{code}
Foreign Objects and Arrays are treated specially by the code for
-----------------------------------------------------------------------
--- $Id: primops.txt,v 1.17 2001/02/15 17:22:15 sewardj Exp $
+-- $Id: primops.txt,v 1.18 2001/02/28 00:01:02 qrczak Exp $
--
-- Primitive Operations
--
--- Word# ---
------------------------------------------------------------------------
-primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word#
-primop WordRemOp "remWord#" Dyadic Word# -> Word# -> Word#
+primop WordAddOp "plusWord#" Dyadic Word# -> Word# -> Word#
+ with commutable = True
+
+primop WordSubOp "minusWord#" Dyadic Word# -> Word# -> Word#
+
+primop WordMulOp "timesWord#" Dyadic Word# -> Word# -> Word#
+ with commutable = True
+
+primop WordQuotOp "quotWord#" Dyadic Word# -> Word# -> Word#
+ with can_fail = True
+
+primop WordRemOp "remWord#" Dyadic Word# -> Word# -> Word#
+ with can_fail = True
-primop AndOp "and#" Dyadic
- Word# -> Word# -> Word#
+primop AndOp "and#" Dyadic Word# -> Word# -> Word#
with commutable = True
-primop OrOp "or#" Dyadic
- Word# -> Word# -> Word#
+primop OrOp "or#" Dyadic Word# -> Word# -> Word#
with commutable = True
-primop XorOp "xor#" Dyadic
- Word# -> Word# -> Word#
+primop XorOp "xor#" Dyadic Word# -> Word# -> Word#
with commutable = True
-primop NotOp "not#" Monadic Word# -> Word#
+primop NotOp "not#" Monadic Word# -> Word#
-primop SllOp "shiftL#" GenPrimOp Word# -> Int# -> Word#
-primop SrlOp "shiftRL#" GenPrimOp Word# -> Int# -> Word#
+primop SllOp "shiftL#" GenPrimOp Word# -> Int# -> Word#
+primop SrlOp "shiftRL#" GenPrimOp Word# -> Int# -> Word#
-primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int#
+primop Word2IntOp "word2Int#" GenPrimOp Word# -> Int#
-primop Word2IntegerOp "word2Integer#" GenPrimOp
+primop Word2IntegerOp "word2Integer#" GenPrimOp
Word# -> (# Int#, ByteArr# #)
with out_of_line = True
-primop WordGtOp "gtWord#" Compare Word# -> Word# -> Bool
-primop WordGeOp "geWord#" Compare Word# -> Word# -> Bool
-primop WordEqOp "eqWord#" Compare Word# -> Word# -> Bool
-primop WordNeOp "neWord#" Compare Word# -> Word# -> Bool
-primop WordLtOp "ltWord#" Compare Word# -> Word# -> Bool
-primop WordLeOp "leWord#" Compare Word# -> Word# -> Bool
+primop WordGtOp "gtWord#" Compare Word# -> Word# -> Bool
+primop WordGeOp "geWord#" Compare Word# -> Word# -> Bool
+primop WordEqOp "eqWord#" Compare Word# -> Word# -> Bool
+primop WordNeOp "neWord#" Compare Word# -> Word# -> Bool
+primop WordLtOp "ltWord#" Compare Word# -> Word# -> Bool
+primop WordLeOp "leWord#" Compare Word# -> Word# -> Bool
------------------------------------------------------------------------
--- Word64# ---
Word64# -> (# Int#, ByteArr# #)
with out_of_line = True
+------------------------------------------------------------------------
+--- Explicitly sized Int# and Word# ---
+------------------------------------------------------------------------
+
+primop IntToInt8Op "intToInt8#" Monadic Int# -> Int#
+primop IntToInt16Op "intToInt16#" Monadic Int# -> Int#
+primop IntToInt32Op "intToInt32#" Monadic Int# -> Int#
+primop WordToWord8Op "wordToWord8#" Monadic Word# -> Word#
+primop WordToWord16Op "wordToWord16#" Monadic Word# -> Word#
+primop WordToWord32Op "wordToWord32#" Monadic Word# -> Word#
------------------------------------------------------------------------
--- Arrays ---
------------------------------------------------------------------------
+primop NewArrayOp "newArray#" GenPrimOp
+ Int# -> a -> State# s -> (# State# s, MutArr# s a #)
+ with
+ strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
+ usage = { mangle NewArrayOp [mkP, mkM, mkP] mkM }
+ out_of_line = True
+
primop NewByteArrayOp_Char "newByteArray#" GenPrimOp
Int# -> State# s -> (# State# s, MutByteArr# s #)
with out_of_line = True
+primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
+ ByteArr# -> Int# -> Char#
+
+primop IndexByteArrayOp_WideChar "indexWideCharArray#" GenPrimOp
+ ByteArr# -> Int# -> Char#
+
+primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp
+ ByteArr# -> Int# -> Addr#
+
+primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp
+ ByteArr# -> Int# -> Float#
+
+primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp
+ ByteArr# -> Int# -> Double#
+
+primop IndexByteArrayOp_StablePtr "indexStablePtrArray#" GenPrimOp
+ ByteArr# -> Int# -> StablePtr# a
+
+primop IndexByteArrayOp_Int8 "indexInt8Array#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Int16 "indexInt16Array#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Int32 "indexInt32Array#" GenPrimOp
+ ByteArr# -> Int# -> Int#
+
+primop IndexByteArrayOp_Int64 "indexInt64Array#" GenPrimOp
+ ByteArr# -> Int# -> Int64#
+
+primop IndexByteArrayOp_Word8 "indexWord8Array#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Word16 "indexWord16Array#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Word32 "indexWord32Array#" GenPrimOp
+ ByteArr# -> Int# -> Word#
+
+primop IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
+ ByteArr# -> Int# -> Word64#
+
+
primop ReadByteArrayOp_Char "readCharArray#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
+primop ReadByteArrayOp_WideChar "readWideCharArray#" GenPrimOp
+ MutByteArr# s -> Int# -> State# s -> (# State# s, Char# #)
+
primop ReadByteArrayOp_Int "readIntArray#" GenPrimOp
MutByteArr# s -> Int# -> State# s -> (# State# s, Int# #)
MutByteArr# s -> Int# -> Char# -> State# s -> State# s
with has_side_effects = True
+primop WriteByteArrayOp_WideChar "writeWideCharArray#" GenPrimOp
+ MutByteArr# s -> Int# -> Char# -> State# s -> State# s
+ with has_side_effects = True
+
primop WriteByteArrayOp_Int "writeIntArray#" GenPrimOp
MutByteArr# s -> Int# -> Int# -> State# s -> State# s
with has_side_effects = True
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
+primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Int# -> State# s -> State# s
with has_side_effects = True
-primop WriteByteArrayOp_Int16 "writeInt16Array#" GenPrimOp
+primop WriteByteArrayOp_Int32 "writeInt32Array#" 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
+primop WriteByteArrayOp_Int64 "writeInt64Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Int64# -> State# s -> State# s
with has_side_effects = True
-primop WriteByteArrayOp_Int32 "writeInt32Array#" GenPrimOp
- MutByteArr# s -> Int# -> Int# -> State# s -> State# s
+primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Word# -> State# s -> State# s
with has_side_effects = True
-primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
+primop WriteByteArrayOp_Word16 "writeWord16Array#" 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
+primop WriteByteArrayOp_Word32 "writeWord32Array#" GenPrimOp
+ MutByteArr# s -> Int# -> Word# -> State# s -> State# s
with has_side_effects = True
primop WriteByteArrayOp_Word64 "writeWord64Array#" GenPrimOp
with has_side_effects = True
-primop IndexByteArrayOp_Char "indexCharArray#" GenPrimOp
- ByteArr# -> Int# -> Char#
-
-primop IndexByteArrayOp_Int "indexIntArray#" GenPrimOp
- ByteArr# -> Int# -> Int#
-
-primop IndexByteArrayOp_Word "indexWordArray#" GenPrimOp
- ByteArr# -> Int# -> Word#
-
-primop IndexByteArrayOp_Addr "indexAddrArray#" GenPrimOp
- ByteArr# -> Int# -> Addr#
-
-primop IndexByteArrayOp_Float "indexFloatArray#" GenPrimOp
- ByteArr# -> Int# -> Float#
-
-primop IndexByteArrayOp_Double "indexDoubleArray#" GenPrimOp
- ByteArr# -> Int# -> Double#
-
-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 IndexByteArrayOp_Word64 "indexWord64Array#" GenPrimOp
- ByteArr# -> Int# -> Word64#
-
-
primop IndexOffAddrOp_Char "indexCharOffAddr#" GenPrimOp
Addr# -> Int# -> Char#
+primop IndexOffAddrOp_WideChar "indexWideCharOffAddr#" GenPrimOp
+ Addr# -> Int# -> Char#
+
primop IndexOffAddrOp_Int "indexIntOffAddr#" GenPrimOp
Addr# -> Int# -> Int#
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 IndexOffAddrOp_Word8 "indexWord8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word#
+
+primop IndexOffAddrOp_Word16 "indexWord16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word#
+
+primop IndexOffAddrOp_Word32 "indexWord32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word#
+
primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp
Addr# -> Int# -> Word64#
primop IndexOffForeignObjOp_Char "indexCharOffForeignObj#" GenPrimOp
ForeignObj# -> Int# -> Char#
+primop IndexOffForeignObjOp_WideChar "indexWideCharOffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Char#
+
primop IndexOffForeignObjOp_Int "indexIntOffForeignObj#" GenPrimOp
ForeignObj# -> Int# -> Int#
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 IndexOffForeignObjOp_Word8 "indexWord8OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
+primop IndexOffForeignObjOp_Word16 "indexWord16OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
+primop IndexOffForeignObjOp_Word32 "indexWord32OffForeignObj#" GenPrimOp
+ ForeignObj# -> Int# -> Word#
+
primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp
ForeignObj# -> Int# -> Word64#
primop ReadOffAddrOp_Char "readCharOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Char# #)
+primop ReadOffAddrOp_WideChar "readWideCharOffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Char# #)
+
primop ReadOffAddrOp_Int "readIntOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Int# #)
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# #)
+primop ReadOffAddrOp_Word8 "readWord8OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadOffAddrOp_Word16 "readWord16OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
+primop ReadOffAddrOp_Word32 "readWord32OffAddr#" GenPrimOp
+ Addr# -> Int# -> State# s -> (# State# s, Word# #)
+
primop ReadOffAddrOp_Word64 "readWord64OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Word64# #)
Addr# -> Int# -> Char# -> State# s -> State# s
with has_side_effects = True
+primop WriteOffAddrOp_WideChar "writeWideCharOffAddr#" GenPrimOp
+ Addr# -> Int# -> Char# -> State# s -> State# s
+ with has_side_effects = True
+
primop WriteOffAddrOp_Int "writeIntOffAddr#" GenPrimOp
Addr# -> Int# -> Int# -> State# s -> State# s
with has_side_effects = True
Addr# -> Int# -> Addr# -> State# s -> State# s
with has_side_effects = True
+primop WriteOffAddrOp_ForeignObj "writeForeignObjOffAddr#" GenPrimOp
+ Addr# -> Int# -> ForeignObj# -> State# s -> State# s
+ with has_side_effects = True
+
primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp
Addr# -> Int# -> Float# -> State# s -> State# s
with has_side_effects = True
Addr# -> Int# -> StablePtr# a -> State# s -> State# s
with has_side_effects = True
-primop WriteOffAddrOp_ForeignObj "writeForeignObjOffAddr#" GenPrimOp
- 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
+primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int# -> State# s -> State# s
with has_side_effects = True
-primop WriteOffAddrOp_Int16 "writeInt16OffAddr#" GenPrimOp
+primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" 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
+primop WriteOffAddrOp_Int64 "writeInt64OffAddr#" GenPrimOp
+ Addr# -> Int# -> Int64# -> State# s -> State# s
with has_side_effects = True
-primop WriteOffAddrOp_Int32 "writeInt32OffAddr#" GenPrimOp
- Addr# -> Int# -> Int# -> State# s -> State# s
+primop WriteOffAddrOp_Word8 "writeWord8OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word# -> State# s -> State# s
with has_side_effects = True
-primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
+primop WriteOffAddrOp_Word16 "writeWord16OffAddr#" 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
+primop WriteOffAddrOp_Word32 "writeWord32OffAddr#" GenPrimOp
+ Addr# -> Int# -> Word# -> State# s -> State# s
with has_side_effects = True
primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp
-primop NewArrayOp "newArray#" GenPrimOp
- Int# -> a -> State# s -> (# State# s, MutArr# s a #)
- with
- strictness = { \ arity -> StrictnessInfo [wwPrim, wwLazy, wwPrim] False }
- usage = { mangle NewArrayOp [mkP, mkM, mkP] mkM }
- out_of_line = True
-
primop SameMutableArrayOp "sameMutableArray#" GenPrimOp
MutArr# s a -> MutArr# s a -> Bool
with
(if maybeToBool (maybeTyConSingleCon tycon) then
-- cmp_eq_Expr ltTag_Expr eqTag_Expr gtTag_Expr a_Expr b_Expr
--- Wierd. Was: case (cmp a b) of { LT -> LT; EQ -> EQ; GT -> GT }
+-- Weird. Was: case (cmp a b) of { LT -> LT; EQ -> EQ; GT -> GT }
cmp_eq_Expr a_Expr b_Expr
else
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.74 2001/02/14 12:59:34 simonmar Exp $
+ * $Id: PrimOps.h,v 1.75 2001/02/28 00:01:03 qrczak Exp $
*
* (c) The GHC Team, 1998-2000
*
Comparison PrimOps.
-------------------------------------------------------------------------- */
-#define gtCharzh(r,a,b) r=(I_)((a)> (b))
-#define geCharzh(r,a,b) r=(I_)((a)>=(b))
-#define eqCharzh(r,a,b) r=(I_)((a)==(b))
-#define neCharzh(r,a,b) r=(I_)((a)!=(b))
-#define ltCharzh(r,a,b) r=(I_)((a)< (b))
-#define leCharzh(r,a,b) r=(I_)((a)<=(b))
+#define gtCharzh(r,a,b) r=(a)> (b)
+#define geCharzh(r,a,b) r=(a)>=(b)
+#define eqCharzh(r,a,b) r=(a)==(b)
+#define neCharzh(r,a,b) r=(a)!=(b)
+#define ltCharzh(r,a,b) r=(a)< (b)
+#define leCharzh(r,a,b) r=(a)<=(b)
/* Int comparisons: >#, >=# etc */
-#define zgzh(r,a,b) r=(I_)((I_)(a) >(I_)(b))
-#define zgzezh(r,a,b) r=(I_)((I_)(a)>=(I_)(b))
-#define zezezh(r,a,b) r=(I_)((I_)(a)==(I_)(b))
-#define zszezh(r,a,b) r=(I_)((I_)(a)!=(I_)(b))
-#define zlzh(r,a,b) r=(I_)((I_)(a) <(I_)(b))
-#define zlzezh(r,a,b) r=(I_)((I_)(a)<=(I_)(b))
-
-#define gtWordzh(r,a,b) r=(I_)((W_)(a) >(W_)(b))
-#define geWordzh(r,a,b) r=(I_)((W_)(a)>=(W_)(b))
-#define eqWordzh(r,a,b) r=(I_)((W_)(a)==(W_)(b))
-#define neWordzh(r,a,b) r=(I_)((W_)(a)!=(W_)(b))
-#define ltWordzh(r,a,b) r=(I_)((W_)(a) <(W_)(b))
-#define leWordzh(r,a,b) r=(I_)((W_)(a)<=(W_)(b))
-
-#define gtAddrzh(r,a,b) r=(I_)((a) >(b))
-#define geAddrzh(r,a,b) r=(I_)((a)>=(b))
-#define eqAddrzh(r,a,b) r=(I_)((a)==(b))
-#define neAddrzh(r,a,b) r=(I_)((a)!=(b))
-#define ltAddrzh(r,a,b) r=(I_)((a) <(b))
-#define leAddrzh(r,a,b) r=(I_)((a)<=(b))
-
-#define gtFloatzh(r,a,b) r=(I_)((a)> (b))
-#define geFloatzh(r,a,b) r=(I_)((a)>=(b))
-#define eqFloatzh(r,a,b) r=(I_)((a)==(b))
-#define neFloatzh(r,a,b) r=(I_)((a)!=(b))
-#define ltFloatzh(r,a,b) r=(I_)((a)< (b))
-#define leFloatzh(r,a,b) r=(I_)((a)<=(b))
-
-/* Double comparisons: >##, >=#@ etc */
-#define zgzhzh(r,a,b) r=(I_)((a) >(b))
-#define zgzezhzh(r,a,b) r=(I_)((a)>=(b))
-#define zezezhzh(r,a,b) r=(I_)((a)==(b))
-#define zszezhzh(r,a,b) r=(I_)((a)!=(b))
-#define zlzhzh(r,a,b) r=(I_)((a) <(b))
-#define zlzezhzh(r,a,b) r=(I_)((a)<=(b))
+#define zgzh(r,a,b) r=(a)> (b)
+#define zgzezh(r,a,b) r=(a)>=(b)
+#define zezezh(r,a,b) r=(a)==(b)
+#define zszezh(r,a,b) r=(a)!=(b)
+#define zlzh(r,a,b) r=(a)< (b)
+#define zlzezh(r,a,b) r=(a)<=(b)
+
+#define gtWordzh(r,a,b) r=(a)> (b)
+#define geWordzh(r,a,b) r=(a)>=(b)
+#define eqWordzh(r,a,b) r=(a)==(b)
+#define neWordzh(r,a,b) r=(a)!=(b)
+#define ltWordzh(r,a,b) r=(a)< (b)
+#define leWordzh(r,a,b) r=(a)<=(b)
+
+#define gtAddrzh(r,a,b) r=(a)> (b)
+#define geAddrzh(r,a,b) r=(a)>=(b)
+#define eqAddrzh(r,a,b) r=(a)==(b)
+#define neAddrzh(r,a,b) r=(a)!=(b)
+#define ltAddrzh(r,a,b) r=(a)< (b)
+#define leAddrzh(r,a,b) r=(a)<=(b)
+
+#define gtFloatzh(r,a,b) r=(a)> (b)
+#define geFloatzh(r,a,b) r=(a)>=(b)
+#define eqFloatzh(r,a,b) r=(a)==(b)
+#define neFloatzh(r,a,b) r=(a)!=(b)
+#define ltFloatzh(r,a,b) r=(a)< (b)
+#define leFloatzh(r,a,b) r=(a)<=(b)
+
+/* Double comparisons: >##, >=## etc */
+#define zgzhzh(r,a,b) r=(a)> (b)
+#define zgzezhzh(r,a,b) r=(a)>=(b)
+#define zezezhzh(r,a,b) r=(a)==(b)
+#define zszezhzh(r,a,b) r=(a)!=(b)
+#define zlzhzh(r,a,b) r=(a)< (b)
+#define zlzezhzh(r,a,b) r=(a)<=(b)
/* -----------------------------------------------------------------------------
Char# PrimOps.
-------------------------------------------------------------------------- */
-#define ordzh(r,a) r=(I_)((W_) (a))
-#define chrzh(r,a) r=(StgChar)((W_)(a))
+#define ordzh(r,a) r=(I_)(a)
+#define chrzh(r,a) r=(C_)(a)
/* -----------------------------------------------------------------------------
Int# PrimOps.
-------------------------------------------------------------------------- */
-I_ stg_div (I_ a, I_ b);
-
#define zpzh(r,a,b) r=(a)+(b)
#define zmzh(r,a,b) r=(a)-(b)
#define ztzh(r,a,b) r=(a)*(b)
#define quotIntzh(r,a,b) r=(a)/(b)
-#define zszh(r,a,b) r=ULTRASAFESTGCALL2(I_,(void *, I_, I_),stg_div,(a),(b))
#define remIntzh(r,a,b) r=(a)%(b)
#define negateIntzh(r,a) r=-(a)
#define addIntCzh(r,c,a,b) \
{ r = a + b; \
c = ((StgWord)(~(a^b) & (a^r))) \
- >> (BITS_PER_BYTE * sizeof(I_) - 1); \
+ >> (BITS_IN (I_) - 1); \
}
#define subIntCzh(r,c,a,b) \
{ r = a - b; \
c = ((StgWord)((a^b) & (a^r))) \
- >> (BITS_PER_BYTE * sizeof(I_) - 1); \
+ >> (BITS_IN (I_) - 1); \
}
/* Multiply with overflow checking.
c = z.i[C]; \
if (c == 0 || c == -1) { \
c = ((StgWord)((a^b) ^ r)) \
- >> (BITS_PER_BYTE * sizeof(I_) - 1); \
+ >> (BITS_IN (I_) - 1); \
} \
}
/* Careful: the carry calculation above is extremely delicate. Make sure
#else
-#define HALF_INT (1 << (BITS_PER_BYTE * sizeof(I_) / 2))
+#define HALF_INT (1 << (BITS_IN (I_) / 2))
#define stg_abs(a) ((a) < 0 ? -(a) : (a))
#endif
/* -----------------------------------------------------------------------------
- Word PrimOps.
+ Word# PrimOps.
-------------------------------------------------------------------------- */
-#define quotWordzh(r,a,b) r=((W_)a)/((W_)b)
-#define remWordzh(r,a,b) r=((W_)a)%((W_)b)
+#define plusWordzh(r,a,b) r=(a)+(b)
+#define minusWordzh(r,a,b) r=(a)-(b)
+#define timesWordzh(r,a,b) r=(a)*(b)
+#define quotWordzh(r,a,b) r=(a)/(b)
+#define remWordzh(r,a,b) r=(a)%(b)
#define andzh(r,a,b) r=(a)&(b)
#define orzh(r,a,b) r=(a)|(b)
on the whatever your C compiler is doing. ToDo: fix/document. -- sof 8/98
*/
#define iShiftRAzh(r,a,b) r=((b) >= BITS_IN(I_)) ? (((a) < 0) ? -1 : 0) : (a)>>(b)
-#define iShiftRLzh(r,a,b) r=((b) >= BITS_IN(I_)) ? 0 : ((W_)(a))>>(b)
+#define iShiftRLzh(r,a,b) r=((b) >= BITS_IN(I_)) ? 0 : (I_)((W_)(a)>>(b))
#define int2Wordzh(r,a) r=(W_)(a)
#define word2Intzh(r,a) r=(I_)(a)
/* -----------------------------------------------------------------------------
- Addr PrimOps.
+ Explicitly sized Int# and Word# PrimOps.
+ -------------------------------------------------------------------------- */
+
+#define intToInt8zh(r,a) r=(StgInt8)(a)
+#define intToInt16zh(r,a) r=(StgInt16)(a)
+#define intToInt32zh(r,a) r=(StgInt32)(a)
+#define wordToWord8zh(r,a) r=(StgWord8)(a)
+#define wordToWord16zh(r,a) r=(StgWord16)(a)
+#define wordToWord32zh(r,a) r=(StgWord32)(a)
+
+/* -----------------------------------------------------------------------------
+ Addr# PrimOps.
-------------------------------------------------------------------------- */
#define int2Addrzh(r,a) r=(A_)(a)
#define addr2Intzh(r,a) r=(I_)(a)
-#define readCharOffAddrzh(r,a,i) r= ((unsigned char *)(a))[i]
-/* unsigned char is for compatibility: the index is still in bytes. */
-#define readIntOffAddrzh(r,a,i) r= ((I_ *)(a))[i]
-#define readWordOffAddrzh(r,a,i) r= ((W_ *)(a))[i]
-#define readAddrOffAddrzh(r,a,i) r= ((PP_)(a))[i]
-#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]
+#define readCharOffAddrzh(r,a,i) r=((StgWord8 *)(a))[i]
+#define readWideCharOffAddrzh(r,a,i) r=((C_ *)(a))[i]
+#define readIntOffAddrzh(r,a,i) r=((I_ *)(a))[i]
+#define readWordOffAddrzh(r,a,i) r=((W_ *)(a))[i]
+#define readAddrOffAddrzh(r,a,i) r=((PP_)(a))[i]
+#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 readInt64OffAddrzh(r,a,i) r=((LI_ *)(a))[i]
+#define readWord64OffAddrzh(r,a,i) r=((LW_ *)(a))[i]
#endif
-#define writeCharOffAddrzh(a,i,v) ((unsigned char *)(a))[i] = (unsigned char)(v)
-/* unsigned char is for compatibility: the index is still in bytes. */
-#define writeIntOffAddrzh(a,i,v) ((I_ *)(a))[i] = (v)
-#define writeWordOffAddrzh(a,i,v) ((W_ *)(a))[i] = (v)
-#define writeAddrOffAddrzh(a,i,v) ((PP_)(a))[i] = (v)
+#define writeCharOffAddrzh(a,i,v) ((StgWord8 *)(a))[i] = (v)
+#define writeWideCharOffAddrzh(a,i,v) ((C_ *)(a))[i] = (v)
+#define writeIntOffAddrzh(a,i,v) ((I_ *)(a))[i] = (v)
+#define writeWordOffAddrzh(a,i,v) ((W_ *)(a))[i] = (v)
+#define writeAddrOffAddrzh(a,i,v) ((PP_)(a))[i] = (v)
#define writeForeignObjOffAddrzh(a,i,v) ((PP_)(a))[i] = ForeignObj_CLOSURE_DATA(v)
-#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)
+#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 writeInt64OffAddrzh(a,i,v) ((LI_ *)(a))[i] = (v)
+#define writeWord64OffAddrzh(a,i,v) ((LW_ *)(a))[i] = (v)
#endif
-#define indexCharOffAddrzh(r,a,i) r= ((unsigned char *)(a))[i]
-/* unsigned char is for compatibility: the index is still in bytes. */
-#define indexIntOffAddrzh(r,a,i) r= ((I_ *)(a))[i]
-#define indexWordOffAddrzh(r,a,i) r= ((W_ *)(a))[i]
-#define indexAddrOffAddrzh(r,a,i) r= ((PP_)(a))[i]
-#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]
+#define indexCharOffAddrzh(r,a,i) r=((StgWord8 *)(a))[i]
+#define indexWideCharOffAddrzh(r,a,i) r=((C_ *)(a))[i]
+#define indexIntOffAddrzh(r,a,i) r=((I_ *)(a))[i]
+#define indexWordOffAddrzh(r,a,i) r=((W_ *)(a))[i]
+#define indexAddrOffAddrzh(r,a,i) r=((PP_)(a))[i]
+#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 indexInt64OffAddrzh(r,a,i) r=((LI_ *)(a))[i]
+#define indexWord64OffAddrzh(r,a,i) r=((LW_ *)(a))[i]
#endif
/* -----------------------------------------------------------------------------
*/
#define integer2Intzh(r, sa,da) \
-{ StgWord word0 = ((StgWord *)BYTE_ARR_CTS(da))[0]; \
- int size = sa; \
+{ I_ s, res; \
\
- (r) = \
- ( size == 0 ) ? \
- 0 : \
- ( size < 0 && word0 != 0x8000000 ) ? \
- -(I_)word0 : \
- (I_)word0; \
+ s = (sa); \
+ if (s == 0) \
+ res = 0; \
+ else { \
+ res = ((mp_limb_t *) (BYTE_ARR_CTS(da)))[0]; \
+ if (s < 0) res = -res; \
+ } \
+ (r) = res; \
}
#define integer2Wordzh(r, sa,da) \
-{ StgWord word0 = ((StgWord *)BYTE_ARR_CTS(da))[0]; \
- int size = sa; \
- (r) = ( size == 0 ) ? 0 : word0 ; \
+{ I_ s; \
+ W_ res; \
+ \
+ s = (sa); \
+ if (s == 0) \
+ res = 0; \
+ else { \
+ res = ((mp_limb_t *) (BYTE_ARR_CTS(da)))[0]; \
+ if (s < 0) res = -res; \
+ } \
+ (r) = res; \
}
#define cmpIntegerzh(r, s1,d1, s2,d2) \
\
arg1._mp_size = (s1); \
arg1._mp_alloc= ((StgArrWords *)d1)->words; \
- arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
+ arg1._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d1)); \
arg2._mp_size = (s2); \
arg2._mp_alloc= ((StgArrWords *)d2)->words; \
- arg2._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d2)); \
+ arg2._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d2)); \
\
(r) = RET_PRIM_STGCALL2(I_,mpz_cmp,&arg1,&arg2); \
}
\
arg._mp_size = (s); \
arg._mp_alloc = ((StgArrWords *)d)->words; \
- arg._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d)); \
+ arg._mp_d = (mp_limb_t *) (BYTE_ARR_CTS(d)); \
\
(r) = RET_PRIM_STGCALL2(I_,mpz_cmp_si,&arg,i); \
}
#ifdef SUPPORT_LONG_LONGS
-#define integerToWord64zh(r, sa,da) \
-{ unsigned long int* d; \
+#define integerToWord64zh(r,sa,da) \
+{ mp_limb_t* d; \
I_ s; \
StgWord64 res; \
\
- d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ d = (mp_limb_t *) (BYTE_ARR_CTS(da)); \
s = (sa); \
- if ( s == 0 ) { \
- res = (LW_)0; \
- } else if ( s == 1) { \
- res = (LW_)d[0]; \
- } else { \
- res = (LW_)d[0] + (LW_)d[1] * 0x100000000ULL; \
+ switch (s) { \
+ case 0: res = 0; break; \
+ case 1: res = d[0]; break; \
+ case -1: res = -d[0]; break; \
+ default: \
+ res = d[0] + ((StgWord64) d[1] << (BITS_IN (mp_limb_t))); \
+ if (s < 0) res = -res; \
} \
(r) = res; \
}
-#define integerToInt64zh(r, sa,da) \
-{ unsigned long int* d; \
+#define integerToInt64zh(r,sa,da) \
+{ mp_limb_t* d; \
I_ s; \
StgInt64 res; \
\
- d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
+ d = (mp_limb_t *) (BYTE_ARR_CTS(da)); \
s = (sa); \
- if ( s == 0 ) { \
- res = (LI_)0; \
- } else if ( s == 1) { \
- res = (LI_)d[0]; \
- } else { \
- res = (LI_)d[0] + (LI_)d[1] * 0x100000000LL; \
- if ( s < 0 ) { \
- res = (LI_)-res; \
- } \
+ switch (s) { \
+ case 0: res = 0; break; \
+ case 1: res = d[0]; break; \
+ case -1: res = -d[0]; break; \
+ default: \
+ res = d[0] + ((StgWord64) d[1] << (BITS_IN (mp_limb_t))); \
+ if (s < 0) res = -res; \
} \
(r) = res; \
}
#define sameMutableArrayzh(r,a,b) r=(I_)((a)==(b))
#define sameMutableByteArrayzh(r,a,b) r=(I_)((a)==(b))
-#define readArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)]
-
-#define readCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
-#define readIntArrayzh(r,a,i) indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
-#define readWordArrayzh(r,a,i) indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
-#define readAddrArrayzh(r,a,i) indexAddrOffAddrzh(r,BYTE_ARR_CTS(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)
+#define readArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)]
+
+#define readCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWideCharArrayzh(r,a,i) indexWideCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readIntArrayzh(r,a,i) indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWordArrayzh(r,a,i) indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readAddrArrayzh(r,a,i) indexAddrOffAddrzh(r,BYTE_ARR_CTS(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 readInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define readWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#endif
/* result ("r") arg ignored in write macros! */
-#define writeArrayzh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v)
-
-#define writeCharArrayzh(a,i,v) ((unsigned char *)(BYTE_ARR_CTS(a)))[i] = (unsigned char)(v)
-/* unsigned char is for compatibility: the index is still in bytes. */
-#define writeIntArrayzh(a,i,v) ((I_ *)(BYTE_ARR_CTS(a)))[i] = (v)
-#define writeWordArrayzh(a,i,v) ((W_ *)(BYTE_ARR_CTS(a)))[i] = (v)
-#define writeAddrArrayzh(a,i,v) ((PP_)(BYTE_ARR_CTS(a)))[i] = (v)
-#define writeFloatArrayzh(a,i,v) \
- ASSIGN_FLT((P_) (((StgFloat *)(BYTE_ARR_CTS(a))) + i),v)
-#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)
+#define writeArrayzh(a,i,v) ((PP_) PTRS_ARR_CTS(a))[(i)]=(v)
+
+#define writeCharArrayzh(a,i,v) writeCharOffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeWideCharArrayzh(a,i,v) writeWideCharOffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeIntArrayzh(a,i,v) writeIntOffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeWordArrayzh(a,i,v) writeWordOffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeAddrArrayzh(a,i,v) writeAddrOffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeFloatArrayzh(a,i,v) writeFloatOffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeDoubleArrayzh(a,i,v) writeDoubleOffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeStablePtrArrayzh(a,i,v) writeStablePtrOffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeInt8Arrayzh(a,i,v) writeInt8OffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeInt16Arrayzh(a,i,v) writeInt16OffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeInt32Arrayzh(a,i,v) writeInt32OffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeWord8Arrayzh(a,i,v) writeWord8OffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeWord16Arrayzh(a,i,v) writeWord16OffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeWord32Arrayzh(a,i,v) writeWord32OffAddrzh(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 writeInt64Arrayzh(a,i,v) writeInt64OffAddrzh(BYTE_ARR_CTS(a),i,v)
+#define writeWord64Arrayzh(a,i,v) writeWord64OffAddrzh(BYTE_ARR_CTS(a),i,v)
#endif
-#define indexArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)]
-
-#define indexCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
-#define indexIntArrayzh(r,a,i) indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
-#define indexWordArrayzh(r,a,i) indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
-#define indexAddrArrayzh(r,a,i) indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i)
-#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)
+#define indexArrayzh(r,a,i) r=((PP_) PTRS_ARR_CTS(a))[(i)]
+
+#define indexCharArrayzh(r,a,i) indexCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWideCharArrayzh(r,a,i) indexWideCharOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexIntArrayzh(r,a,i) indexIntOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWordArrayzh(r,a,i) indexWordOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexAddrArrayzh(r,a,i) indexAddrOffAddrzh(r,BYTE_ARR_CTS(a),i)
+#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)
+#define indexInt64Arrayzh(r,a,i) indexInt64OffAddrzh(r,BYTE_ARR_CTS(a),i)
+#define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
#endif
/* Freezing arrays-of-ptrs requires changing an info table, for the
#define eqForeignObj(f1,f2) ((f1)==(f2))
-#define indexCharOffForeignObjzh(r,fo,i) indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexIntOffForeignObjzh(r,fo,i) indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexWordOffForeignObjzh(r,fo,i) indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexAddrOffForeignObjzh(r,fo,i) indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#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)
+#define indexCharOffForeignObjzh(r,fo,i) indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWideCharOffForeignObjzh(r,fo,i) indexWideCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexIntOffForeignObjzh(r,fo,i) indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWordOffForeignObjzh(r,fo,i) indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexAddrOffForeignObjzh(r,fo,i) indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#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)
+#define indexInt64OffForeignObjzh(r,fo,i) indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
#endif
#endif
% -----------------------------------------------------------------------------
-% $Id: Numeric.lhs,v 1.12 2001/02/22 16:48:24 qrczak Exp $
+% $Id: Numeric.lhs,v 1.13 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The University of Glasgow, 1997-2000
%
#ifndef __HUGS__
-- GHC imports
import Prelude -- For dependencies
-import PrelBase ( Char(..) )
+import PrelBase ( Char(..), unsafeChr )
import PrelRead -- Lots of things
import PrelReal ( showSigned )
import PrelFloat ( fromRat, FFFormat(..),
formatRealFloat, floatToDigits, showFloat
)
-import PrelNum ( ord_0 )
#else
-- Hugs imports
import Array
\begin{code}
showInt :: Integral a => a -> ShowS
-showInt i rs
- | i < 0 = error "Numeric.showInt: can't show negative numbers"
- | otherwise = go i rs
+showInt n cs
+ | n < 0 = error "Numeric.showInt: can't show negative numbers"
+ | otherwise = go n cs
where
- go n r =
- case quotRem n 10 of { (n', d) ->
- case chr (ord_0 + fromIntegral d) of { C# c# -> -- stricter than necessary
- let
- r' = C# c# : r
- in
- if n' == 0 then r' else go n' r'
- }}
+ go n cs
+ | n < 10 = case unsafeChr (ord '0' + fromIntegral n) of
+ c@(C# _) -> c:cs
+ | otherwise = case unsafeChr (ord '0' + fromIntegral r) of
+ c@(C# _) -> go q (c:cs)
+ where
+ (q,r) = n `quotRem` 10
\end{code}
Controlling the format and precision of floats. The code that
% -----------------------------------------------------------------------------
-% $Id: PrelBase.lhs,v 1.41 2001/02/23 14:44:43 simonmar Exp $
+% $Id: PrelBase.lhs,v 1.42 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The University of Glasgow, 1992-2000
%
\begin{code}
{-# OPTIONS -fno-implicit-prelude #-}
+#include "MachDeps.h"
+
module PrelBase
(
module PrelBase,
- module PrelGHC, -- Re-export PrelGHC, PrelErr & PrelNum, to avoid lots
+ module PrelGHC, -- Re-export PrelGHC and PrelErr, to avoid lots
module PrelErr -- of people having to import it explicitly
)
where
\begin{code}
class Eq a where
- (==), (/=) :: a -> a -> Bool
+ (==), (/=) :: a -> a -> Bool
- (/=) x y = not ((==) x y)
- (==) x y = not ((/=) x y)
+ x /= y = not (x == y)
+ x == y = not (x /= y)
class (Eq a) => Ord a where
- compare :: a -> a -> Ordering
- (<), (<=), (>=), (>):: a -> a -> Bool
- max, min :: a -> a -> a
+ compare :: a -> a -> Ordering
+ (<), (<=), (>), (>=) :: a -> a -> Bool
+ max, min :: a -> a -> a
+
+ -- An instance of Ord should define either 'compare' or '<='.
+ -- Using 'compare' can be more efficient for complex types.
--- An instance of Ord should define either compare or <=
--- Using compare can be more efficient for complex types.
compare x y
- | x == y = EQ
- | x <= y = LT -- NB: must be '<=' not '<' to validate the
- -- above claim about the minimal things that can
- -- be defined for an instance of Ord
- | otherwise = GT
-
- x <= y = case compare x y of { GT -> False; _other -> True }
- x < y = case compare x y of { LT -> True; _other -> False }
- x >= y = case compare x y of { LT -> False; _other -> True }
- x > y = case compare x y of { GT -> True; _other -> False }
-
- -- These two default methods use '>' rather than compare
+ | x == y = EQ
+ | x <= y = LT -- NB: must be '<=' not '<' to validate the
+ -- above claim about the minimal things that
+ -- can be defined for an instance of Ord
+ | otherwise = GT
+
+ x < y = case compare x y of { LT -> True; _other -> False }
+ x <= y = case compare x y of { GT -> False; _other -> True }
+ x > y = case compare x y of { GT -> True; _other -> False }
+ x >= y = case compare x y of { LT -> False; _other -> True }
+
+ -- These two default methods use '<=' rather than 'compare'
-- because the latter is often more expensive
- max x y = if x > y then x else y
- min x y = if x > y then y else x
+ max x y = if x <= y then y else x
+ min x y = if x <= y then x else y
\end{code}
%*********************************************************
{-
{-# SPECIALISE instance Eq [Char] #-}
-}
- [] == [] = True
+ [] == [] = True
(x:xs) == (y:ys) = x == y && xs == ys
- _xs == _ys = False
-
- xs /= ys = if (xs == ys) then False else True
+ _xs == _ys = False
instance (Ord a) => Ord [a] where
{-
compare (_:_) [] = GT
compare [] (_:_) = LT
compare (x:xs) (y:ys) = case compare x y of
- LT -> LT
- GT -> GT
- EQ -> compare xs ys
+ LT -> LT
+ GT -> GT
+ EQ -> compare xs ys
instance Functor [] where
fmap = map
zeroInt = I# 0#
oneInt = I# 1#
twoInt = I# 2#
-minInt = I# (-2147483648#) -- GHC <= 2.09 had this at -2147483647
-maxInt = I# 2147483647#
+#if WORD_SIZE_IN_BYTES == 4
+minInt = I# (-0x80000000#)
+maxInt = I# 0x7FFFFFFF#
+#else
+minInt = I# (-0x8000000000000000#)
+maxInt = I# 0x7FFFFFFFFFFFFFFF#
+#endif
instance Eq Int where
- (==) x y = x `eqInt` y
- (/=) x y = x `neInt` y
+ (==) = eqInt
+ (/=) = neInt
instance Ord Int where
- compare x y = compareInt x y
+ compare = compareInt
- (<) x y = ltInt x y
- (<=) x y = leInt x y
- (>=) x y = geInt x y
- (>) x y = gtInt x y
+ (<) = ltInt
+ (<=) = leInt
+ (>=) = geInt
+ (>) = gtInt
compareInt :: Int -> Int -> Ordering
-(I# x) `compareInt` (I# y) = compareInt# x y
+(I# x) `compareInt` (I# y) = compareInt# x y
compareInt# :: Int# -> Int# -> Ordering
compareInt# x# y#
-- right-associating infix application operator (useful in continuation-
-- passing style)
+{-# INLINE ($) #-}
($) :: (a -> b) -> a -> b
f $ x = f x
%* *
%*********************************************************
+\begin{code}
+divInt#, modInt# :: Int# -> Int# -> Int#
+x# `divInt#` y#
+ | (x# ># 0#) && (y# <# 0#) = ((x# -# y#) -# 1#) `quotInt#` y#
+ | (x# <# 0#) && (y# ># 0#) = ((x# -# y#) +# 1#) `quotInt#` y#
+ | otherwise = x# `quotInt#` y#
+x# `modInt#` y#
+ | (x# ># 0#) && (y# <# 0#) ||
+ (x# <# 0#) && (y# ># 0#) = if r# /=# 0# then r# +# y# else 0#
+ | otherwise = r#
+ where
+ r# = x# `remInt#` y#
+\end{code}
+
Definitions of the boxed PrimOps; these will be
used in the case of partial applications, etc.
{-# INLINE remInt #-}
{-# INLINE negateInt #-}
-plusInt, minusInt, timesInt, quotInt, remInt, gcdInt :: Int -> Int -> Int
-plusInt (I# x) (I# y) = I# (x +# y)
-minusInt(I# x) (I# y) = I# (x -# y)
-timesInt(I# x) (I# y) = I# (x *# y)
-quotInt (I# x) (I# y) = I# (quotInt# x y)
-remInt (I# x) (I# y) = I# (remInt# x y)
+plusInt, minusInt, timesInt, quotInt, remInt, divInt, modInt, gcdInt :: Int -> Int -> Int
+(I# x) `plusInt` (I# y) = I# (x +# y)
+(I# x) `minusInt` (I# y) = I# (x -# y)
+(I# x) `timesInt` (I# y) = I# (x *# y)
+(I# x) `quotInt` (I# y) = I# (x `quotInt#` y)
+(I# x) `remInt` (I# y) = I# (x `remInt#` y)
+(I# x) `divInt` (I# y) = I# (x `divInt#` y)
+(I# x) `modInt` (I# y) = I# (x `modInt#` y)
gcdInt (I# a) (I# b) = g a b
where g 0# 0# = error "PrelBase.gcdInt: gcd 0 0 is undefined"
negateInt :: Int -> Int
negateInt (I# x) = I# (negateInt# x)
-divInt, modInt :: Int -> Int -> Int
-x `divInt` y
- | x > zeroInt && y < zeroInt = quotInt ((x `minusInt` y) `minusInt` oneInt) y
- | x < zeroInt && y > zeroInt = quotInt ((x `minusInt` y) `plusInt` oneInt) y
- | otherwise = quotInt x y
-
-x `modInt` y
- | x > zeroInt && y < zeroInt ||
- x < zeroInt && y > zeroInt = if r/=zeroInt then r `plusInt` y else zeroInt
- | otherwise = r
- where
- r = remInt x y
-
gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool
-gtInt (I# x) (I# y) = x ># y
-geInt (I# x) (I# y) = x >=# y
-eqInt (I# x) (I# y) = x ==# y
-neInt (I# x) (I# y) = x /=# y
-ltInt (I# x) (I# y) = x <# y
-leInt (I# x) (I# y) = x <=# y
+(I# x) `gtInt` (I# y) = x ># y
+(I# x) `geInt` (I# y) = x >=# y
+(I# x) `eqInt` (I# y) = x ==# y
+(I# x) `neInt` (I# y) = x /=# y
+(I# x) `ltInt` (I# y) = x <# y
+(I# x) `leInt` (I# y) = x <=# y
+
+{-# RULES
+"int2Word2Int" forall x#. int2Word# (word2Int# x#) = x#
+"word2Int2Word" forall x#. word2Int# (int2Word# x#) = x#
+ #-}
\end{code}
individual operations.
\begin{code}
+#include "MachDeps.h"
+
module PrelBits where
import Prelude -- To generate the dependency
#endif
class Num a => Bits a where
- (.&.), (.|.), xor :: a -> a -> a
- complement :: a -> a
- shift :: a -> Int -> a
- rotate :: a -> Int -> a
- bit :: Int -> a
- setBit :: a -> Int -> a
- clearBit :: a -> Int -> a
- complementBit :: a -> Int -> a
- testBit :: a -> Int -> Bool
- bitSize :: a -> Int
- isSigned :: a -> Bool
-
- bit i = shift 0x1 i
- setBit x i = x .|. bit i
- clearBit x i = x .&. complement (bit i)
- complementBit x i = x `xor` bit i
- testBit x i = (x .&. bit i) /= 0
+ (.&.), (.|.), xor :: a -> a -> a
+ complement :: a -> a
+ shift :: a -> Int -> a
+ rotate :: a -> Int -> a
+ bit :: Int -> a
+ setBit :: a -> Int -> a
+ clearBit :: a -> Int -> a
+ complementBit :: a -> Int -> a
+ testBit :: a -> Int -> Bool
+ bitSize :: a -> Int
+ isSigned :: a -> Bool
+
+ bit i = 1 `shift` i
+ x `setBit` i = x .|. bit i
+ x `clearBit` i = x .&. complement (bit i)
+ x `complementBit` i = x `xor` bit i
+ x `testBit` i = (x .&. bit i) /= 0
shiftL, shiftR :: Bits a => a -> Int -> a
rotateL, rotateR :: Bits a => a -> Int -> a
-shiftL a i = shift a i
-shiftR a i = shift a (-i)
-rotateL a i = rotate a i
-rotateR a i = rotate a (-i)
+x `shiftL` i = x `shift` i
+x `shiftR` i = x `shift` (-i)
+x `rotateL` i = x `rotate` i
+x `rotateR` i = x `rotate` (-i)
+
+instance Bits Int where
+ (I# x#) .&. (I# y#) = I# (word2Int# (int2Word# x# `and#` int2Word# y#))
+ (I# x#) .|. (I# y#) = I# (word2Int# (int2Word# x# `or#` int2Word# y#))
+ (I# x#) `xor` (I# y#) = I# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+ complement (I# x#) = I# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
+ (I# x#) `shift` (I# i#)
+ | i# >=# 0# = I# (x# `iShiftL#` i#)
+ | otherwise = I# (x# `iShiftRA#` negateInt# i#)
+ (I# x#) `rotate` (I# i#) =
+#if WORD_SIZE_IN_BYTES == 4
+ I# (word2Int# ((x'# `shiftL#` i'#) `or#`
+ (x'# `shiftRL#` (32# -# i'#))))
+ where
+ x'# = int2Word# x#
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
+#else
+ I# (word2Int# ((x'# `shiftL#` i'#) `or#`
+ (x'# `shiftRL#` (64# -# i'#))))
+ where
+ x'# = int2Word# x#
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+#endif
+ bitSize _ = WORD_SIZE_IN_BYTES * 8
+ isSigned _ = True
\end{code}
% ------------------------------------------------------------------------------
-% $Id: PrelFloat.lhs,v 1.10 2001/02/22 13:17:58 simonpj Exp $
+% $Id: PrelFloat.lhs,v 1.11 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The University of Glasgow, 1994-2000
%
let bk = expt base (-k) in
gen [] (r * bk) s (mUp * bk) (mDn * bk)
in
- (map toInt (reverse rds), k)
+ (map fromIntegral (reverse rds), k)
\end{code}
foreign import ccall "isDoubleDenormalized" unsafe isDoubleDenormalized :: Double -> Int
foreign import ccall "isDoubleNegativeZero" unsafe isDoubleNegativeZero :: Double -> Int
\end{code}
+
+%*********************************************************
+%* *
+\subsection{Coercion rules}
+%* *
+%*********************************************************
+
+\begin{code}
+{-# RULES
+"fromIntegral/Int->Float" fromIntegral = int2Float
+"fromIntegral/Int->Double" fromIntegral = int2Double
+"realToFrac/Float->Float" realToFrac = id :: Float -> Float
+"realToFrac/Float->Double" realToFrac = float2Double
+"realToFrac/Double->Float" realToFrac = double2Float
+"realToFrac/Double->Double" realToFrac = id :: Double -> Double
+ #-}
+\end{code}
tryTakeMVarzh
tryPutMVarzh
isEmptyMVarzh
-
+
-- Parallel
seqzh
parzh
leCharzh
ordzh
chrzh
-
+
-- Int Type
Intzh
zgzh
addIntCzh
subIntCzh
mulIntCzh
-
+
Wordzh
gtWordzh
geWordzh
neWordzh
ltWordzh
leWordzh
+ plusWordzh
+ minusWordzh
+ timesWordzh
quotWordzh
remWordzh
andzh
notzh
xorzh
shiftLzh
--- shiftRAzh
shiftRLzh
int2Wordzh
word2Intzh
-
- Word64zh
Int64zh
+ Word64zh
+
+ intToInt8zh
+ intToInt16zh
+ intToInt32zh
+ wordToWord8zh
+ wordToWord16zh
+ wordToWord32zh
Addrzh
gtAddrzh
tanhFloatzh
powerFloatzh
decodeFloatzh
-
+
Doublezh
zgzhzh
zgzezhzh
tanhDoublezh
ztztzhzh
decodeDoublezh
-
+
cmpIntegerzh
cmpIntegerIntzh
plusIntegerzh
ByteArrayzh
MutableArrayzh
MutableByteArrayzh
-
+
sameMutableArrayzh
sameMutableByteArrayzh
-
+
newArrayzh
newByteArrayzh
-
+
indexArrayzh
indexCharArrayzh
+ indexWideCharArrayzh
indexIntArrayzh
indexWordArrayzh
+ indexAddrArrayzh
indexFloatArrayzh
indexDoubleArrayzh
- indexAddrArrayzh
indexStablePtrArrayzh
indexInt8Arrayzh
indexInt16Arrayzh
indexWord16Arrayzh
indexWord32Arrayzh
indexWord64Arrayzh
-
--- indexOffAddrzh
+
+ readArrayzh
+ readCharArrayzh
+ readWideCharArrayzh
+ readIntArrayzh
+ readWordArrayzh
+ readAddrArrayzh
+ readFloatArrayzh
+ readDoubleArrayzh
+ readStablePtrArrayzh
+ readInt8Arrayzh
+ readInt16Arrayzh
+ readInt32Arrayzh
+ readInt64Arrayzh
+ readWord8Arrayzh
+ readWord16Arrayzh
+ readWord32Arrayzh
+ readWord64Arrayzh
+
+ writeArrayzh
+ writeCharArrayzh
+ writeWideCharArrayzh
+ writeIntArrayzh
+ writeWordArrayzh
+ writeAddrArrayzh
+ writeFloatArrayzh
+ writeDoubleArrayzh
+ writeStablePtrArrayzh
+ writeInt8Arrayzh
+ writeInt16Arrayzh
+ writeInt32Arrayzh
+ writeInt64Arrayzh
+ writeWord8Arrayzh
+ writeWord16Arrayzh
+ writeWord32Arrayzh
+ writeWord64Arrayzh
+
indexCharOffAddrzh
+ indexWideCharOffAddrzh
indexIntOffAddrzh
indexWordOffAddrzh
indexAddrOffAddrzh
indexWord16OffAddrzh
indexWord32OffAddrzh
indexWord64OffAddrzh
-
+
readCharOffAddrzh
+ readWideCharOffAddrzh
readIntOffAddrzh
readWordOffAddrzh
readAddrOffAddrzh
readWord64OffAddrzh
writeCharOffAddrzh
+ writeWideCharOffAddrzh
writeIntOffAddrzh
writeWordOffAddrzh
writeAddrOffAddrzh
writeWord32OffAddrzh
writeWord64OffAddrzh
--- indexOffForeignObjzh
indexCharOffForeignObjzh
+ indexWideCharOffForeignObjzh
indexIntOffForeignObjzh
indexWordOffForeignObjzh
indexAddrOffForeignObjzh
indexWord16OffForeignObjzh
indexWord32OffForeignObjzh
indexWord64OffForeignObjzh
-
- writeArrayzh
- writeCharArrayzh
- writeIntArrayzh
- writeWordArrayzh
- writeFloatArrayzh
- writeDoubleArrayzh
- writeAddrArrayzh
- writeStablePtrArrayzh
- writeInt8Arrayzh
- writeInt16Arrayzh
- writeInt32Arrayzh
- writeInt64Arrayzh
- writeWord8Arrayzh
- writeWord16Arrayzh
- writeWord32Arrayzh
- writeWord64Arrayzh
-
- readArrayzh
- readCharArrayzh
- readIntArrayzh
- readWordArrayzh
- readFloatArrayzh
- readDoubleArrayzh
- readAddrArrayzh
- readStablePtrArrayzh
- readInt8Arrayzh
- readInt16Arrayzh
- readInt32Arrayzh
- readInt64Arrayzh
- readWord8Arrayzh
- readWord16Arrayzh
- readWord32Arrayzh
- readWord64Arrayzh
unsafeFreezzeArrayzh -- Note zz in the middle
unsafeFreezzeByteArrayzh -- Ditto
%
-% (c) The University of Glasgow, 2000
+% (c) The University of Glasgow, 1997-2001
%
\section[PrelInt]{Module @PrelInt@}
\begin{code}
{-# OPTIONS -monly-3-regs #-}
-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
-
- -- internal stuff
- , intToInt8#, i8ToInt#, intToInt16#, i16ToInt#, intToInt32#, i32ToInt#,
- , intToInt64#, plusInt64#, minusInt64#, negateInt64#
-
- ) where
+#include "MachDeps.h"
-import PrelWord
-import PrelBits
-import PrelArr
-import PrelRead
-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 = intToInt16 . int8ToInt
-int8ToInt32 = intToInt32 . int8ToInt
-int16ToInt32 = intToInt32 . int16ToInt
-
-int16ToInt8 (I16# x) = I8# (intToInt8# x)
-int32ToInt8 (I32# x) = I8# (intToInt8# x)
-int32ToInt16 (I32# x) = I16# (intToInt16# x)
-
-int8ToInteger = toInteger
-int8ToInt64 = int32ToInt64 . int8ToInt32
+module PrelInt (
+ Int8(..), Int16(..), Int32(..), Int64(..))
+ where
-int16ToInteger = toInteger
-int16ToInt64 = int32ToInt64 . int16ToInt32
-
-int32ToInteger = toInteger
+import PrelBase
+import PrelEnum
+import PrelNum
+import PrelReal
+import PrelRead
+import PrelArr
+import PrelBits
+import PrelWord
-int64ToInt8 = int32ToInt8 . int64ToInt32
-int64ToInt16 = int32ToInt16 . int64ToInt32
+------------------------------------------------------------------------
+-- type Int8
+------------------------------------------------------------------------
------------------------------------------------------------------------------
--- The following rules for fromIntegral remove the need to export specialized
--- conversion functions.
------------------------------------------------------------------------------
+-- Int8 is represented in the same way as Int. Operations may assume
+-- and must ensure that it holds only values from its logical range.
-{-# 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#
+data Int8 = I8# Int# deriving (Eq, Ord)
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#
-
--- 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#)
+instance Show Int8 where
+ showsPrec p x = showsPrec p (fromIntegral x :: Int)
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#))
-
-instance Bounded Int8 where
- minBound = 0x80
- maxBound = 0x7f
+ (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 (I8# x#) = I8# (intToInt8# (negateInt# x#))
+ abs x | x >= 0 = x
+ | otherwise = negate x
+ signum x | x > 0 = 1
+ signum 0 = 0
+ signum _ = -1
+ fromInteger (S# i#) = I8# (intToInt8# i#)
+ fromInteger (J# s# d#) = I8# (intToInt8# (integer2Int# s# d#))
instance Real Int8 where
toRational x = toInteger x % 1
+instance Enum Int8 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Int8"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Int8"
+ toEnum i@(I# i#)
+ | i >= fromIntegral (minBound::Int8) && i <= fromIntegral (maxBound::Int8)
+ = I8# i#
+ | otherwise = toEnumError "Int8" i (minBound::Int8, maxBound::Int8)
+ fromEnum (I8# x#) = I# x#
+ enumFrom = boundedEnumFrom
+ enumFromThen = boundedEnumFromThen
+
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)
-
-
-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)))
+ quot x@(I8# x#) y@(I8# y#)
+ | y /= 0 = I8# (intToInt8# (x# `quotInt#` y#))
+ | otherwise = divZeroError "quot{Int8}" x
+ rem x@(I8# x#) y@(I8# y#)
+ | y /= 0 = I8# (intToInt8# (x# `remInt#` y#))
+ | otherwise = divZeroError "rem{Int8}" x
+ div x@(I8# x#) y@(I8# y#)
+ | y /= 0 = I8# (intToInt8# (x# `divInt#` y#))
+ | otherwise = divZeroError "div{Int8}" x
+ mod x@(I8# x#) y@(I8# y#)
+ | y /= 0 = I8# (intToInt8# (x# `modInt#` y#))
+ | otherwise = divZeroError "mod{Int8}" x
+ quotRem x@(I8# x#) y@(I8# y#)
+ | y /= 0 = (I8# (intToInt8# (x# `quotInt#` y#)),
+ I8# (intToInt8# (x# `remInt#` y#)))
+ | otherwise = divZeroError "quotRem{Int8}" x
+ divMod x@(I8# x#) y@(I8# y#)
+ | y /= 0 = (I8# (intToInt8# (x# `divInt#` y#)),
+ I8# (intToInt8# (x# `modInt#` y#)))
+ | otherwise = divZeroError "divMod{Int8}" x
+ toInteger (I8# x#) = S# x#
+
+instance Bounded Int8 where
+ minBound = -0x80
+ maxBound = 0x7F
instance Ix Int8 where
- range (m,n) = [m..n]
+ 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 >= fromIntegral (minBound::Int8) && x <= fromIntegral (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
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Int8"
+ inRange (m,n) i = m <= i && i <= n
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)
-
-binop8 :: (Int32 -> Int32 -> a) -> (Int8 -> Int8 -> a)
-binop8 op x y = int8ToInt32 x `op` int8ToInt32 y
+ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
instance Bits Int8 where
- (I8# x) .&. (I8# y) = I8# (word2Int# ((int2Word# x) `and#` (int2Word# y)))
- (I8# x) .|. (I8# y) = I8# (word2Int# ((int2Word# x) `or#` (int2Word# y)))
- (I8# x) `xor` (I8# y) = I8# (word2Int# ((int2Word# x) `xor#` (int2Word# y)))
- complement (I8# x) = I8# (word2Int# ((int2Word# x) `xor#` (int2Word# 0xff#)))
- shift (I8# x) i@(I# i#)
- | i > 0 = I8# (intToInt8# (iShiftL# (i8ToInt# x) i#))
- | otherwise = I8# (intToInt8# (iShiftRA# (i8ToInt# x) (negateInt# i#)))
- i8@(I8# x) `rotate` (I# i)
- | i ==# 0# = i8
- | i ># 0# =
- I8# (intToInt8# ( word2Int# (
- (int2Word# (iShiftL# (i8ToInt# x) i'))
- `or#`
- (int2Word# (iShiftRA# (word2Int# (
- (int2Word# x) `and#`
- (int2Word# (0x100# -# pow2# i2))))
- i2)))))
- | otherwise = rotate i8 (I# (8# +# i))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 7#)
- i2 = 8# -# i'
- bitSize _ = 8
- isSigned _ = True
-
-pow2# :: Int# -> Int#
-pow2# x# = iShiftL# 1# x#
-
-pow2_64# :: Int# -> Int64#
-pow2_64# x# = word64ToInt64# (shiftL64# (wordToWord64# (int2Word# 1#)) x#)
-
--- -----------------------------------------------------------------------------
--- Int16
--- -----------------------------------------------------------------------------
-
-data Int16 = I16# Int#
+ (I8# x#) .&. (I8# y#) = I8# (word2Int# (int2Word# x# `and#` int2Word# y#))
+ (I8# x#) .|. (I8# y#) = I8# (word2Int# (int2Word# x# `or#` int2Word# y#))
+ (I8# x#) `xor` (I8# y#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+ complement (I8# x#) = I8# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
+ (I8# x#) `shift` (I# i#)
+ | i# >=# 0# = I8# (intToInt8# (x# `iShiftL#` i#))
+ | otherwise = I8# (x# `iShiftRA#` negateInt# i#)
+ (I8# x#) `rotate` (I# i#) =
+ I8# (intToInt8# (word2Int# ((x'# `shiftL#` i'#) `or#`
+ (x'# `shiftRL#` (8# -# i'#)))))
+ where
+ x'# = wordToWord8# (int2Word# x#)
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
+ bitSize _ = 8
+ isSigned _ = True
-instance CCallable Int16
-instance CReturnable Int16
-
-int16ToInt (I16# x) = I# (i16ToInt# x)
+{-# RULES
+"fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (intToInt8# x#)
+"fromIntegral/Int8->a" fromIntegral = \(I8# x#) -> fromIntegral (I# x#)
+ #-}
-i16ToInt# :: Int# -> Int#
-i16ToInt# x = if x <=# 0x7fff# then x else x -# 0x10000#
- -- x's upper 16 bits should already be zero
+------------------------------------------------------------------------
+-- type Int16
+------------------------------------------------------------------------
--- 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)
+-- Int16 is represented in the same way as Int. Operations may assume
+-- and must ensure that it holds only values from its logical range.
-intToInt16# :: Int# -> Int#
-intToInt16# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xffff#)
+data Int16 = I16# Int# deriving (Eq, Ord)
-instance Eq Int16 where
- (I16# x#) == (I16# y#) = x# ==# y#
- (I16# x#) /= (I16# y#) = x# /=# y#
+instance CCallable Int16
+instance CReturnable Int16
-instance Ord Int16 where
- compare (I16# x#) (I16# y#) = compareInt# (i16ToInt# x#) (i16ToInt# y#)
+instance Show Int16 where
+ showsPrec p x = showsPrec p (fromIntegral x :: Int)
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#))
-
-instance Bounded Int16 where
- minBound = 0x8000
- maxBound = 0x7fff
+ (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 (I16# x#) = I16# (intToInt16# (negateInt# x#))
+ abs x | x >= 0 = x
+ | otherwise = negate x
+ signum x | x > 0 = 1
+ signum 0 = 0
+ signum _ = -1
+ fromInteger (S# i#) = I16# (intToInt16# i#)
+ fromInteger (J# s# d#) = I16# (intToInt16# (integer2Int# s# d#))
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)
-
-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
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Int16"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Int16"
+ toEnum i@(I# i#)
+ | i >= fromIntegral (minBound::Int16) && i <= fromIntegral (maxBound::Int16)
+ = I16# i#
+ | otherwise = toEnumError "Int16" i (minBound::Int16, maxBound::Int16)
+ fromEnum (I16# x#) = I# x#
+ enumFrom = boundedEnumFrom
+ enumFromThen = boundedEnumFromThen
- toEnum x
- | x >= fromIntegral (minBound::Int16) && x <= fromIntegral (maxBound::Int16)
- = intToInt16 x
- | otherwise
- = toEnumError "Int16" x (minBound::Int16, maxBound::Int16)
+instance Integral Int16 where
+ quot x@(I16# x#) y@(I16# y#)
+ | y /= 0 = I16# (intToInt16# (x# `quotInt#` y#))
+ | otherwise = divZeroError "quot{Int16}" x
+ rem x@(I16# x#) y@(I16# y#)
+ | y /= 0 = I16# (intToInt16# (x# `remInt#` y#))
+ | otherwise = divZeroError "rem{Int16}" x
+ div x@(I16# x#) y@(I16# y#)
+ | y /= 0 = I16# (intToInt16# (x# `divInt#` y#))
+ | otherwise = divZeroError "div{Int16}" x
+ mod x@(I16# x#) y@(I16# y#)
+ | y /= 0 = I16# (intToInt16# (x# `modInt#` y#))
+ | otherwise = divZeroError "mod{Int16}" x
+ quotRem x@(I16# x#) y@(I16# y#)
+ | y /= 0 = (I16# (intToInt16# (x# `quotInt#` y#)),
+ I16# (intToInt16# (x# `remInt#` y#)))
+ | otherwise = divZeroError "quotRem{Int16}" x
+ divMod x@(I16# x#) y@(I16# y#)
+ | y /= 0 = (I16# (intToInt16# (x# `divInt#` y#)),
+ I16# (intToInt16# (x# `modInt#` y#)))
+ | otherwise = divZeroError "divMod{Int16}" x
+ toInteger (I16# x#) = S# x#
- fromEnum = int16ToInt
+instance Bounded Int16 where
+ minBound = -0x8000
+ maxBound = 0x7FFF
- 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 Ix Int16 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Int16"
+ inRange (m,n) i = m <= i && i <= n
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)
-
-
-binop16 :: (Int32 -> Int32 -> a) -> (Int16 -> Int16 -> a)
-binop16 op x y = int16ToInt32 x `op` int16ToInt32 y
+ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
instance Bits Int16 where
- (I16# x) .&. (I16# y) = I16# (word2Int# ((int2Word# x) `and#` (int2Word# y)))
- (I16# x) .|. (I16# y) = I16# (word2Int# ((int2Word# x) `or#` (int2Word# y)))
- (I16# x) `xor` (I16# y) = I16# (word2Int# ((int2Word# x) `xor#` (int2Word# y)))
- complement (I16# x) = I16# (word2Int# ((int2Word# x) `xor#` (int2Word# 0xffff#)))
- shift (I16# x) i@(I# i#)
- | i > 0 = I16# (intToInt16# (iShiftL# (i16ToInt# x) i#))
- | otherwise = I16# (intToInt16# (iShiftRA# (i16ToInt# x) (negateInt# i#)))
- i16@(I16# x) `rotate` (I# i)
- | i ==# 0# = i16
- | i ># 0# =
- I16# (intToInt16# (word2Int# (
- (int2Word# (iShiftL# (i16ToInt# x) i'))
- `or#`
- (int2Word# (iShiftRA# ( word2Int# (
- (int2Word# x) `and#` (int2Word# (0x100# -# pow2# i2))))
- i2)))))
- | otherwise = rotate i16 (I# (16# +# i))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 15#)
- i2 = 16# -# i'
- bitSize _ = 16
- isSigned _ = True
-
--- -----------------------------------------------------------------------------
--- Int32
--- -----------------------------------------------------------------------------
-
-data Int32 = I32# Int#
+ (I16# x#) .&. (I16# y#) = I16# (word2Int# (int2Word# x# `and#` int2Word# y#))
+ (I16# x#) .|. (I16# y#) = I16# (word2Int# (int2Word# x# `or#` int2Word# y#))
+ (I16# x#) `xor` (I16# y#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+ complement (I16# x#) = I16# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
+ (I16# x#) `shift` (I# i#)
+ | i# >=# 0# = I16# (intToInt16# (x# `iShiftL#` i#))
+ | otherwise = I16# (x# `iShiftRA#` negateInt# i#)
+ (I16# x#) `rotate` (I# i#) =
+ I16# (intToInt16# (word2Int# ((x'# `shiftL#` i'#) `or#`
+ (x'# `shiftRL#` (16# -# i'#)))))
+ where
+ x'# = wordToWord16# (int2Word# x#)
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
+ bitSize _ = 16
+ isSigned _ = True
-instance CCallable Int32
-instance CReturnable Int32
+{-# RULES
+"fromIntegral/a->Int16" fromIntegral = \x -> case fromIntegral x of I# x# -> I16# (intToInt16# x#)
+"fromIntegral/Int16->a" fromIntegral = \(I16# x#) -> fromIntegral (I# x#)
+ #-}
-int32ToInt (I32# x) = I# (i32ToInt# x)
+------------------------------------------------------------------------
+-- type Int32
+------------------------------------------------------------------------
-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
+-- Int32 is represented in the same way as Int.
+#if WORD_SIZE_IN_BYTES == 8
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
#endif
-intToInt32 (I# x) = I32# (intToInt32# x)
+data Int32 = I32# Int# deriving (Eq, Ord)
-intToInt32# :: Int# -> Int#
-#if WORD_SIZE_IN_BYTES > 4
-intToInt32# i# = word2Int# ((int2Word# i#) `and#` int2Word# 0xffffffff#)
-#else
-intToInt32# i# = i#
+#if WORD_SIZE_IN_BYTES == 4
+{-# RULES "intToInt32#" forall x#. intToInt32# x# = x# #-}
#endif
-instance Eq Int32 where
- (I32# x#) == (I32# y#) = x# ==# y#
- (I32# x#) /= (I32# y#) = x# /=# y#
+instance CCallable Int32
+instance CReturnable Int32
-instance Ord Int32 where
- compare (I32# x#) (I32# y#) = compareInt# (i32ToInt# x#) (i32ToInt# y#)
+instance Show Int32 where
+ showsPrec p x = showsPrec p (fromIntegral x :: Int)
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#))
-
-
-instance Bounded Int32 where
- minBound = int2Int32 minBound
- maxBound = int2Int32 maxBound
-
-int2Int32 :: Int -> Int32
-int2Int32 (I# i#) = I32# (intToInt32# i#)
+ (I32# x#) + (I32# y#) = I32# (intToInt32# (x# +# y#))
+ (I32# x#) - (I32# y#) = I32# (intToInt32# (x# -# y#))
+ (I32# x#) * (I32# y#) = I32# (intToInt32# (x# *# y#))
+ negate (I32# x#) = I32# (intToInt32# (negateInt# x#))
+ abs x | x >= 0 = x
+ | otherwise = negate x
+ signum x | x > 0 = 1
+ signum 0 = 0
+ signum _ = -1
+ fromInteger (S# i#) = I32# (intToInt32# i#)
+ fromInteger (J# s# d#) = I32# (intToInt32# (integer2Int# s# d#))
instance Real Int32 where
toRational x = toInteger x % 1
+instance Enum Int32 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Int32"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Int32"
+#if WORD_SIZE_IN_BYTES == 4
+ toEnum (I# i#) = I32# i#
+#else
+ toEnum i@(I# i#)
+ | i >= fromIntegral (minBound::Int32) && i <= fromIntegral (maxBound::Int32)
+ = I32# i#
+ | otherwise = toEnumError "Int32" i (minBound::Int32, maxBound::Int32)
+#endif
+ fromEnum (I32# x#) = I# x#
+ enumFrom = boundedEnumFrom
+ enumFromThen = boundedEnumFromThen
+
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)
-
-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)))
+ quot x@(I32# x#) y@(I32# y#)
+ | y /= 0 = I32# (intToInt32# (x# `quotInt#` y#))
+ | otherwise = divZeroError "quot{Int32}" x
+ rem x@(I32# x#) y@(I32# y#)
+ | y /= 0 = I32# (intToInt32# (x# `remInt#` y#))
+ | otherwise = divZeroError "rem{Int32}" x
+ div x@(I32# x#) y@(I32# y#)
+ | y /= 0 = I32# (intToInt32# (x# `divInt#` y#))
+ | otherwise = divZeroError "div{Int32}" x
+ mod x@(I32# x#) y@(I32# y#)
+ | y /= 0 = I32# (intToInt32# (x# `modInt#` y#))
+ | otherwise = divZeroError "mod{Int32}" x
+ quotRem x@(I32# x#) y@(I32# y#)
+ | y /= 0 = (I32# (intToInt32# (x# `quotInt#` y#)),
+ I32# (intToInt32# (x# `remInt#` y#)))
+ | otherwise = divZeroError "quotRem{Int32}" x
+ divMod x@(I32# x#) y@(I32# y#)
+ | y /= 0 = (I32# (intToInt32# (x# `divInt#` y#)),
+ I32# (intToInt32# (x# `modInt#` y#)))
+ | otherwise = divZeroError "divMod{Int32}" x
+ toInteger (I32# x#) = S# x#
+
+instance Bounded Int32 where
+ minBound = -0x80000000
+ maxBound = 0x7FFFFFFF
instance Ix Int32 where
- range (m,n) = [m..n]
+ 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 >= fromIntegral (minBound::Int32) && x <= fromIntegral (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
-
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Int32"
+ inRange (m,n) i = m <= i && i <= n
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)
+ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
instance Bits Int32 where
- (I32# x) .&. (I32# y) = I32# (word2Int# ((int2Word# x) `and#` (int2Word# y)))
- (I32# x) .|. (I32# y) = I32# (word2Int# ((int2Word# x) `or#` (int2Word# y)))
- (I32# x) `xor` (I32# y) = I32# (word2Int# ((int2Word# x) `xor#` (int2Word# y)))
-#if WORD_SIZE_IN_BYTES > 4
- complement (I32# x) = I32# (word2Int# ((int2Word# x) `xor#` (int2Word# 0xffffffff#)))
-#else
- complement (I32# x) = I32# (word2Int# ((int2Word# x) `xor#` (int2Word# (negateInt# 1#))))
-#endif
- shift (I32# x) i@(I# i#)
- | i > 0 = I32# (intToInt32# (iShiftL# (i32ToInt# x) i#))
- | otherwise = I32# (intToInt32# (iShiftRA# (i32ToInt# x) (negateInt# i#)))
- i32@(I32# x) `rotate` (I# i)
- | i ==# 0# = i32
- | i ># 0# =
- -- ( (x<<i') | ((x&(0x100000000-2^i2))>>i2)
- I32# (intToInt32# ( word2Int# (
- (int2Word# (iShiftL# (i32ToInt# x) i'))
- `or#`
- (int2Word# (iShiftRA# (word2Int# (
- (int2Word# x)
- `and#`
- (int2Word# (maxBound# -# pow2# i2 +# 1#))))
- i2)))))
- | otherwise = rotate i32 (I# (32# +# i))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 31#)
- i2 = 32# -# i'
- (I32# maxBound#) = maxBound
- bitSize _ = 32
- isSigned _ = True
-
--- -----------------------------------------------------------------------------
--- Int64
--- -----------------------------------------------------------------------------
+ (I32# x#) .&. (I32# y#) = I32# (word2Int# (int2Word# x# `and#` int2Word# y#))
+ (I32# x#) .|. (I32# y#) = I32# (word2Int# (int2Word# x# `or#` int2Word# y#))
+ (I32# x#) `xor` (I32# y#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+ complement (I32# x#) = I32# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
+ (I32# x#) `shift` (I# i#)
+ | i# >=# 0# = I32# (intToInt32# (x# `iShiftL#` i#))
+ | otherwise = I32# (x# `iShiftRA#` negateInt# i#)
+ (I32# x#) `rotate` (I# i#) =
+ I32# (intToInt32# (word2Int# ((x'# `shiftL#` i'#) `or#`
+ (x'# `shiftRL#` (32# -# i'#)))))
+ where
+ x'# = wordToWord32# (int2Word# x#)
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
+ bitSize _ = 32
+ isSigned _ = True
-#if WORD_SIZE_IN_BYTES == 8
-data Int64 = I64# Int#
+{-# RULES
+"fromIntegral/a->Int32" fromIntegral = \x -> case fromIntegral x of I# x# -> I32# (intToInt32# x#)
+"fromIntegral/Int32->a" fromIntegral = \(I32# x#) -> fromIntegral (I# x#)
+ #-}
-int32ToInt64 (I32# i#) = I64# i#
+------------------------------------------------------------------------
+-- type Int64
+------------------------------------------------------------------------
-intToInt32# :: Int# -> Int#
-intToInt32# i# = word2Int# ((int2Word# i#) `and#` (case (maxBound::Word32) of W# x# -> x#))
+#if WORD_SIZE_IN_BYTES == 4
-int64ToInt32 (I64# i#) = I32# (intToInt32# w#)
+data Int64 = I64# Int64#
+
+instance Eq Int64 where
+ (I64# x#) == (I64# y#) = x# `eqInt64#` y#
+ (I64# x#) /= (I64# y#) = x# `neInt64#` y#
-instance Eq Int64 where
- (I64# x) == (I64# y) = x `eqInt#` y
- (I64# x) /= (I64# y) = x `neInt#` y
+instance Ord Int64 where
+ (I64# x#) < (I64# y#) = x# `ltInt64#` y#
+ (I64# x#) <= (I64# y#) = x# `leInt64#` y#
+ (I64# x#) > (I64# y#) = x# `gtInt64#` y#
+ (I64# x#) >= (I64# y#) = x# `geInt64#` y#
-instance Ord Int32 where
- compare (I64# x#) (I64# y#) = compareInt# x# y#
+instance Show Int64 where
+ showsPrec p x = showsPrec p (toInteger x)
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#)
+ (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 | x >= 0 = x
+ | otherwise = negate x
+ signum x | x > 0 = 1
+ signum 0 = 0
+ signum _ = -1
+ fromInteger (S# i#) = I64# (intToInt64# i#)
+ fromInteger (J# s# d#) = I64# (integerToInt64# s# d#)
-instance Bounded Int64 where
- minBound = integerToInt64 (-0x8000000000000000)
- maxBound = integerToInt64 0x7fffffffffffffff
+instance Enum Int64 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Int64"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Int64"
+ toEnum (I# i#) = I64# (intToInt64# i#)
+ fromEnum x@(I64# x#)
+ | x >= fromIntegral (minBound::Int) && x <= fromIntegral (maxBound::Int)
+ = I# (int64ToInt# x#)
+ | otherwise = fromEnumError "Int64" x
+ enumFrom = integralEnumFrom
+ enumFromThen = integralEnumFromThen
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
+ quot x@(I64# x#) y@(I64# y#)
+ | y /= 0 = I64# (x# `quotInt64#` y#)
+ | otherwise = divZeroError "quot{Int64}" x
+ rem x@(I64# x#) y@(I64# y#)
+ | y /= 0 = I64# (x# `remInt64#` y#)
+ | otherwise = divZeroError "rem{Int64}" x
+ div x@(I64# x#) y@(I64# y#)
+ | y /= 0 = I64# (x# `divInt64#` y#)
+ | otherwise = divZeroError "div{Int64}" x
+ mod x@(I64# x#) y@(I64# y#)
+ | y /= 0 = I64# (x# `modInt64#` y#)
+ | otherwise = divZeroError "mod{Int64}" x
+ quotRem x@(I64# x#) y@(I64# y#)
+ | y /= 0 = (I64# (x# `quotInt64#` y#), I64# (x# `remInt64#` y#))
+ | otherwise = divZeroError "quotRem{Int64}" x
+ divMod x@(I64# x#) y@(I64# y#)
+ | y /= 0 = (I64# (x# `divInt64#` y#), I64# (x# `modInt64#` y#))
+ | otherwise = divZeroError "divMod{Int64}" x
+ toInteger x@(I64# x#)
+ | x >= -0x80000000 && x <= 0x7FFFFFFF
+ = S# (int64ToInt# x#)
+ | otherwise = case int64ToInteger# x# of (# s, d #) -> J# s d
+
+divInt64#, modInt64# :: Int64# -> Int64# -> Int64#
+x# `divInt64#` y#
+ | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#)
+ = ((x# `minusInt64#` y#) `minusInt64#` intToInt64# 1#) `quotInt64#` y#
+ | (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#)
+ = ((x# `minusInt64#` y#) `plusInt64#` intToInt64# 1#) `quotInt64#` y#
+ | otherwise = x# `quotInt64#` y#
+x# `modInt64#` y#
+ | (x# `gtInt64#` intToInt64# 0#) && (y# `ltInt64#` intToInt64# 0#) ||
+ (x# `ltInt64#` intToInt64# 0#) && (y# `gtInt64#` intToInt64# 0#)
+ = if r# `neInt64#` intToInt64# 0# then r# `plusInt64#` y# else intToInt64# 0#
+ | otherwise = r#
+ where
+ r# = x# `remInt64#` y#
- a@(I64# _) `quotRem` b@(I64# _) = (a `quotInt64` b, a `remInt64` b)
- toInteger (I64# i#) = toInteger (I# i#)
-
-remInt64 (I64# x) (I64# y) = I64# (x `remInt#` y)
-quotInt64 (I64# x) (I64# y) = I64# (x `quotInt#` y)
+instance Read Int64 where
+ readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
-int64ToInteger (I64# i#) = toInteger (I# i#)
-integerToInt64 i = case fromInteger i of { I# i# -> I64# i# }
+instance Bits Int64 where
+ (I64# x#) .&. (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `and64#` int64ToWord64# y#))
+ (I64# x#) .|. (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `or64#` int64ToWord64# y#))
+ (I64# x#) `xor` (I64# y#) = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#))
+ complement (I64# x#) = I64# (word64ToInt64# (not64# (int64ToWord64# x#)))
+ (I64# x#) `shift` (I# i#)
+ | i# >=# 0# = I64# (x# `iShiftL64#` i#)
+ | otherwise = I64# (x# `iShiftRA64#` negateInt# i#)
+ (I64# x#) `rotate` (I# i#) =
+ I64# (word64ToInt64# ((x'# `shiftL64#` i'#) `or64#`
+ (x'# `shiftRL64#` (64# -# i'#))))
+ where
+ x'# = int64ToWord64# x#
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+ bitSize _ = 64
+ isSigned _ = True
+
+foreign import "stg_eqInt64" unsafe eqInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_neInt64" unsafe neInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_ltInt64" unsafe ltInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_leInt64" unsafe leInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_gtInt64" unsafe gtInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_geInt64" unsafe geInt64# :: Int64# -> Int64# -> Bool
+foreign import "stg_plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64#
+foreign import "stg_quotWord64" unsafe quotInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_remWord64" unsafe remInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64#
+foreign import "stg_int64ToInt" unsafe int64ToInt# :: Int64# -> Int#
+foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64#
+foreign import "stg_word64ToWord" unsafe word64ToWord# :: Word64# -> Word#
+foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64#
+foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64#
+foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_not64" unsafe not64# :: Word64# -> Word64#
+foreign import "stg_iShiftL64" unsafe iShiftL64# :: Int64# -> Int# -> Int64#
+foreign import "stg_iShiftRA64" unsafe iShiftRA64# :: Int64# -> Int# -> Int64#
+foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
-intToInt64 (I# i#) = I64# i#
-int64ToInt (I64# i#) = I# i#
+{-# RULES
+"fromIntegral/Int->Int64" fromIntegral = \(I# x#) -> I64# (intToInt64# x#)
+"fromIntegral/Word->Int64" fromIntegral = \(W# x#) -> I64# (word64ToInt64# (wordToWord64# x#))
+"fromIntegral/Word64->Int64" fromIntegral = \(W64# x#) -> I64# (word64ToInt64# x#)
+"fromIntegral/Int64->Int" fromIntegral = \(I64# x#) -> I# (int64ToInt# x#)
+"fromIntegral/Int64->Word" fromIntegral = \(I64# x#) -> W# (int2Word# (int64ToInt# x#))
+"fromIntegral/Int64->Word64" fromIntegral = \(I64# x#) -> W64# (int64ToWord64# x#)
+"fromIntegral/Int64->Int64" fromIntegral = id :: Int64 -> Int64
+ #-}
#else
---assume: support for long-longs
-data Int64 = I64# Int64#
-int32ToInt64 (I32# i#) = I64# (intToInt64# i#)
-int64ToInt32 (I64# i#) = I32# (int64ToInt# i#)
+data Int64 = I64# Int# deriving (Eq, Ord)
-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 Show Int64 where
+ showsPrec p x = showsPrec p (fromIntegral x :: Int)
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
-
-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
-
-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#)
-
--- Int64# 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#
-
-foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64#
-foreign import "stg_int64ToInt" unsafe int64ToInt# :: Int64# -> Int#
-foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64#
-foreign import "stg_remInt64" unsafe remInt64# :: Int64# -> Int64# -> Int64#
-foreign import "stg_quotInt64" unsafe quotInt64# :: Int64# -> Int64# -> Int64#
-foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64#
-foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64#
-foreign import "stg_plusInt64" unsafe 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 CCallable Int64
-instance CReturnable Int64
+ (I64# x#) + (I64# y#) = I64# (x# +# y#)
+ (I64# x#) - (I64# y#) = I64# (x# -# y#)
+ (I64# x#) * (I64# y#) = I64# (x# *# y#)
+ negate (I64# x#) = I64# (negateInt# x#)
+ abs x | x >= 0 = x
+ | otherwise = negate x
+ signum x | x > 0 = 1
+ signum 0 = 0
+ signum _ = -1
+ fromInteger (S# i#) = I64# i#
+ fromInteger (J# s# d#) = I64# (integer2Int# s# d#)
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]
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Int64"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Int64"
+ toEnum (I# i#) = I64# i#
+ fromEnum (I64# x#) = I# x#
+ enumFrom = boundedEnumFrom
+ enumFromThen = boundedEnumFromThen
-instance Show Int64 where
- showsPrec p i64 = showsPrec p (int64ToInteger i64)
+instance Integral Int64 where
+ quot x@(I64# x#) y@(I64# y#)
+ | y /= 0 = I64# (x# `quotInt#` y#)
+ | otherwise = divZeroError "quot{Int64}" x
+ rem x@(I64# x#) y@(I64# y#)
+ | y /= 0 = I64# (x# `remInt#` y#)
+ | otherwise = divZeroError "rem{Int64}" x
+ div x@(I64# x#) y@(I64# y#)
+ | y /= 0 = I64# (x# `divInt#` y#)
+ | otherwise = divZeroError "div{Int64}" x
+ mod x@(I64# x#) y@(I64# y#)
+ | y /= 0 = I64# (x# `modInt#` y#)
+ | otherwise = divZeroError "mod{Int64}" x
+ quotRem x@(I64# x#) y@(I64# y#)
+ | y /= 0 = (I64# (x# `quotInt#` y#), I64# (x# `remInt#` y#))
+ | otherwise = divZeroError "quotRem{Int64}" x
+ divMod x@(I64# x#) y@(I64# y#)
+ | y /= 0 = (I64# (x# `divInt#` y#), I64# (x# `modInt#` y#))
+ | otherwise = divZeroError "divMod{Int64}" x
+ toInteger (I64# x#) = S# x#
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
+ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
-instance Real Int64 where
- toRational x = toInteger x % 1
-
-#if WORD_SIZE_IN_BYTES == 8
instance Bits Int64 where
- (I64# x) .&. (I64# y) = I64# (word2Int# ((int2Word# x) `and#` (int2Word# y)))
- (I64# x) .|. (I64# y) = I64# (word2Int# ((int2Word# x) `or#` (int2Word# y)))
- (I64# x) `xor` (I64# y) = I64# (word2Int# ((int2Word# x) `xor#` (int2Word# y)))
- complement (I64# x) = I64# (negateInt# x)
- shift (I64# x) i@(I# i#)
- | i > 0 = I64# (iShiftL# x i#)
- | otherwise = I64# (iShiftRA# x (negateInt# i#))
- i64@(I64# x) `rotate` (I# i)
- | i ==# 0# = i64
- | i ># 0# =
- -- ( (x<<i') | ((x&(0x10000000000000000-2^i2))>>i2) )
- I64# (word2Int# (
- (int2Word# (iShiftL# x i'))
- `or#`
- (int2Word# (iShiftRA# (word2Int# (
- (int2Word# x)
- `and#`
- (int2Word# (maxBound# -# pow2# i2 +# 1#))))
- i2))))
- | otherwise = rotate i64 (I# (64# +# i))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 63#)
- i2 = 64# -# i'
- (I64# maxBound#) = maxBound
- bitSize _ = 64
- isSigned _ = True
-
-#else /* WORD_SIZE_IN_BYTES != 8 */
+ (I64# x#) .&. (I64# y#) = I64# (word2Int# (int2Word# x# `and#` int2Word# y#))
+ (I64# x#) .|. (I64# y#) = I64# (word2Int# (int2Word# x# `or#` int2Word# y#))
+ (I64# x#) `xor` (I64# y#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# y#))
+ complement (I64# x#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))
+ (I64# x#) `shift` (I# i#)
+ | i# >=# 0# = I64# (x# `iShiftL#` i#)
+ | otherwise = I64# (x# `iShiftRA#` negateInt# i#)
+ (I64# x#) `rotate` (I# i#) =
+ I64# (word2Int# ((x'# `shiftL#` i'#) `or#`
+ (x'# `shiftRL#` (64# -# i'#))))
+ where
+ x'# = int2Word# x#
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+ bitSize _ = 64
+ isSigned _ = True
-instance Bits Int64 where
- (I64# x) .&. (I64# y) = I64# (word64ToInt64# ((int64ToWord64# x) `and64#` (int64ToWord64# y)))
- (I64# x) .|. (I64# y) = I64# (word64ToInt64# ((int64ToWord64# x) `or64#` (int64ToWord64# y)))
- (I64# x) `xor` (I64# y) = I64# (word64ToInt64# ((int64ToWord64# x) `xor64#` (int64ToWord64# y)))
- complement (I64# x) = I64# (negateInt64# x)
- shift (I64# x) i@(I# i#)
- | i > 0 = I64# (iShiftL64# x i#)
- | otherwise = I64# (iShiftRA64# x (negateInt# i#))
- i64@(I64# x) `rotate` (I# i)
- | i ==# 0# = i64
- | i ># 0# =
- -- ( (x<<i') | ((x&(0x10000000000000000-2^i2))>>i2) )
- I64# (word64ToInt64# (
- (int64ToWord64# (iShiftL64# x i')) `or64#`
- (int64ToWord64# (iShiftRA64# (word64ToInt64# ((int64ToWord64# x) `and64#`
- (int64ToWord64# (maxBound# `minusInt64#` (pow2_64# i2 `plusInt64#` (intToInt64# 1#))))))
- i2))))
- | otherwise = rotate i64 (I# (64# +# i))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 63#)
- i2 = 64# -# i'
- (I64# maxBound#) = maxBound
- bitSize _ = 64
- isSigned _ = True
-
-foreign import "stg_not64" unsafe not64# :: Word64# -> Word64#
-foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
-foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64#
-foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64#
-foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
-foreign import "stg_iShiftRA64" unsafe iShiftRA64# :: Int64# -> Int# -> Int64#
-foreign import "stg_iShiftRL64" unsafe iShiftRL64# :: Int64# -> Int# -> Int64#
-foreign import "stg_iShiftL64" unsafe iShiftL64# :: Int64# -> Int# -> Int64#
-foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
+{-# RULES
+"fromIntegral/a->Int64" fromIntegral = \x -> case fromIntegral x of I# x# -> I64# (intToInt64# x#)
+"fromIntegral/Int64->a" fromIntegral = \(I64# x#) -> fromIntegral (I# x#)
+ #-}
#endif
--- ---------------------------------------------------------------------------
--- Miscellaneous Utilities
--- ---------------------------------------------------------------------------
+instance CCallable Int64
+instance CReturnable Int64
+
+instance Real Int64 where
+ toRational x = toInteger x % 1
-absReal :: (Ord a, Num a) => a -> a
-absReal x | x >= 0 = x
- | otherwise = -x
+instance Bounded Int64 where
+ minBound = -0x8000000000000000
+ maxBound = 0x7FFFFFFFFFFFFFFF
-signumReal :: (Ord a, Num a) => a -> a
-signumReal x | x == 0 = 0
- | x > 0 = 1
- | otherwise = -1
+instance Ix Int64 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Int64"
+ inRange (m,n) i = m <= i && i <= n
\end{code}
% ------------------------------------------------------------------------------
-% $Id: PrelNum.lhs,v 1.36 2001/02/22 16:48:24 qrczak Exp $
+% $Id: PrelNum.lhs,v 1.37 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The University of Glasgow, 1994-2000
%
x - y = x + negate y
negate x = 0 - x
-fromInt :: Num a => Int -> a
--- For backward compatibility
-fromInt (I# i#) = fromInteger (S# i#)
-\end{code}
-
-A few small numeric functions
-
-\begin{code}
-subtract :: (Num a) => a -> a -> a
{-# INLINE subtract #-}
-subtract x y = y - x
-
-ord_0 :: Int
-ord_0 = ord '0'
+subtract :: (Num a) => a -> a -> a
+subtract x y = y - x
\end{code}
\begin{code}
instance Num Int where
- (+) x y = plusInt x y
- (-) x y = minusInt x y
- negate x = negateInt x
- (*) x y = timesInt x y
- abs n = if n `geInt` 0 then n else (negateInt n)
+ (+) = plusInt
+ (-) = minusInt
+ negate = negateInt
+ (*) = timesInt
+ abs n = if n `geInt` 0 then n else negateInt n
signum n | n `ltInt` 0 = negateInt 1
| n `eqInt` 0 = 0
| otherwise = 1
- fromInteger n = integer2Int n
+ fromInteger = integer2Int
\end{code}
%*********************************************************
\begin{code}
-instance Show Integer where
- showsPrec x = showSignedInteger x
- showList = showList__ (showsPrec 0)
-
-showSignedInteger :: Int -> Integer -> ShowS
-showSignedInteger p n r
- | n < 0 && p > 6 = '(':jtos n (')':r)
- | otherwise = jtos n r
+instance Show Integer where
+ showsPrec p n r
+ | n < 0 && p > 6 = '(' : jtos n (')' : r)
+ | otherwise = jtos n r
+ showList = showList__ (showsPrec 0)
jtos :: Integer -> String -> String
-jtos i rs
- | i < 0 = '-' : jtos' (-i) rs
- | otherwise = jtos' i rs
- where
- jtos' :: Integer -> String -> String
- jtos' n cs
- | n < 10 = chr (fromInteger n + (ord_0::Int)) : cs
- | otherwise = jtos' q (chr (integer2Int r + (ord_0::Int)) : cs)
+jtos n cs
+ | n < 0 = '-' : jtos' (-n) cs
+ | otherwise = jtos' n cs
where
- (q,r) = n `quotRemInteger` 10
+ jtos' :: Integer -> String -> String
+ jtos' n cs
+ | n < 10 = case unsafeChr (ord '0' + fromInteger n) of
+ c@(C# _) -> c:cs
+ | otherwise = case unsafeChr (ord '0' + fromInteger r) of
+ c@(C# _) -> jtos' q (c:cs)
+ where
+ (q,r) = n `quotRemInteger` 10
\end{code}
% ------------------------------------------------------------------------------
-% $Id: PrelRead.lhs,v 1.17 2001/02/22 13:17:59 simonpj Exp $
+% $Id: PrelRead.lhs,v 1.18 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The University of Glasgow, 1994-2000
%
ReadS Int,
ReadS Integer #-}
readDec :: (Integral a) => ReadS a
-readDec = readInt 10 isDigit (\d -> ord d - ord_0)
+readDec = readInt 10 isDigit (\d -> ord d - ord '0')
{-# SPECIALISE readOct ::
ReadS Int,
ReadS Integer #-}
readOct :: (Integral a) => ReadS a
-readOct = readInt 8 isOctDigit (\d -> ord d - ord_0)
+readOct = readInt 8 isOctDigit (\d -> ord d - ord '0')
{-# SPECIALISE readHex ::
ReadS Int,
ReadS Integer #-}
readHex :: (Integral a) => ReadS a
readHex = readInt 16 isHexDigit hex
- where hex d = ord d - (if isDigit d then ord_0
+ where hex d = ord d - (if isDigit d then ord '0'
else ord (if isUpper d then 'A' else 'a') - 10)
readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a
readInt radix isDig digToInt s = do
(ds,r) <- nonnull isDig s
- return (foldl1 (\n d -> n * radix + d) (map (fromInteger . int2Integer . digToInt) ds), r)
+ return (foldl1 (\n d -> n * radix + d)
+ (map (fromInteger . toInteger . digToInt) ds), r)
{-# SPECIALISE readSigned ::
ReadS Int -> ReadS Int,
% ------------------------------------------------------------------------------
-% $Id: PrelReal.lhs,v 1.9 2001/02/22 16:48:24 qrczak Exp $
+% $Id: PrelReal.lhs,v 1.10 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The University of Glasgow, 1994-2000
%
divMod n d = if signum r == negate (signum d) then (q-1, r+d) else qr
where qr@(q,r) = quotRem n d
-toInt :: Integral a => a -> Int
--- For backward compatibility
-toInt i = fromInteger (toInteger i)
-
class (Num a) => Fractional a where
(/) :: a -> a -> a
recip :: a -> a
%*********************************************************
%* *
+\subsection{Coercions}
+%* *
+%*********************************************************
+
+\begin{code}
+fromIntegral :: (Integral a, Num b) => a -> b
+fromIntegral = fromInteger . toInteger
+
+{-# RULES
+"fromIntegral/Int->Int" fromIntegral = id :: Int -> Int
+ #-}
+
+realToFrac :: (Real a, Fractional b) => a -> b
+realToFrac = fromRational . toRational
+
+{-# RULES
+"realToFrac/Int->Int" realToFrac = id :: Int -> Int
+ #-}
+
+-- For backward compatibility
+{- DEPRECATED fromInt "use fromIntegral instead" -}
+fromInt :: Num a => Int -> a
+fromInt = fromIntegral
+
+-- For backward compatibility
+{- DEPRECATED toInt "use fromIntegral instead" -}
+toInt :: Integral a => a -> Int
+toInt = fromIntegral
+\end{code}
+
+%*********************************************************
+%* *
\subsection{Overloaded numeric functions}
%* *
%*********************************************************
"gcd/Integer->Integer->Integer" gcd = gcdInteger
"lcm/Integer->Integer->Integer" lcm = lcmInteger
#-}
+
+integralEnumFrom :: (Integral a, Bounded a) => a -> [a]
+integralEnumFrom n = map fromInteger [toInteger n .. toInteger (maxBound `asTypeOf` n)]
+
+integralEnumFromThen :: (Integral a, Bounded a) => a -> a -> [a]
+integralEnumFromThen n1 n2
+ | i_n2 >= i_n1 = map fromInteger [i_n1, i_n2 .. toInteger (maxBound `asTypeOf` n1)]
+ | otherwise = map fromInteger [i_n1, i_n2 .. toInteger (minBound `asTypeOf` n1)]
+ where
+ i_n1 = toInteger n1
+ i_n2 = toInteger n2
\end{code}
% ------------------------------------------------------------------------------
-% $Id: PrelShow.lhs,v 1.12 2000/09/14 13:46:42 simonpj Exp $
+% $Id: PrelShow.lhs,v 1.13 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The University of Glasgow, 1992-2000
%
-- The sticking point is the recursive call to (showl xs), which
-- it can't figure out would be ok with arity 2.
-instance Show Int where
- showsPrec p n = showSignedInt p n
+instance Show Int where
+ showsPrec = showSignedInt
instance Show a => Show (Maybe a) where
showsPrec _p Nothing s = showString "Nothing" s
intToDigit :: Int -> Char
intToDigit (I# i)
- | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
- | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `plusInt` I# i `minusInt` I# 10#)
- | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
+ | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i)
+ | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` I# 10# `plusInt` I# i)
+ | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i))
\end{code}
\begin{code}
showSignedInt :: Int -> Int -> ShowS
showSignedInt (I# p) (I# n) r
- | n <# 0# && p ># 6# = '(':itos n (')':r)
- | otherwise = itos n r
+ | n <# 0# && p ># 6# = '(' : itos n (')' : r)
+ | otherwise = itos n r
itos :: Int# -> String -> String
-itos n r
- | n >=# 0# = itos' n r
- | negateInt# n <# 0# = -- n is minInt, a difficult number
- itos (n `quotInt#` 10#) (itos' (negateInt# (n `remInt#` 10#)) r)
- | otherwise = '-':itos' (negateInt# n) r
- where
- itos' :: Int# -> String -> String
- -- x >= 0
- itos' x cs
- | x <# 10# = C# (chr# (x +# ord# '0'#)) : cs
- | otherwise = itos' (x `quotInt#` 10#)
- (C# (chr# (x `remInt#` 10# +# ord# '0'#)) : cs)
+itos n# cs
+ | n# <# 0# = let
+ n'# = negateInt# n#
+ in if n'# <# 0# -- minInt?
+ then '-' : itos' (negateInt# (n'# `quotInt#` 10#))
+ (itos' (negateInt# (n'# `remInt#` 10#)) cs)
+ else '-' : itos' n'# cs
+ | otherwise = itos' n# cs
+ where
+ itos' :: Int# -> String -> String
+ itos' n# cs
+ | n# <# 10# = C# (chr# (ord# '0'# +# n#)) : cs
+ | otherwise = itos' (n# `quotInt#` 10#)
+ (C# (chr# (ord# '0'# +# (n# `remInt#` 10#))) : cs)
\end{code}
%*********************************************************
% -----------------------------------------------------------------------------
-% $Id: PrelStorable.lhs,v 1.2 2001/02/05 11:49:20 chak Exp $
+% $Id: PrelStorable.lhs,v 1.3 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The FFI task force, 2000
%
System-dependent, but rather obvious instances
\begin{code}
-instance Storable Char where
- sizeOf _ = sizeOf (undefined::Word32)
- alignment _ = alignment (undefined::Word32)
- peekElemOff p i = liftM (chr . fromIntegral) $ peekElemOff (castPtr p::Ptr Word32) i
- pokeElemOff p i x = pokeElemOff (castPtr p::Ptr Word32) i (fromIntegral (ord x))
-
instance Storable Bool where
sizeOf _ = sizeOf (undefined::CInt)
alignment _ = alignment (undefined::CInt)
peekElemOff p i = liftM FunPtr $ peekElemOff (castPtr p) i
pokeElemOff p i (FunPtr x) = pokeElemOff (castPtr p) i x
-#define STORABLE(T,size,align,read,write) \
-instance Storable (T) where { \
- sizeOf _ = size; \
- alignment _ = align; \
- peekElemOff a i = read a i; \
- pokeElemOff a i x = write a i x }
+#define STORABLE(T,size,align,read,write) \
+instance Storable (T) where { \
+ sizeOf _ = size; \
+ alignment _ = align; \
+ peekElemOff = read; \
+ pokeElemOff = write }
+
+STORABLE(Char,SIZEOF_INT32,ALIGNMENT_INT32,
+ readWideCharOffPtr,writeWideCharOffPtr)
-STORABLE(Int,SIZEOF_INT,ALIGNMENT_INT,
+STORABLE(Int,SIZEOF_LONG,ALIGNMENT_LONG,
readIntOffPtr,writeIntOffPtr)
+STORABLE(Word,SIZEOF_LONG,ALIGNMENT_LONG,
+ readWordOffPtr,writeWordOffPtr)
+
STORABLE((Ptr a),SIZEOF_VOID_P,ALIGNMENT_VOID_P,
readPtrOffPtr,writePtrOffPtr)
\begin{code}
#ifdef __GLASGOW_HASKELL__
-readIntOffPtr :: Ptr Int -> Int -> IO Int
-readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a)
-readFloatOffPtr :: Ptr Float -> Int -> IO Float
-readDoubleOffPtr :: Ptr Double -> Int -> IO Double
-readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a)
-readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8
-readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16
-readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32
-readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64
-readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8
-readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16
-readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32
-readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64
-
+readWideCharOffPtr :: Ptr Char -> Int -> IO Char
+readIntOffPtr :: Ptr Int -> Int -> IO Int
+readWordOffPtr :: Ptr Word -> Int -> IO Word
+readPtrOffPtr :: Ptr (Ptr a) -> Int -> IO (Ptr a)
+readFloatOffPtr :: Ptr Float -> Int -> IO Float
+readDoubleOffPtr :: Ptr Double -> Int -> IO Double
+readStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> IO (StablePtr a)
+readInt8OffPtr :: Ptr Int8 -> Int -> IO Int8
+readInt16OffPtr :: Ptr Int16 -> Int -> IO Int16
+readInt32OffPtr :: Ptr Int32 -> Int -> IO Int32
+readInt64OffPtr :: Ptr Int64 -> Int -> IO Int64
+readWord8OffPtr :: Ptr Word8 -> Int -> IO Word8
+readWord16OffPtr :: Ptr Word16 -> Int -> IO Word16
+readWord32OffPtr :: Ptr Word32 -> Int -> IO Word32
+readWord64OffPtr :: Ptr Word64 -> Int -> IO Word64
+
+readWideCharOffPtr (Ptr a) (I# i)
+ = IO $ \s -> case readWideCharOffAddr# a i s of (# s2, x #) -> (# s2, C# x #)
readIntOffPtr (Ptr a) (I# i)
- = IO $ \s -> case readIntOffAddr# a i s of { (# s,x #) -> (# s, I# x #) }
+ = IO $ \s -> case readIntOffAddr# a i s of (# s2, x #) -> (# s2, I# x #)
+readWordOffPtr (Ptr a) (I# i)
+ = IO $ \s -> case readWordOffAddr# a i s of (# s2, x #) -> (# s2, W# x #)
readPtrOffPtr (Ptr a) (I# i)
- = IO $ \s -> case readAddrOffAddr# a i s of { (# s,x #) -> (# s, Ptr x #) }
+ = IO $ \s -> case readAddrOffAddr# a i s of (# s2, x #) -> (# s2, Ptr x #)
readFloatOffPtr (Ptr a) (I# i)
- = IO $ \s -> case readFloatOffAddr# a i s of { (# s,x #) -> (# s, F# x #) }
+ = IO $ \s -> case readFloatOffAddr# a i s of (# s2, x #) -> (# s2, F# x #)
readDoubleOffPtr (Ptr a) (I# i)
- = IO $ \s -> case readDoubleOffAddr# a i s of { (# s,x #) -> (# s, D# x #) }
+ = IO $ \s -> case readDoubleOffAddr# a i s of (# s2, x #) -> (# s2, D# x #)
readStablePtrOffPtr (Ptr a) (I# i)
- = IO $ \s -> case readStablePtrOffAddr# a i s of { (# s,x #) -> (# s, StablePtr x #) }
-
+ = IO $ \s -> case readStablePtrOffAddr# a i s of (# s2, x #) -> (# s2, StablePtr x #)
readInt8OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt8OffAddr# a i s of (# s, w #) -> (# s, I8# w #)
-
+ = IO $ \s -> case readInt8OffAddr# a i s of (# s2, x #) -> (# s2, I8# x #)
readInt16OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt16OffAddr# a i s of (# s, w #) -> (# s, I16# w #)
-
+ = IO $ \s -> case readInt16OffAddr# a i s of (# s2, x #) -> (# s2, I16# x #)
readInt32OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt32OffAddr# a i s of (# s, w #) -> (# s, I32# w #)
-
-#if WORD_SIZE_IN_BYTES == 8
-readInt64OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readIntOffAddr# a i s of (# s, w #) -> (# s, I64# w #)
-#else
+ = IO $ \s -> case readInt32OffAddr# a i s of (# s2, x #) -> (# s2, I32# x #)
readInt64OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readInt64OffAddr# a i s of (# s, w #) -> (# s, I64# w #)
-#endif
-
-
-writeIntOffPtr :: Ptr Int -> Int -> Int -> IO ()
-writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO ()
-writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO ()
-writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO ()
-writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO ()
-writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO ()
-writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO ()
-writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO ()
-writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO ()
-writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO ()
-writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO ()
-writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO ()
-writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO ()
-
-writeIntOffPtr (Ptr a#) (I# i#) (I# e#) = IO $ \ s# ->
- case (writeIntOffAddr# a# i# e# s#) of s2# -> (# s2#, () #)
-
-writePtrOffPtr (Ptr a#) (I# i#) (Ptr e#) = IO $ \ s# ->
- case (writeAddrOffAddr# a# i# e# s#) of s2# -> (# s2#, () #)
-
-writeFloatOffPtr (Ptr a#) (I# i#) (F# e#) = IO $ \ s# ->
- case (writeFloatOffAddr# a# i# e# s#) of s2# -> (# s2#, () #)
-
-writeDoubleOffPtr (Ptr a#) (I# i#) (D# e#) = IO $ \ s# ->
- case (writeDoubleOffAddr# a# i# e# s#) of s2# -> (# s2#, () #)
-
-writeStablePtrOffPtr (Ptr a#) (I# i#) (StablePtr e#) = IO $ \ s# ->
- case (writeStablePtrOffAddr# a# i# e# s#) of s2# -> (# s2# , () #)
-
-writeInt8OffPtr (Ptr a#) (I# i#) (I8# w#) = IO $ \ s# ->
- case (writeInt8OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-
-writeInt16OffPtr (Ptr a#) (I# i#) (I16# w#) = IO $ \ s# ->
- case (writeInt16OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-
-writeInt32OffPtr (Ptr a#) (I# i#) (I32# w#) = IO $ \ s# ->
- case (writeInt32OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-
-#if WORD_SIZE_IN_BYTES == 8
-writeInt64OffPtr (Ptr a#) (I# i#) (I64# w#) = IO $ \ s# ->
- case (writeIntOffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-#else
-writeInt64OffPtr (Ptr a#) (I# i#) (I64# w#) = IO $ \ s# ->
- case (writeInt64OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-#endif
-
+ = IO $ \s -> case readInt64OffAddr# a i s of (# s2, x #) -> (# s2, I64# x #)
readWord8OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readWord8OffAddr# a i s of (# s, w #) -> (# s, W8# w #)
-
+ = IO $ \s -> case readWord8OffAddr# a i s of (# s2, x #) -> (# s2, W8# x #)
readWord16OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readWord16OffAddr# a i s of (# s, w #) -> (# s, W16# w #)
-
+ = IO $ \s -> case readWord16OffAddr# a i s of (# s2, x #) -> (# s2, W16# x #)
readWord32OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readWord32OffAddr# a i s of (# s, w #) -> (# s, W32# w #)
-
-#if WORD_SIZE_IN_BYTES == 8
-readWord64OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readWordOffAddr# a i s of (# s, w #) -> (# s, W64# w #)
-#else
+ = IO $ \s -> case readWord32OffAddr# a i s of (# s2, x #) -> (# s2, W32# x #)
readWord64OffPtr (Ptr a) (I# i)
- = IO $ \s -> case readWord64OffAddr# a i s of (# s, w #) -> (# s, W64# w #)
-#endif
-
-writeWord8OffPtr (Ptr a#) (I# i#) (W8# w#) = IO $ \ s# ->
- case (writeWord8OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-
-writeWord16OffPtr (Ptr a#) (I# i#) (W16# w#) = IO $ \ s# ->
- case (writeWord16OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-
-writeWord32OffPtr (Ptr a#) (I# i#) (W32# w#) = IO $ \ s# ->
- case (writeWord32OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-
-#if WORD_SIZE_IN_BYTES == 8
-writeWord64OffPtr (Ptr a#) (I# i#) (W64# w#) = IO $ \ s# ->
- case (writeWordOffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-#else
-writeWord64OffPtr (Ptr a#) (I# i#) (W64# w#) = IO $ \ s# ->
- case (writeWord64OffAddr# a# i# w# s#) of s2# -> (# s2#, () #)
-#endif
+ = IO $ \s -> case readWord64OffAddr# a i s of (# s2, x #) -> (# s2, W64# x #)
+
+writeWideCharOffPtr :: Ptr Char -> Int -> Char -> IO ()
+writeIntOffPtr :: Ptr Int -> Int -> Int -> IO ()
+writeWordOffPtr :: Ptr Word -> Int -> Word -> IO ()
+writePtrOffPtr :: Ptr (Ptr a) -> Int -> Ptr a -> IO ()
+writeFloatOffPtr :: Ptr Float -> Int -> Float -> IO ()
+writeDoubleOffPtr :: Ptr Double -> Int -> Double -> IO ()
+writeStablePtrOffPtr :: Ptr (StablePtr a) -> Int -> StablePtr a -> IO ()
+writeInt8OffPtr :: Ptr Int8 -> Int -> Int8 -> IO ()
+writeInt16OffPtr :: Ptr Int16 -> Int -> Int16 -> IO ()
+writeInt32OffPtr :: Ptr Int32 -> Int -> Int32 -> IO ()
+writeInt64OffPtr :: Ptr Int64 -> Int -> Int64 -> IO ()
+writeWord8OffPtr :: Ptr Word8 -> Int -> Word8 -> IO ()
+writeWord16OffPtr :: Ptr Word16 -> Int -> Word16 -> IO ()
+writeWord32OffPtr :: Ptr Word32 -> Int -> Word32 -> IO ()
+writeWord64OffPtr :: Ptr Word64 -> Int -> Word64 -> IO ()
+
+writeWideCharOffPtr (Ptr a) (I# i) (C# x)
+ = IO $ \s -> case writeWideCharOffAddr# a i x s of s2 -> (# s2, () #)
+writeIntOffPtr (Ptr a) (I# i) (I# x)
+ = IO $ \s -> case writeIntOffAddr# a i x s of s2 -> (# s2, () #)
+writeWordOffPtr (Ptr a) (I# i) (W# x)
+ = IO $ \s -> case writeWordOffAddr# a i x s of s2 -> (# s2, () #)
+writePtrOffPtr (Ptr a) (I# i) (Ptr x)
+ = IO $ \s -> case writeAddrOffAddr# a i x s of s2 -> (# s2, () #)
+writeFloatOffPtr (Ptr a) (I# i) (F# x)
+ = IO $ \s -> case writeFloatOffAddr# a i x s of s2 -> (# s2, () #)
+writeDoubleOffPtr (Ptr a) (I# i) (D# x)
+ = IO $ \s -> case writeDoubleOffAddr# a i x s of s2 -> (# s2, () #)
+writeStablePtrOffPtr (Ptr a) (I# i) (StablePtr x)
+ = IO $ \s -> case writeStablePtrOffAddr# a i x s of s2 -> (# s2 , () #)
+writeInt8OffPtr (Ptr a) (I# i) (I8# x)
+ = IO $ \s -> case writeInt8OffAddr# a i x s of s2 -> (# s2, () #)
+writeInt16OffPtr (Ptr a) (I# i) (I16# x)
+ = IO $ \s -> case writeInt16OffAddr# a i x s of s2 -> (# s2, () #)
+writeInt32OffPtr (Ptr a) (I# i) (I32# x)
+ = IO $ \s -> case writeInt32OffAddr# a i x s of s2 -> (# s2, () #)
+writeInt64OffPtr (Ptr a) (I# i) (I64# x)
+ = IO $ \s -> case writeInt64OffAddr# a i x s of s2 -> (# s2, () #)
+writeWord8OffPtr (Ptr a) (I# i) (W8# x)
+ = IO $ \s -> case writeWord8OffAddr# a i x s of s2 -> (# s2, () #)
+writeWord16OffPtr (Ptr a) (I# i) (W16# x)
+ = IO $ \s -> case writeWord16OffAddr# a i x s of s2 -> (# s2, () #)
+writeWord32OffPtr (Ptr a) (I# i) (W32# x)
+ = IO $ \s -> case writeWord32OffAddr# a i x s of s2 -> (# s2, () #)
+writeWord64OffPtr (Ptr a) (I# i) (W64# x)
+ = IO $ \s -> case writeWord64OffAddr# a i x s of s2 -> (# s2, () #)
#endif /* __GLASGOW_HASKELL__ */
\end{code}
%
-% (c) The University of Glasgow, 1997-2000
+% (c) The University of Glasgow, 1997-2001
%
\section[PrelWord]{Module @PrelWord@}
#include "MachDeps.h"
module PrelWord (
- Word(..), 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
-
- -- internal stuff
- , wordToWord8#, wordToWord16#, wordToWord32#, wordToWord64#
-
- , word64ToInt64#, int64ToWord64#
- , wordToWord64#, word64ToWord#
-
- , toEnumError, fromEnumError, succError, predError, divZeroError
- ) where
+ Word(..), Word8(..), Word16(..), Word32(..), Word64(..),
+ divZeroError, toEnumError, fromEnumError, succError, predError)
+ where
-import PrelArr
-import PrelBits
-import PrelRead
+import PrelBase
import PrelEnum
-import PrelReal
import PrelNum
-import PrelBase
+import PrelReal
+import PrelRead
+import PrelArr
+import PrelBits
+
+------------------------------------------------------------------------
+-- Helper functions
+------------------------------------------------------------------------
--- ---------------------------------------------------------------------------
--- The Word Type
--- ---------------------------------------------------------------------------
+{-# NOINLINE divZeroError #-}
+divZeroError :: (Show a) => String -> a -> b
+divZeroError meth x =
+ error $ "Integral." ++ meth ++ ": divide by 0 (" ++ show x ++ " / 0)"
+
+{-# NOINLINE toEnumError #-}
+toEnumError :: (Show a) => String -> Int -> (a,a) -> b
+toEnumError inst_ty i bnds =
+ error $ "Enum.toEnum{" ++ inst_ty ++ "}: tag (" ++
+ show i ++
+ ") is outside of bounds " ++
+ show bnds
+
+{-# NOINLINE fromEnumError #-}
+fromEnumError :: (Show a) => String -> a -> b
+fromEnumError inst_ty x =
+ error $ "Enum.fromEnum{" ++ inst_ty ++ "}: value (" ++
+ show x ++
+ ") is outside of Int's bounds " ++
+ show (minBound::Int, maxBound::Int)
+
+{-# NOINLINE succError #-}
+succError :: String -> a
+succError inst_ty =
+ error $ "Enum.succ{" ++ inst_ty ++ "}: tried to take `succ' of maxBound"
+
+{-# NOINLINE predError #-}
+predError :: String -> a
+predError inst_ty =
+ error $ "Enum.pred{" ++ inst_ty ++ "}: tried to take `pred' of minBound"
+
+------------------------------------------------------------------------
+-- type Word
+------------------------------------------------------------------------
+
+-- A Word is an unsigned integral type, with the same size as Int.
--- A Word is an unsigned integral type, with the same number of bits as Int.
data Word = W# Word# deriving (Eq, Ord)
instance CCallable Word
instance CReturnable Word
--- ---------------------------------------------------------------------------
--- 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
-
-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#))
+instance Show Word where
+ showsPrec p x = showsPrec p (toInteger x)
+
+instance Num Word where
+ (W# x#) + (W# y#) = W# (x# `plusWord#` y#)
+ (W# x#) - (W# y#) = W# (x# `minusWord#` y#)
+ (W# x#) * (W# y#) = W# (x# `timesWord#` y#)
+ negate (W# x#) = W# (int2Word# (negateInt# (word2Int# x#)))
+ abs x = x
+ signum 0 = 0
+ signum _ = 1
+ fromInteger (S# i#) = W# (int2Word# i#)
+ fromInteger (J# s# d#) = W# (integer2Word# s# d#)
+
+instance Real Word where
+ toRational x = toInteger x % 1
+
+instance Enum Word where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Word"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Word"
+ toEnum i@(I# i#)
+ | i >= 0 = W# (int2Word# i#)
+ | otherwise = toEnumError "Word" i (minBound::Word, maxBound::Word)
+ fromEnum x@(W# x#)
+ | x <= fromIntegral (maxBound::Int)
+ = I# (word2Int# x#)
+ | otherwise = fromEnumError "Word" x
+ enumFrom = integralEnumFrom
+ enumFromThen = integralEnumFromThen
+
+instance Integral Word where
+ quot x@(W# x#) y@(W# y#)
+ | y /= 0 = W# (x# `quotWord#` y#)
+ | otherwise = divZeroError "quot{Word}" x
+ rem x@(W# x#) y@(W# y#)
+ | y /= 0 = W# (x# `remWord#` y#)
+ | otherwise = divZeroError "rem{Word}" x
+ div x@(W# x#) y@(W# y#)
+ | y /= 0 = W# (x# `quotWord#` y#)
+ | otherwise = divZeroError "div{Word}" x
+ mod x@(W# x#) y@(W# y#)
+ | y /= 0 = W# (x# `remWord#` y#)
+ | otherwise = divZeroError "mod{Word}" x
+ quotRem x@(W# x#) y@(W# y#)
+ | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#))
+ | otherwise = divZeroError "quotRem{Word}" x
+ divMod x@(W# x#) y@(W# y#)
+ | y /= 0 = (W# (x# `quotWord#` y#), W# (x# `remWord#` y#))
+ | otherwise = divZeroError "divMod{Word}" x
+ toInteger (W# x#)
+ | i# >=# 0# = S# i#
+ | otherwise = case word2Integer# x# of (# s, d #) -> J# s d
+ where
+ i# = word2Int# x#
+
+instance Bounded Word where
+ minBound = 0
+#if WORD_SIZE_IN_BYTES == 4
+ maxBound = 0xFFFFFFFF
#else
-intToWord32 (I# x) = W32# (int2Word# x)
+ maxBound = 0xFFFFFFFFFFFFFFFF
#endif
-word32ToInt (W32# x) = I# (word2Int# x)
-
-word2Integer :: Word# -> Integer
-word2Integer w | i >=# 0# = S# i
- | otherwise = case word2Integer# w of
- (# s, d #) -> J# s d
- where i = word2Int# w
-
-word32ToInteger (W32# x) = word2Integer x
-integerToWord32 = fromInteger
-
------------------------------------------------------------------------------
--- The following rules for fromIntegral remove the need to export specialized
--- conversion functions.
------------------------------------------------------------------------------
+instance Ix Word where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Word"
+ inRange (m,n) i = m <= i && i <= n
+
+instance Read Word where
+ readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+
+instance Bits Word where
+ (W# x#) .&. (W# y#) = W# (x# `and#` y#)
+ (W# x#) .|. (W# y#) = W# (x# `or#` y#)
+ (W# x#) `xor` (W# y#) = W# (x# `xor#` y#)
+ complement (W# x#) = W# (x# `xor#` mb#) where W# mb# = maxBound
+ (W# x#) `shift` (I# i#)
+ | i# >=# 0# = W# (x# `shiftL#` i#)
+ | otherwise = W# (x# `shiftRL#` negateInt# i#)
+#if WORD_SIZE_IN_BYTES == 4
+ (W# x#) `rotate` (I# i#) = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (32# -# i'#)))
+ where
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
+#else
+ (W# x#) `rotate` (I# i#) = W# ((x# `shiftL#` i'#) `or#` (x# `shiftRL#` (64# -# i'#)))
+ where
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+#endif
+ bitSize _ = WORD_SIZE_IN_BYTES * 8
+ isSigned _ = False
{-# 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}
+"fromIntegral/Int->Word" fromIntegral = \(I# x#) -> W# (int2Word# x#)
+"fromIntegral/Word->Int" fromIntegral = \(W# x#) -> I# (word2Int# x#)
+"fromIntegral/Word->Word" fromIntegral = id :: Word -> Word
+ #-}
-\subsection[Word8]{The @Word8@ interface}
+------------------------------------------------------------------------
+-- type Word8
+------------------------------------------------------------------------
+-- Word8 is represented in the same way as Word. Operations may assume
+-- and must ensure that it holds only values from its logical range.
-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#
+data Word8 = W8# Word# deriving (Eq, Ord)
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 Show Word8 where
+ showsPrec p x = showsPrec p (fromIntegral x :: Int)
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#))
-
-instance Bounded Word8 where
- minBound = 0
- maxBound = 0xff
+ (W8# x#) + (W8# y#) = W8# (wordToWord8# (x# `plusWord#` y#))
+ (W8# x#) - (W8# y#) = W8# (wordToWord8# (x# `minusWord#` y#))
+ (W8# x#) * (W8# y#) = W8# (wordToWord8# (x# `timesWord#` y#))
+ negate (W8# x#) = W8# (wordToWord8# (int2Word# (negateInt# (word2Int# x#))))
+ abs x = x
+ signum 0 = 0
+ signum _ = 1
+ fromInteger (S# i#) = W8# (wordToWord8# (int2Word# i#))
+ fromInteger (J# s# d#) = W8# (wordToWord8# (integer2Word# s# d#))
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
+ toRational x = toInteger x % 1
- mod x@(W8# x#) (W8# y#)
- | y# `neWord#` (int2Word# 0#) = W8# (x# `remWord#` y#)
- | otherwise = divZeroError "mod{Word8}" x
+instance Enum Word8 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Word8"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Word8"
+ toEnum i@(I# i#)
+ | i >= 0 && i <= fromIntegral (maxBound::Word8)
+ = W8# (int2Word# i#)
+ | otherwise = toEnumError "Word8" i (minBound::Word8, maxBound::Word8)
+ fromEnum (W8# x#) = I# (word2Int# x#)
+ enumFrom = boundedEnumFrom
+ enumFromThen = boundedEnumFromThen
- 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))
+instance Integral Word8 where
+ quot x@(W8# x#) y@(W8# y#)
+ | y /= 0 = W8# (x# `quotWord#` y#)
+ | otherwise = divZeroError "quot{Word8}" x
+ rem x@(W8# x#) y@(W8# y#)
+ | y /= 0 = W8# (x# `remWord#` y#)
+ | otherwise = divZeroError "rem{Word8}" x
+ div x@(W8# x#) y@(W8# y#)
+ | y /= 0 = W8# (x# `quotWord#` y#)
+ | otherwise = divZeroError "div{Word8}" x
+ mod x@(W8# x#) y@(W8# y#)
+ | y /= 0 = W8# (x# `remWord#` y#)
+ | otherwise = divZeroError "mod{Word8}" x
+ quotRem x@(W8# x#) y@(W8# y#)
+ | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#))
+ | otherwise = divZeroError "quotRem{Word8}" x
+ divMod x@(W8# x#) y@(W8# y#)
+ | y /= 0 = (W8# (x# `quotWord#` y#), W8# (x# `remWord#` y#))
+ | otherwise = divZeroError "quotRem{Word8}" x
+ toInteger (W8# x#) = S# (word2Int# x#)
- toInteger = toInteger . toInt
+instance Bounded Word8 where
+ minBound = 0
+ maxBound = 0xFF
instance Ix Word8 where
- range (m,n) = [m..n]
+ 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 >= fromIntegral (minBound::Word8) && i <= fromIntegral (maxBound::Word8)
- = W8# (intToWord8# i#)
- | otherwise
- = toEnumError "Word8" i (minBound::Word8,maxBound::Word8)
-
- fromEnum (W8# w) = I# (word2Int# w)
-
- enumFrom = boundedEnumFrom
- enumFromThen = boundedEnumFromThen
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Word8"
+ inRange (m,n) i = m <= i && i <= n
instance Read Word8 where
- readsPrec _ = readDec
-
-instance Show Word8 where
- showsPrec p w8 = showsPrec p (word8ToInt w8)
+ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
instance Bits Word8 where
- (W8# x) .&. (W8# y) = W8# (x `and#` y)
- (W8# x) .|. (W8# y) = W8# (x `or#` y)
- (W8# x) `xor` (W8# y) = W8# (x `xor#` y)
- complement (W8# x) = W8# (x `xor#` int2Word# 0xff#)
- shift (W8# x#) i@(I# i#)
- | i > 0 = W8# (wordToWord8# (shiftL# x# i#))
- | otherwise = W8# (wordToWord8# (shiftRL# x# (negateInt# i#)))
- w@(W8# x) `rotate` (I# i)
- | i ==# 0# = w
- | i ># 0# = W8# ((wordToWord8# (shiftL# x i')) `or#`
- (shiftRL# (x `and#`
- (int2Word# (0x100# -# pow2# i2)))
- i2))
- | otherwise = rotate w (I# (8# +# i))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 7#)
- i2 = 8# -# i'
-
- bit (I# i#)
- | i# >=# 0# && i# <=# 7# = W8# (wordToWord8# (shiftL# (int2Word# 1#) i#))
- | otherwise = 0 -- We'll be overbearing, for now..
-
- testBit (W8# x#) (I# i#)
- | i# <# 8# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
- | otherwise = False -- for now, this is really an error.
-
- bitSize _ = 8
- isSigned _ = False
-
-pow2# :: Int# -> Int#
-pow2# x# = word2Int# (shiftL# (int2Word# 1#) x#)
-
-pow2_64# :: Int# -> Int64#
-pow2_64# x# = word64ToInt64# (shiftL64# (wordToWord64# (int2Word# 1#)) x#)
-
--- ---------------------------------------------------------------------------
--- Word16
--- ---------------------------------------------------------------------------
-
--- 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@.
-
-data Word16 = W16# Word#
+ (W8# x#) .&. (W8# y#) = W8# (x# `and#` y#)
+ (W8# x#) .|. (W8# y#) = W8# (x# `or#` y#)
+ (W8# x#) `xor` (W8# y#) = W8# (x# `xor#` y#)
+ complement (W8# x#) = W8# (x# `xor#` mb#) where W8# mb# = maxBound
+ (W8# x#) `shift` (I# i#)
+ | i# >=# 0# = W8# (wordToWord8# (x# `shiftL#` i#))
+ | otherwise = W8# (x# `shiftRL#` negateInt# i#)
+ (W8# x#) `rotate` (I# i#) = W8# (wordToWord8# ((x# `shiftL#` i'#) `or#`
+ (x# `shiftRL#` (8# -# i'#))))
+ where
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
+ bitSize _ = 8
+ isSigned _ = False
-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#))
+{-# RULES
+"fromIntegral/a->Word8" fromIntegral = \x -> case fromIntegral x of W# x# -> W8# (wordToWord8# x#)
+"fromIntegral/Word8->a" fromIntegral = \(W8# x#) -> fromIntegral (W# x#)
+ #-}
-wordToWord16# :: Word# -> Word#
-wordToWord16# w# = w# `and#` (int2Word# 0xffff#)
+------------------------------------------------------------------------
+-- type Word16
+------------------------------------------------------------------------
-instance Eq Word16 where
- (W16# x) == (W16# y) = x `eqWord#` y
- (W16# x) /= (W16# y) = x `neWord#` y
+-- Word16 is represented in the same way as Word. Operations may assume
+-- and must ensure that it holds only values from its logical range.
-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 }
+data Word16 = W16# Word# deriving (Eq, Ord)
+instance CCallable Word16
+instance CReturnable Word16
+instance Show Word16 where
+ showsPrec p x = showsPrec p (fromIntegral x :: Int)
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#))
-
-instance Bounded Word16 where
- minBound = 0
- maxBound = 0xffff
+ (W16# x#) + (W16# y#) = W16# (wordToWord16# (x# `plusWord#` y#))
+ (W16# x#) - (W16# y#) = W16# (wordToWord16# (x# `minusWord#` y#))
+ (W16# x#) * (W16# y#) = W16# (wordToWord16# (x# `timesWord#` y#))
+ negate (W16# x#) = W16# (wordToWord16# (int2Word# (negateInt# (word2Int# x#))))
+ abs x = x
+ signum 0 = 0
+ signum _ = 1
+ fromInteger (S# i#) = W16# (wordToWord16# (int2Word# i#))
+ fromInteger (J# s# d#) = W16# (wordToWord16# (integer2Word# s# d#))
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
+ toRational x = toInteger x % 1
- mod x@(W16# x#) (W16# y#)
- | y# `neWord#` (int2Word# 0#) = W16# (x# `remWord#` y#)
- | otherwise = divZeroError "mod{Word16}" x
+instance Enum Word16 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Word16"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Word16"
+ toEnum i@(I# i#)
+ | i >= 0 && i <= fromIntegral (maxBound::Word16)
+ = W16# (int2Word# i#)
+ | otherwise = toEnumError "Word16" i (minBound::Word16, maxBound::Word16)
+ fromEnum (W16# x#) = I# (word2Int# x#)
+ enumFrom = boundedEnumFrom
+ enumFromThen = boundedEnumFromThen
- 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))
+instance Integral Word16 where
+ quot x@(W16# x#) y@(W16# y#)
+ | y /= 0 = W16# (x# `quotWord#` y#)
+ | otherwise = divZeroError "quot{Word16}" x
+ rem x@(W16# x#) y@(W16# y#)
+ | y /= 0 = W16# (x# `remWord#` y#)
+ | otherwise = divZeroError "rem{Word16}" x
+ div x@(W16# x#) y@(W16# y#)
+ | y /= 0 = W16# (x# `quotWord#` y#)
+ | otherwise = divZeroError "div{Word16}" x
+ mod x@(W16# x#) y@(W16# y#)
+ | y /= 0 = W16# (x# `remWord#` y#)
+ | otherwise = divZeroError "mod{Word16}" x
+ quotRem x@(W16# x#) y@(W16# y#)
+ | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#))
+ | otherwise = divZeroError "quotRem{Word16}" x
+ divMod x@(W16# x#) y@(W16# y#)
+ | y /= 0 = (W16# (x# `quotWord#` y#), W16# (x# `remWord#` y#))
+ | otherwise = divZeroError "quotRem{Word16}" x
+ toInteger (W16# x#) = S# (word2Int# x#)
- toInteger = toInteger . word16ToInt
+instance Bounded Word16 where
+ minBound = 0
+ maxBound = 0xFFFF
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 >= fromIntegral (minBound::Word16) && i <= fromIntegral (maxBound::Word16)
- = W16# (intToWord16# i#)
- | otherwise
- = toEnumError "Word16" i (minBound::Word16,maxBound::Word16)
-
- fromEnum (W16# w) = I# (word2Int# w)
- enumFrom = boundedEnumFrom
- enumFromThen = boundedEnumFromThen
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Word16"
+ inRange (m,n) i = m <= i && i <= n
instance Read Word16 where
- readsPrec _ = readDec
-
-instance Show Word16 where
- showsPrec p w16 = showsPrec p (word16ToInt w16)
+ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
instance Bits Word16 where
- (W16# x) .&. (W16# y) = W16# (x `and#` y)
- (W16# x) .|. (W16# y) = W16# (x `or#` y)
- (W16# x) `xor` (W16# y) = W16# (x `xor#` y)
- complement (W16# x) = W16# (x `xor#` int2Word# 0xffff#)
- shift (W16# x#) i@(I# i#)
- | i > 0 = W16# (wordToWord16# (shiftL# x# i#))
- | otherwise = W16# (shiftRL# x# (negateInt# i#))
- w@(W16# x) `rotate` (I# i)
- | i ==# 0# = w
- | i ># 0# = W16# ((wordToWord16# (shiftL# x i')) `or#`
- (shiftRL# (x `and#`
- (int2Word# (0x10000# -# pow2# i2)))
- i2))
- | otherwise = rotate w (I# (16# +# i'))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 15#)
- i2 = 16# -# i'
- bit (I# i#)
- | i# >=# 0# && i# <=# 15# = W16# (shiftL# (int2Word# 1#) i#)
- | otherwise = 0 -- We'll be overbearing, for now..
-
- testBit (W16# x#) (I# i#)
- | i# <# 16# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
- | otherwise = False -- for now, this is really an error.
-
- bitSize _ = 16
- isSigned _ = False
-
--- ---------------------------------------------------------------------------
--- Word32
--- ---------------------------------------------------------------------------
-
--- 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@.
-
-data Word32 = W32# Word#
+ (W16# x#) .&. (W16# y#) = W16# (x# `and#` y#)
+ (W16# x#) .|. (W16# y#) = W16# (x# `or#` y#)
+ (W16# x#) `xor` (W16# y#) = W16# (x# `xor#` y#)
+ complement (W16# x#) = W16# (x# `xor#` mb#) where W16# mb# = maxBound
+ (W16# x#) `shift` (I# i#)
+ | i# >=# 0# = W16# (wordToWord16# (x# `shiftL#` i#))
+ | otherwise = W16# (x# `shiftRL#` negateInt# i#)
+ (W16# x#) `rotate` (I# i#) = W16# (wordToWord16# ((x# `shiftL#` i'#) `or#`
+ (x# `shiftRL#` (16# -# i'#))))
+ where
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
+ bitSize _ = 16
+ isSigned _ = False
-instance CCallable Word32
-instance CReturnable Word32
+{-# RULES
+"fromIntegral/a->Word16" fromIntegral = \x -> case fromIntegral x of W# x# -> W16# (wordToWord16# x#)
+"fromIntegral/Word16->a" fromIntegral = \(W16# x#) -> fromIntegral (W# x#)
+ #-}
-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 }
+------------------------------------------------------------------------
+-- type Word32
+------------------------------------------------------------------------
-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))
+-- Word32 is represented in the same way as Word.
#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)))
+-- Operations may assume and must ensure that it holds only values
+-- from its logical range.
#endif
- abs x = x
- signum = signumReal
- fromInteger (S# i#) = W32# (intToWord32# i#)
- fromInteger (J# s# d#) = W32# (wordToWord32# (integer2Word# s# d#))
- -- ToDo: restrict fromInt{eger} range.
-intToWord32# :: Int# -> Word#
-wordToWord32# :: Word# -> Word#
+data Word32 = W32# Word# deriving (Eq, Ord)
-#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#
+#if WORD_SIZE_IN_BYTES == 4
+{-# RULES "wordToWord32#" forall x#. wordToWord32# x# = x# #-}
#endif
-instance Bounded Word32 where
- minBound = 0
-#if WORD_SIZE_IN_BYTES == 8
- maxBound = 0xffffffff
+instance CCallable Word32
+instance CReturnable Word32
+
+instance Show Word32 where
+#if WORD_SIZE_IN_BYTES == 4
+ showsPrec p x = showsPrec p (toInteger x)
#else
- maxBound = minBound - 1
+ showsPrec p x = showsPrec p (fromIntegral x :: Int)
#endif
+instance Num Word32 where
+ (W32# x#) + (W32# y#) = W32# (wordToWord32# (x# `plusWord#` y#))
+ (W32# x#) - (W32# y#) = W32# (wordToWord32# (x# `minusWord#` y#))
+ (W32# x#) * (W32# y#) = W32# (wordToWord32# (x# `timesWord#` y#))
+ negate (W32# x#) = W32# (wordToWord32# (int2Word# (negateInt# (word2Int# x#))))
+ abs x = x
+ signum 0 = 0
+ signum _ = 1
+ fromInteger (S# i#) = W32# (wordToWord32# (int2Word# i#))
+ fromInteger (J# s# d#) = W32# (wordToWord32# (integer2Word# s# d#))
+
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
-
+instance Enum Word32 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Word32"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Word32"
+ toEnum i@(I# i#)
+ | i >= 0
+#if WORD_SIZE_IN_BYTES == 8
+ && i <= fromIntegral (maxBound::Word32)
+#endif
+ = W32# (int2Word# i#)
+ | otherwise = toEnumError "Word32" i (minBound::Word32, maxBound::Word32)
+#if WORD_SIZE_IN_BYTES == 4
+ fromEnum (W32# x#) = I# (word2Int# x#)
+ enumFrom = integralEnumFrom
+ enumFromThen = integralEnumFromThen
+#else
+ fromEnum x@(W32# x#)
+ | x <= fromIntegral (maxBound::Int)
+ = I# (word2Int# x#)
+ | otherwise = fromEnumError "Word32" x
+ enumFrom = boundedEnumFrom
+ enumFromThen = boundedEnumFromThen
+#endif
-{-# 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 Integral Word32 where
+ quot x@(W32# x#) y@(W32# y#)
+ | y /= 0 = W32# (x# `quotWord#` y#)
+ | otherwise = divZeroError "quot{Word32}" x
+ rem x@(W32# x#) y@(W32# y#)
+ | y /= 0 = W32# (x# `remWord#` y#)
+ | otherwise = divZeroError "rem{Word32}" x
+ div x@(W32# x#) y@(W32# y#)
+ | y /= 0 = W32# (x# `quotWord#` y#)
+ | otherwise = divZeroError "div{Word32}" x
+ mod x@(W32# x#) y@(W32# y#)
+ | y /= 0 = W32# (x# `remWord#` y#)
+ | otherwise = divZeroError "mod{Word32}" x
+ quotRem x@(W32# x#) y@(W32# y#)
+ | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#))
+ | otherwise = divZeroError "quotRem{Word32}" x
+ divMod x@(W32# x#) y@(W32# y#)
+ | y /= 0 = (W32# (x# `quotWord#` y#), W32# (x# `remWord#` y#))
+ | otherwise = divZeroError "quotRem{Word32}" x
+ toInteger (W32# x#)
+#if WORD_SIZE_IN_BYTES == 4
+ | i# >=# 0# = S# i#
+ | otherwise = case word2Integer# x# of (# s, d #) -> J# s d
+ where
+ i# = word2Int# x#
+#else
+ = S# (word2Int# x#)
+#endif
+instance Bounded Word32 where
+ minBound = 0
+ maxBound = 0xFFFFFFFF
instance Ix Word32 where
- range (m,n) = [m..n]
+ 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
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Word32"
+ inRange (m,n) i = m <= i && i <= n
instance Read Word32 where
- readsPrec _ = readDec
-
-instance Show Word32 where
- showsPrec p w = showsPrec p (word32ToInteger w)
+#if WORD_SIZE_IN_BYTES == 4
+ readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
+#else
+ readsPrec p s = [(fromIntegral (x::Int), r) | (x, r) <- readsPrec p s]
+#endif
instance Bits Word32 where
- (W32# x) .&. (W32# y) = W32# (x `and#` y)
- (W32# x) .|. (W32# y) = W32# (x `or#` y)
- (W32# x) `xor` (W32# y) = W32# (x `xor#` y)
- complement (W32# x) = W32# (x `xor#` mb#) where (W32# mb#) = maxBound
- shift (W32# x) i@(I# i#)
- | i > 0 = W32# (wordToWord32# (shiftL# x i#))
- | otherwise = W32# (shiftRL# x (negateInt# i#))
- w@(W32# x) `rotate` (I# i)
- | i ==# 0# = w
- | i ># 0# = W32# ((wordToWord32# (shiftL# x i')) `or#`
- (shiftRL# (x `and#`
- (int2Word# (word2Int# maxBound# -# pow2# i2 +# 1#)))
- i2))
- | otherwise = rotate w (I# (32# +# i))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 31#)
- i2 = 32# -# i'
- (W32# maxBound#) = maxBound
-
- bit (I# i#)
- | i# >=# 0# && i# <=# 31# = W32# (shiftL# (int2Word# 1#) i#)
- | otherwise = 0 -- We'll be overbearing, for now..
-
- testBit (W32# x#) (I# i#)
- | i# <# 32# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
- | otherwise = False -- for now, this is really an error.
- bitSize _ = 32
- isSigned _ = False
-
--- -----------------------------------------------------------------------------
--- Word64
--- -----------------------------------------------------------------------------
-
-#if WORD_SIZE_IN_BYTES == 8
-data Word64 = W64# Word#
-
-word32ToWord64 (W32 w#) = W64# w#
+ (W32# x#) .&. (W32# y#) = W32# (x# `and#` y#)
+ (W32# x#) .|. (W32# y#) = W32# (x# `or#` y#)
+ (W32# x#) `xor` (W32# y#) = W32# (x# `xor#` y#)
+ complement (W32# x#) = W32# (x# `xor#` mb#) where W32# mb# = maxBound
+ (W32# x#) `shift` (I# i#)
+ | i# >=# 0# = W32# (wordToWord32# (x# `shiftL#` i#))
+ | otherwise = W32# (x# `shiftRL#` negateInt# i#)
+ (W32# x#) `rotate` (I# i#) = W32# (wordToWord32# ((x# `shiftL#` i'#) `or#`
+ (x# `shiftRL#` (32# -# i'#))))
+ where
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
+ bitSize _ = 32
+ isSigned _ = False
-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#))
+{-# RULES
+"fromIntegral/a->Word32" fromIntegral = \x -> case fromIntegral x of W# x# -> W32# (wordToWord32# x#)
+"fromIntegral/Word32->a" fromIntegral = \(W32# x#) -> fromIntegral (W# x#)
+ #-}
-wordToWord32# :: Word# -> Word#
-wordToWord32# w# = w# `and#` (case (maxBound::Word32) of W# x# -> x#)
+------------------------------------------------------------------------
+-- type Word64
+------------------------------------------------------------------------
-word64ToWord32 :: Word64 -> Word32
-word64ToWord32 (W64# w#) = W32# (wordToWord32# w#)
+#if WORD_SIZE_IN_BYTES == 4
-wordToWord64# w# = w#
-word64ToWord# w# = w#
+data Word64 = W64# Word64#
-instance Eq Word64 where
- (W64# x) == (W64# y) = x `eqWord#` y
- (W64# x) /= (W64# y) = x `neWord#` y
+instance Eq Word64 where
+ (W64# x#) == (W64# y#) = x# `eqWord64#` y#
+ (W64# x#) /= (W64# y#) = x# `neWord64#` 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 Ord Word64 where
+ (W64# x#) < (W64# y#) = x# `ltWord64#` y#
+ (W64# x#) <= (W64# y#) = x# `leWord64#` y#
+ (W64# x#) > (W64# y#) = x# `gtWord64#` y#
+ (W64# x#) >= (W64# y#) = x# `geWord64#` 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#)
-
--- 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
+ (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 (W64# x#) = W64# (int64ToWord64# (negateInt64# (word64ToInt64# x#)))
+ abs x = x
+ signum 0 = 0
+ signum _ = 1
+ fromInteger (S# i#) = W64# (int64ToWord64# (intToInt64# i#))
+ fromInteger (J# s# d#) = W64# (integerToWord64# s# d#)
- 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
-
-#else /* WORD_SIZE_IN_BYTES < 8 */
-
-data Word64 = W64# Word64#
+instance Enum Word64 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Word64"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Word64"
+ toEnum i@(I# i#)
+ | i >= 0 = W64# (wordToWord64# (int2Word# i#))
+ | otherwise = toEnumError "Word64" i (minBound::Word64, maxBound::Word64)
+ fromEnum x@(W64# x#)
+ | x <= fromIntegral (maxBound::Int)
+ = I# (word2Int# (word64ToWord# x#))
+ | otherwise = fromEnumError "Word64" x
+ enumFrom = integralEnumFrom
+ enumFromThen = integralEnumFromThen
--- for completeness sake
-word32ToWord64 (W32# w#) = W64# (wordToWord64# w#)
-word64ToWord32 (W64# w#) = W32# (word64ToWord# w#)
+instance Integral Word64 where
+ quot x@(W64# x#) y@(W64# y#)
+ | y /= 0 = W64# (x# `quotWord64#` y#)
+ | otherwise = divZeroError "quot{Word64}" x
+ rem x@(W64# x#) y@(W64# y#)
+ | y /= 0 = W64# (x# `remWord64#` y#)
+ | otherwise = divZeroError "rem{Word64}" x
+ div x@(W64# x#) y@(W64# y#)
+ | y /= 0 = W64# (x# `quotWord64#` y#)
+ | otherwise = divZeroError "div{Word64}" x
+ mod x@(W64# x#) y@(W64# y#)
+ | y /= 0 = W64# (x# `remWord64#` y#)
+ | otherwise = divZeroError "mod{Word64}" x
+ quotRem x@(W64# x#) y@(W64# y#)
+ | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#))
+ | otherwise = divZeroError "quotRem{Word64}" x
+ divMod x@(W64# x#) y@(W64# y#)
+ | y /= 0 = (W64# (x# `quotWord64#` y#), W64# (x# `remWord64#` y#))
+ | otherwise = divZeroError "quotRem{Word64}" x
+ toInteger x@(W64# x#)
+ | x <= 0x7FFFFFFF = S# (word2Int# (word64ToWord# x#))
+ | otherwise = case word64ToInteger# x# of (# s, d #) -> J# s d
-word8ToWord64 (W8# w#) = W64# (wordToWord64# w#)
-word64ToWord8 (W64# w#) = W8# ((word64ToWord# w#) `and#` (int2Word# 0xff#))
+instance Bits Word64 where
+ (W64# x#) .&. (W64# y#) = W64# (x# `and64#` y#)
+ (W64# x#) .|. (W64# y#) = W64# (x# `or64#` y#)
+ (W64# x#) `xor` (W64# y#) = W64# (x# `xor64#` y#)
+ complement (W64# x#) = W64# (not64# x#)
+ (W64# x#) `shift` (I# i#)
+ | i# >=# 0# = W64# (x# `shiftL64#` i#)
+ | otherwise = W64# (x# `shiftRL64#` negateInt# i#)
+ (W64# x#) `rotate` (I# i#) = W64# ((x# `shiftL64#` i'#) `or64#`
+ (x# `shiftRL64#` (64# -# i'#)))
+ where
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+ bitSize _ = 64
+ isSigned _ = False
+
+foreign import "stg_eqWord64" unsafe eqWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_neWord64" unsafe neWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_ltWord64" unsafe ltWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_leWord64" unsafe leWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_gtWord64" unsafe gtWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_geWord64" unsafe geWord64# :: Word64# -> Word64# -> Bool
+foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64#
+foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64#
+foreign import "stg_plusInt64" unsafe plusInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64#
+foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64#
+foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64#
+foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64#
+foreign import "stg_word64ToWord" unsafe word64ToWord# :: Word64# -> Word#
+foreign import "stg_quotWord64" unsafe quotWord64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_remWord64" unsafe remWord64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
+foreign import "stg_not64" unsafe not64# :: Word64# -> Word64#
+foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
+foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
-word16ToWord64 (W16# w#) = W64# (wordToWord64# w#)
-word64ToWord16 (W64# w#) = W16# ((word64ToWord# w#) `and#` (int2Word# 0xffff#))
+{-# RULES
+"fromIntegral/Int->Word64" fromIntegral = \(I# x#) -> W64# (int64ToWord64# (intToInt64# x#))
+"fromIntegral/Word->Word64" fromIntegral = \(W# x#) -> W64# (wordToWord64# x#)
+"fromIntegral/Word64->Int" fromIntegral = \(W64# x#) -> I# (word2Int# (word64ToWord# x#))
+"fromIntegral/Word64->Word" fromIntegral = \(W64# x#) -> W# (word64ToWord# x#)
+"fromIntegral/Word64->Word64" fromIntegral = id :: Word64 -> Word64
+ #-}
-word64ToInteger (W64# w#) =
- case word64ToInteger# w# of
- (# s#, p# #) -> J# s# p#
-word64ToInt (W64# w#) = I# (word2Int# (word64ToWord# w#))
+#else
-intToWord64# :: Int# -> Word64#
-intToWord64# i# = wordToWord64# (int2Word# i#)
+data Word32 = W64# Word# deriving (Eq, Ord)
-intToWord64 (I# i#) = W64# (intToWord64# i#)
+instance Num Word64 where
+ (W64# x#) + (W64# y#) = W64# (x# `plusWord#` y#)
+ (W64# x#) - (W64# y#) = W64# (x# `minusWord#` y#)
+ (W64# x#) * (W64# y#) = W64# (x# `timesWord#` y#)
+ negate (W64# x#) = W64# (int2Word# (negateInt# (word2Int# x#)))
+ abs x = x
+ signum 0 = 0
+ signum _ = 1
+ fromInteger (S# i#) = W64# (int2Word# i#)
+ fromInteger (J# s# d#) = W64# (integer2Word# s# d#)
-integerToWord64 (S# i#) = W64# (intToWord64# i#)
-integerToWord64 (J# s# d#) = W64# (integerToWord64# s# d#)
+instance Enum Word64 where
+ succ x
+ | x /= maxBound = x + 1
+ | otherwise = succError "Word64"
+ pred x
+ | x /= minBound = x - 1
+ | otherwise = predError "Word64"
+ toEnum i@(I# i#)
+ | i >= 0 = W64# (int2Word# i#)
+ | otherwise = toEnumError "Word64" i (minBound::Word64, maxBound::Word64)
+ fromEnum x@(W64# x#)
+ | x <= fromIntegral (maxBound::Int)
+ = I# (word2Int# x#)
+ | otherwise = fromEnumError "Word64" x
+ enumFrom = integralEnumFrom
+ enumFromThen = integralEnumFromThen
-instance Eq Word64 where
- (W64# x) == (W64# y) = x `eqWord64#` y
- (W64# x) /= (W64# y) = not (x `eqWord64#` y)
+instance Integral Word64 where
+ quot x@(W64# x#) y@(W64# y#)
+ | y /= 0 = W64# (x# `quotWord#` y#)
+ | otherwise = divZeroError "quot{Word64}" x
+ rem x@(W64# x#) y@(W64# y#)
+ | y /= 0 = W64# (x# `remWord#` y#)
+ | otherwise = divZeroError "rem{Word64}" x
+ div x@(W64# x#) y@(W64# y#)
+ | y /= 0 = W64# (x# `quotWord#` y#)
+ | otherwise = divZeroError "div{Word64}" x
+ mod x@(W64# x#) y@(W64# y#)
+ | y /= 0 = W64# (x# `remWord#` y#)
+ | otherwise = divZeroError "mod{Word64}" x
+ quotRem x@(W64# x#) y@(W64# y#)
+ | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#))
+ | otherwise = divZeroError "quotRem{Word64}" x
+ divMod x@(W64# x#) y@(W64# y#)
+ | y /= 0 = (W64# (x# `quotWord#` y#), W64# (x# `remWord#` y#))
+ | otherwise = divZeroError "quotRem{Word64}" x
+ toInteger (W64# x#)
+ | i# >=# 0# = S# i#
+ | otherwise = case word2Integer# x# of (# s, d #) -> J# s d
+ where
+ i# = word2Int# x#
-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 Bits Word64 where
+ (W64# x#) .&. (W64# y#) = W64# (x# `and#` y#)
+ (W64# x#) .|. (W64# y#) = W64# (x# `or#` y#)
+ (W64# x#) `xor` (W64# y#) = W64# (x# `xor#` y#)
+ complement (W64# x#) = W64# (x# `xor#` mb#) where W64# mb# = maxBound
+ (W64# x#) `shift` (I# i#)
+ | i# >=# 0# = W64# (x# `shiftL#` i#)
+ | otherwise = W64# (x# `shiftRL#` negateInt# i#)
+ (W64# x#) `rotate` (I# i#) = W64# ((x# `shiftL#` i'#) `or#`
+ (x# `shiftRL#` (64# -# i'#)))
+ where
+ i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+ bitSize _ = 64
+ isSigned _ = False
-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
-
--- 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
-
-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#
-
-foreign import "stg_intToInt64" unsafe intToInt64# :: Int# -> Int64#
-foreign import "stg_int64ToWord64" unsafe int64ToWord64# :: Int64# -> Word64#
-foreign import "stg_word64ToInt64" unsafe word64ToInt64# :: Word64# -> Int64#
-foreign import "stg_wordToWord64" unsafe wordToWord64# :: Word# -> Word64#
-foreign import "stg_word64ToWord" unsafe word64ToWord# :: Word64# -> Word#
-foreign import "stg_negateInt64" unsafe negateInt64# :: Int64# -> Int64#
-foreign import "stg_remWord64" unsafe remWord64# :: Word64# -> Word64# -> Word64#
-foreign import "stg_quotWord64" unsafe quotWord64# :: Word64# -> Word64# -> Word64#
-foreign import "stg_timesInt64" unsafe timesInt64# :: Int64# -> Int64# -> Int64#
-foreign import "stg_minusInt64" unsafe minusInt64# :: Int64# -> Int64# -> Int64#
-foreign import "stg_plusInt64" unsafe 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#
+{-# RULES
+"fromIntegral/a->Word64" fromIntegral = \x -> case fromIntegral x of W# x# -> W64# x#
+"fromIntegral/Word64->a" fromIntegral = \(W64# x#) -> fromIntegral (W# x#)
+ #-}
#endif
-instance CCallable Word64
+instance CCallable Word64
instance CReturnable Word64
-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
+ showsPrec p x = showsPrec p (toInteger x)
instance Real Word64 where
- toRational x = toInteger x % 1
-
-#if WORD_SIZE_IN_BYTES == 8
-
-instance Bits Word64 where
- (W64# x) .&. (W64# y) = W64# (x `and#` y)
- (W64# x) .|. (W64# y) = W64# (x `or#` y)
- (W64# x) `xor` (W64# y) = W64# (x `xor#` y)
- complement (W64# x) = W64# (x `xor#` (case (maxBound::Word64) of W64# x# -> x#))
- shift (W64# x#) i@(I# i#)
- | i > 0 = W64# (shiftL# x# i#)
- | otherwise = W64# (shiftRL# x# (negateInt# i#))
-
- w@(W64# x) `rotate` (I# i)
- | i ==# 0# = w
- | i ># 0# = W64# (shiftL# x i') `or#`
- (shiftRL# (x `and#`
- (int2Word# (word2Int# maxBound# -# pow2# i2 +# 1#)))
- i2))
- | otherwise = rotate w (I# (64# +# i))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 63#)
- i2 = 64# -# i'
- (W64# maxBound#) = maxBound
-
- bit (I# i#)
- | i# >=# 0# && i# <=# 63# = W64# (shiftL# (int2Word# 1#) i#)
- | otherwise = 0 -- We'll be overbearing, for now..
-
- testBit (W64# x#) (I# i#)
- | i# <# 64# && i# >=# 0# = (word2Int# (x# `and#` (shiftL# (int2Word# 1#) i#))) /=# 0#
- | otherwise = False -- for now, this is really an error.
-
- bitSize _ = 64
- isSigned _ = False
-
-#else /* WORD_SIZE_IN_BYTES < 8 */
-
-instance Bits Word64 where
- (W64# x) .&. (W64# y) = W64# (x `and64#` y)
- (W64# x) .|. (W64# y) = W64# (x `or64#` y)
- (W64# x) `xor` (W64# y) = W64# (x `xor64#` y)
- complement (W64# x) = W64# (x `xor64#` (case (maxBound::Word64) of W64# x# -> x#))
- shift (W64# x#) i@(I# i#)
- | i > 0 = W64# (shiftL64# x# i#)
- | otherwise = W64# (shiftRL64# x# (negateInt# i#))
-
- w@(W64# x) `rotate` (I# i)
- | i ==# 0# = w
- | i ># 0# = W64# ((shiftL64# x i') `or64#`
- (shiftRL64# (x `and64#`
- (int64ToWord64# ((word64ToInt64# maxBound#) `minusInt64#`
- (pow2_64# i2 `plusInt64#` (intToInt64# 1#))))))
- i2)
- | otherwise = rotate w (I# (64# +# i))
- where
- i' = word2Int# (int2Word# i `and#` int2Word# 63#)
- i2 = 64# -# i'
- (W64# maxBound#) = maxBound
-
- bit (I# i#)
- | i# >=# 0# && i# <=# 63# = W64# (shiftL64# (wordToWord64# (int2Word# 1#)) i#)
- | otherwise = 0 -- We'll be overbearing, for now..
-
- testBit (W64# x#) (I# i#)
- | i# <# 64# && i# >=# 0# = (word2Int# (word64ToWord# (x# `and64#` (shiftL64# (wordToWord64# (int2Word# 1#)) i#)))) /=# 0#
- | otherwise = False -- for now, this is really an error.
-
- bitSize _ = 64
- isSigned _ = False
-
-foreign import "stg_not64" unsafe not64# :: Word64# -> Word64#
-foreign import "stg_xor64" unsafe xor64# :: Word64# -> Word64# -> Word64#
-foreign import "stg_or64" unsafe or64# :: Word64# -> Word64# -> Word64#
-foreign import "stg_and64" unsafe and64# :: Word64# -> Word64# -> Word64#
-foreign import "stg_shiftRL64" unsafe shiftRL64# :: Word64# -> Int# -> Word64#
-foreign import "stg_shiftL64" unsafe shiftL64# :: Word64# -> Int# -> Word64#
-
-#endif /* WORD_SIZE_IN_BYTES < 8 */
-\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)))
+ toRational x = toInteger x % 1
-succError :: String -> a
-succError inst_ty
- = error ("Enum.succ{" ++ inst_ty ++ "}: tried to take `succ' of maxBound")
+instance Bounded Word64 where
+ minBound = 0
+ maxBound = 0xFFFFFFFFFFFFFFFF
-predError :: String -> a
-predError inst_ty
- = error ("Enum.pred{" ++ inst_ty ++ "}: tried to take `pred' of minBound")
+instance Ix Word64 where
+ range (m,n) = [m..n]
+ index b@(m,_) i
+ | inRange b i = fromIntegral (i - m)
+ | otherwise = indexError b i "Word64"
+ inRange (m,n) i = m <= i && i <= n
-divZeroError :: (Show a) => String -> a -> b
-divZeroError meth v
- = error ("Integral." ++ meth ++ ": divide by 0 (" ++ show v ++ " / 0)")
+instance Read Word64 where
+ readsPrec p s = [(fromInteger x, r) | (x, r) <- readsPrec p s]
\end{code}
% ------------------------------------------------------------------------------
-% $Id: Prelude.lhs,v 1.24 2001/02/22 16:48:24 qrczak Exp $
+% $Id: Prelude.lhs,v 1.25 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The University of Glasgow, 1992-2000
%
{-# INLINE mapM_ #-}
mapM_ f as = sequence_ (map f as)
\end{code}
-
-
-%*********************************************************
-%* *
-\subsection{Coercions}
-%* *
-%*********************************************************
-
-\begin{code}
-{-# RULES
-"fromIntegral/Int->Int" fromIntegral = id :: Int -> Int
-"fromIntegral/Integer->Integer" fromIntegral = id :: Integer -> Integer
-"fromIntegral/Int->Integer" fromIntegral = int2Integer
-"fromIntegral/Integer->Int" fromIntegral = integer2Int
-"fromIntegral/Int->Rational" forall n . fromIntegral n = int2Integer n :% 1
-"fromIntegral/Integer->Rational" forall n . fromIntegral n = n :% (1 :: Integer)
-"fromIntegral/Int->Float" fromIntegral = int2Float
-"fromIntegral/Int->Double" fromIntegral = int2Double
-"fromIntegral/Integer->Float" forall n . fromIntegral n = encodeFloat n 0 :: Float
-"fromIntegral/Integer->Double" forall n . fromIntegral n = encodeFloat n 0 :: Double
- #-}
-fromIntegral :: (Integral a, Num b) => a -> b
-fromIntegral = fromInteger . toInteger
-
-{-# RULES
-"realToFrac/Float->Double" realToFrac = floatToDouble
-"realToFrac/Double->Float" realToFrac = doubleToFloat
-"realToFrac/Float->Float" realToFrac = id :: Float -> Float
-"realToFrac/Double->Double" realToFrac = id :: Double -> Double
-"realToFrac/Rational->Rational" realToFrac = id :: Rational -> Rational
-"realToFrac/Float->Rational" realToFrac = rf2rat :: Float -> Rational
-"realToFrac/Double->Rational" realToFrac = rf2rat :: Double -> Rational
-"realToFrac/Rational->Float" realToFrac = fromRat :: Rational -> Float
-"realToFrac/Rational->Double" realToFrac = fromRat :: Rational -> Double
- #-}
-realToFrac :: (Real a, Fractional b) => a -> b
-realToFrac = fromRational . toRational
-
-doubleToFloat :: Double -> Float
-doubleToFloat (D# d) = F# (double2Float# d)
-
-floatToDouble :: Float -> Double
-floatToDouble (F# f) = D# (float2Double# f)
-
-{-# SPECIALIZE rf2rat ::
- Float -> Rational,
- Double -> Rational
- #-}
-rf2rat :: RealFloat a => a -> Rational
-rf2rat x = if n >= 0 then (m * (b ^ n)) :% 1 else m :% (b ^ (-n))
- where (m,n) = decodeFloat x
- b = floatRadix x
-\end{code}
% ------------------------------------------------------------------------------
-% $Id: Random.lhs,v 1.23 2001/02/22 16:48:24 qrczak Exp $
+% $Id: Random.lhs,v 1.24 2001/02/28 00:01:03 qrczak Exp $
%
% (c) The University of Glasgow, 1995-2000
%
import PrelRead ( readDec )
import PrelIOBase ( unsafePerformIO, stToIO )
import PrelArr ( STRef, newSTRef, readSTRef, writeSTRef )
-import PrelFloat ( float2Double, double2Float )
import Time ( getClockTime, ClockTime(..) )
#else
import PrelPrim ( IORef
random g = randomR (0::Double,1) g
-- hah, so you thought you were saving cycles by using Float?
-
-#ifdef __HUGS__
instance Random Float where
random g = randomIvalDouble (0::Double,1) realToFrac g
randomR (a,b) g = randomIvalDouble (realToFrac a, realToFrac b) realToFrac g
-#else
-instance Random Float where
- randomR (a,b) g = randomIvalDouble (float2Double a, float2Double b) double2Float g
- random g = randomIvalDouble (0::Double,1) double2Float g
-#endif
-
\end{code}
-- to compile on sparc-solaris. Blargh.
-- -----------------------------------------------------------------------------
--- $Id: Time.hsc,v 1.9 2001/01/30 10:59:04 simonmar Exp $
+-- $Id: Time.hsc,v 1.10 2001/02/28 00:01:03 qrczak Exp $
--
-- (c) The University of Glasgow, 1995-2001
--
addToClockTime (TimeDiff year mon day hour min sec psec)
(TOD c_sec c_psec) =
let
- sec_diff = fromInt sec + 60 * fromInt min + 3600 * fromInt hour + 24 * 3600 * fromInt day
+ sec_diff = toInteger sec +
+ 60 * toInteger min +
+ 3600 * toInteger hour +
+ 24 * 3600 * toInteger day
cal = toUTCTime (TOD (c_sec + sec_diff) (c_psec + psec))
-- FIXME! ^^^^
new_mon = fromEnum (ctMonth cal) + r_mon
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.72 2001/02/14 12:59:34 simonmar Exp $
+ * $Id: PrimOps.hc,v 1.73 2001/02/28 00:01:04 qrczak Exp $
*
* (c) The GHC Team, 1998-2000
*
if ( val < 0LL ) {
neg = 1;
val = -val;
- }
+ }
hi = (W_)((LW_)val / 0x100000000ULL);
if ( words_needed == 2 ) {
- s = 2;
+ s = 2;
Hp[-1] = (W_)val;
Hp[0] = hi;
} else if ( val != 0 ) {
/* -----------------------------------------------------------------------------
- * $Id: StgLongLong.c,v 1.4 1999/03/02 19:50:47 sof Exp $
+ * $Id: StgLongLong.c,v 1.5 2001/02/28 00:01:04 qrczak Exp $
*
* (c) The GHC Team, 1998-1999
*
#include "Rts.h"
#ifdef SUPPORT_LONG_LONGS
-StgInt
-stg_gtWord64(StgWord64 l1, StgWord64 l2)
-{ return ( l1 > l2); }
-StgInt
-stg_geWord64(StgWord64 l1, StgWord64 l2)
-{ return ( l1 >= l2); }
+/* Relational operators */
-StgInt
-stg_eqWord64(StgWord64 l1, StgWord64 l2)
-{ return ( l1 == l2); }
+StgBool stg_gtWord64 (StgWord64 a, StgWord64 b) {return a > b;}
+StgBool stg_geWord64 (StgWord64 a, StgWord64 b) {return a >= b;}
+StgBool stg_eqWord64 (StgWord64 a, StgWord64 b) {return a == b;}
+StgBool stg_neWord64 (StgWord64 a, StgWord64 b) {return a != b;}
+StgBool stg_ltWord64 (StgWord64 a, StgWord64 b) {return a < b;}
+StgBool stg_leWord64 (StgWord64 a, StgWord64 b) {return a <= b;}
-StgInt
-stg_neWord64(StgWord64 l1, StgWord64 l2)
-{ return ( l1 != l2); }
-
-StgInt
-stg_ltWord64(StgWord64 l1, StgWord64 l2)
-{ return ( l1 < l2); }
-
-StgInt
-stg_leWord64(StgWord64 l1, StgWord64 l2)
-{ return ( l1 <= l2); }
-
-/* ------------------ */
-
-StgInt
-stg_gtInt64(StgInt64 l1, StgInt64 l2)
-{ return ( l1 > l2); }
-
-StgInt
-stg_geInt64(StgInt64 l1, StgInt64 l2)
-{ return ( l1 >= l2); }
-
-StgInt
-stg_eqInt64(StgInt64 l1, StgInt64 l2)
-{ return ( l1 == l2); }
-
-StgInt
-stg_neInt64(StgInt64 l1, StgInt64 l2)
-{ return ( l1 != l2); }
-
-StgInt
-stg_ltInt64(StgInt64 l1, StgInt64 l2)
-{ return ( l1 < l2); }
-
-StgInt
-stg_leInt64(StgInt64 l1, StgInt64 l2)
-{ return ( l1 <= l2); }
+StgBool stg_gtInt64 (StgInt64 a, StgInt64 b) {return a > b;}
+StgBool stg_geInt64 (StgInt64 a, StgInt64 b) {return a >= b;}
+StgBool stg_eqInt64 (StgInt64 a, StgInt64 b) {return a == b;}
+StgBool stg_neInt64 (StgInt64 a, StgInt64 b) {return a != b;}
+StgBool stg_ltInt64 (StgInt64 a, StgInt64 b) {return a < b;}
+StgBool stg_leInt64 (StgInt64 a, StgInt64 b) {return a <= b;}
/* Arithmetic operators */
-StgWord64
-stg_remWord64(StgWord64 a, StgWord64 b)
-{ return (a%b); }
-
-StgWord64
-stg_quotWord64(StgWord64 a, StgWord64 b)
-{ return (a/b); }
-
-StgInt64
-stg_remInt64(StgInt64 a, StgInt64 b)
-{ return (a%b); }
-
-StgInt64
-stg_quotInt64(StgInt64 a, StgInt64 b)
-{ return (a/b); }
-
-StgInt64
-stg_negateInt64(StgInt64 a)
-{ return (-a); }
-
-StgInt64
-stg_plusInt64(StgInt64 a, StgInt64 b)
-{ return (a+b); }
-
-StgInt64
-stg_minusInt64(StgInt64 a, StgInt64 b)
-{ return (a-b); }
-
-StgInt64
-stg_timesInt64(StgInt64 a, StgInt64 b)
-{ return (a*b); }
+StgWord64 stg_remWord64 (StgWord64 a, StgWord64 b) {return a % b;}
+StgWord64 stg_quotWord64 (StgWord64 a, StgWord64 b) {return a / b;}
+StgInt64 stg_remInt64 (StgInt64 a, StgInt64 b) {return a % b;}
+StgInt64 stg_quotInt64 (StgInt64 a, StgInt64 b) {return a / b;}
+StgInt64 stg_negateInt64 (StgInt64 a) {return -a;}
+StgInt64 stg_plusInt64 (StgInt64 a, StgInt64 b) {return a + b;}
+StgInt64 stg_minusInt64 (StgInt64 a, StgInt64 b) {return a - b;}
+StgInt64 stg_timesInt64 (StgInt64 a, StgInt64 b) {return a * b;}
/* Logical operators: */
-StgWord64
-stg_and64(StgWord64 a, StgWord64 b)
-{ return (a&b); }
-
-StgWord64
-stg_or64(StgWord64 a, StgWord64 b)
-{ return (a|b); }
-
-StgWord64
-stg_xor64(StgWord64 a, StgWord64 b)
-{ return (a^b); }
-
-StgWord64
-stg_not64(StgWord64 a)
-{ return (~a); }
-
-StgWord64
-stg_shiftL64(StgWord64 a, StgInt b)
-{ return (a << b); }
-
-StgWord64
-stg_shiftRL64(StgWord64 a, StgInt b)
-{ return (a >> b); }
-
-StgInt64
-stg_iShiftL64(StgInt64 a, StgInt b)
-{ return ( a<<b ); }
-
+StgWord64 stg_and64 (StgWord64 a, StgWord64 b) {return a & b;}
+StgWord64 stg_or64 (StgWord64 a, StgWord64 b) {return a | b;}
+StgWord64 stg_xor64 (StgWord64 a, StgWord64 b) {return a ^ b;}
+StgWord64 stg_not64 (StgWord64 a) {return ~a;}
+StgWord64 stg_shiftL64 (StgWord64 a, StgInt b) {return a << b;}
+StgWord64 stg_shiftRL64 (StgWord64 a, StgInt b) {return a >> b;}
/* Right shifting of signed quantities is not portable in C, so
the behaviour you'll get from using these primops depends
on the whatever your C compiler is doing. ToDo: fix. -- sof 8/98
*/
-
-StgInt64
-stg_iShiftRA64(StgInt64 a, StgInt b)
-{ return ( a>>b ); }
-
-StgInt64
-stg_iShiftRL64(StgInt64 a, StgInt b)
-{ return ( a>>b ); }
-
-/*
-Casting between longs and longer longs:
-(the primops that cast from to/from Integers and long longs are
-expressed as macros, since these may cause some heap allocation).
+StgInt64 stg_iShiftL64 (StgInt64 a, StgInt b) {return a << b;}
+StgInt64 stg_iShiftRA64 (StgInt64 a, StgInt b) {return a >> b;}
+StgInt64 stg_iShiftRL64 (StgInt64 a, StgInt b)
+{return (StgInt64) ((StgWord64) a >> b);}
+
+/* Casting between longs and longer longs:
+ (the primops that cast between Integers and long longs are
+ expressed as macros, since these may cause some heap allocation).
*/
-StgInt64
-stg_intToInt64(StgInt i)
-{ return ( (StgInt64)i ); }
-
-StgInt
-stg_int64ToInt(StgInt64 i)
-{ return ( (StgInt)i ); }
-
-StgWord64
-stg_int64ToWord64(StgInt64 i)
-{ return ( (StgWord64)i ); }
-
-StgWord64
-stg_wordToWord64(StgWord w)
-{ return ( (StgWord64)w ); }
-
-StgWord
-stg_word64ToWord(StgWord64 w)
-{ return ( (StgWord)w ); }
-
-StgInt64
-stg_word64ToInt64(StgWord64 w)
-{ return ( (StgInt64)w ); }
+StgInt64 stg_intToInt64 (StgInt i) {return (StgInt64) i;}
+StgInt stg_int64ToInt (StgInt64 i) {return (StgInt) i;}
+StgWord64 stg_int64ToWord64 (StgInt64 i) {return (StgWord64) i;}
+StgWord64 stg_wordToWord64 (StgWord w) {return (StgWord64) w;}
+StgWord stg_word64ToWord (StgWord64 w) {return (StgWord) w;}
+StgInt64 stg_word64ToInt64 (StgWord64 w) {return (StgInt64) w;}
#endif /* SUPPORT_LONG_LONGS */
test :: IO ()
test = do
- testIntlikeNoBits "Int" (0::Int)
- testIntlike "Int8" (0::Int8)
- testIntlike "Int16" (0::Int16)
- testIntlike "Int32" (0::Int32)
- testIntlike "Word8" (0::Word8)
- testIntlike "Word16" (0::Word16)
- testIntlike "Word32" (0::Word32)
+ testIntlike "Int" (0::Int)
+ testIntlike "Int8" (0::Int8)
+ testIntlike "Int16" (0::Int16)
+ testIntlike "Int32" (0::Int32)
+ testIntlike "Int64" (0::Int64)
+ testIntlike "Word8" (0::Word8)
+ testIntlike "Word16" (0::Word16)
+ testIntlike "Word32" (0::Word32)
+ testIntlike "Word64" (0::Word64)
testInteger
-testIntlikeNoBits :: (Bounded a, Integral a, Ix a, Read a) => String -> a -> IO ()
-testIntlikeNoBits name zero = do
+testIntlike :: (Bounded a, Integral a, Ix a, Read a, Bits a) => String -> a -> IO ()
+testIntlike name zero = do
putStrLn $ "--------------------------------"
putStrLn $ "--Testing " ++ name
putStrLn $ "--------------------------------"
testReal zero
testIntegral zero
testConversions zero
+ testBits zero True
testInteger = do
let zero = 0 :: Integer
testIntegral zero
testBits zero False
-testIntlike :: (Bounded a, Integral a, Ix a, Read a, Bits a) => String -> a -> IO ()
-testIntlike name zero = do
- testIntlikeNoBits name zero
- testBits zero True
-
-
-- In all these tests, zero is a dummy element used to get
-- the overloading to work
putStr "Word64 : " >> print (map fromIntegral numbers :: [Word64])
where numbers = [minBound, 0, maxBound] `asTypeOf` [zero]
-samples :: (Num a, Enum a) => a -> ([a], [a])
-samples zero = ([-3 .. -1]++[0 .. 3], [-3 .. -1]++[1 .. 3])
+samples :: (Num a) => a -> ([a], [a])
+samples zero = (map fromInteger ([-3 .. -1]++[0 .. 3]),
+ map fromInteger ([-3 .. -1]++[1 .. 3]))
table1 :: (Show a, Show b) => String -> (a -> b) -> [a] -> IO ()
table1 nm f xs = do
projects / ghc-hetmet.git / commitdiff