From: qrczak Date: Wed, 28 Feb 2001 00:01:04 +0000 (+0000) Subject: [project @ 2001-02-28 00:01:01 by qrczak] X-Git-Tag: Approximately_9120_patches~2525 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=871db587eda4fcba3fdc049b225a1d63a4ebe641;p=ghc-hetmet.git [project @ 2001-02-28 00:01:01 by qrczak] * Add {intToInt,wordToWord}{8,16,32}# primops. WARNING: Not implemented in ncg for Alpha and Sparc. But -O -fasm is not going to go far anyway because of other omissions. * Have full repertoire of 8,16,32-bit signed and unsigned MachMisc.Size values. Again only x86 is fully supported. They are used for {index,read,write}{Int,Word}{8,16,32}{OffAddr,Array}# and {intToInt,wordToWord}{8,16,32}# primops. * Have full repertoire of {index,read,write}\ {Char,WideChar,Int,Word,Addr,Float,Double,StablePtr,\ {Int,Word}{8,16,32,64}}\ {OffAddr,Array} primops and appropriate instances. There were various omissions in various places. * Add {plus,minus,times}Word# primops to avoid so many Word# <-> Int# coercions. * Rewrite modules PrelWord and PrelInt almost from scratch. * Simplify fromInteger and realToFrac rules. For each of {Int,Word}{8,16,32} there is just a pair of fromInteger rules replacing the source or target type with Int or Word. For {Int,Word,Int64,Word64} there are rules from any to any. Don't include rules which are derivable from inlining anyway, e.g. those mentioning Integer. Old explicit coercions are simply defined as appropriately typed fromInteger. * Various old coercion functions marked as deprecated. * Add instance Bits Int, and instance {Show,Num,Real,Enum,Integral,Bounded,Ix,Read,Bits} Word. * Coercions to sized integer types consistently behave as cutting the right amount of bits from the infinite two-complement representation. For example (fromIntegral (-1 :: Int8) :: Word64) == maxBound. * ghc/tests/numeric/should_run/arith011 tests {Int,Word}64 and instance Bits Int, and does not try to use overflowing toEnum. arith011.stdout is not updated yet because of a problem I will tell about soon. * Move fromInteger and realToFrac from Prelude to PrelReal. Move fromInt from PrelNum to PrelReal and define as fromInteger. Define toInt as fromInteger. fromInteger is the place to write integer conversion rules for. * Remove ArrayBase.newInitialisedArray, use default definition of newArray instead. * Bugs fixed: - {quot,rem}Word# primop attributes. - integerToInt64# for small negative values. - {min,max}Bound::Int on 64-bit platforms. - iShiftRL64#. - Various Bits instances. * Polishing: - Use 'ppr' instead of 'pprPrimOp' and 'text . showPrimRep'. - PrimRep.{primRepString,showPrimRepToUser} removed. - MachMisc.sizeOf returns Int instead of Integer. - Some eta reduction, parens, spacing, and reordering cleanups - sorry, couldn't resist. * Questions: - Should iShiftRL and iShiftRL64 be removed? IMHO they should, s/iShiftRA/iShiftR/, s/shiftRL/shiftR/. The behaviour on shifting is a property of the signedness of the type, not the operation! I haven't done this change. --- diff --git a/ghc/compiler/absCSyn/CLabel.lhs b/ghc/compiler/absCSyn/CLabel.lhs index 4bebe07..2c84990 100644 --- a/ghc/compiler/absCSyn/CLabel.lhs +++ b/ghc/compiler/absCSyn/CLabel.lhs @@ -1,7 +1,7 @@ % % (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} @@ -89,7 +89,7 @@ import Module ( moduleName, moduleNameFS, 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} @@ -508,7 +508,7 @@ pprCLbl (RtsLabel (RtsApEntry upd_reqd arity)) ] pprCLbl (RtsLabel (RtsPrimOp primop)) - = pprPrimOp primop <> ptext SLIT("_fast") + = ppr primop <> ptext SLIT("_fast") pprCLbl (RtsLabel RtsModuleRegd) = ptext SLIT("module_registered") diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs index 1bcc3b5..e022656 100644 --- a/ghc/compiler/absCSyn/PprAbsC.lhs +++ b/ghc/compiler/absCSyn/PprAbsC.lhs @@ -45,9 +45,9 @@ import TyCon ( tyConDataCons ) 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, @@ -239,7 +239,7 @@ pprAbsC stmt@(COpStmt results op args vol_regs) _ 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)), @@ -333,14 +333,14 @@ pprAbsC stmt@(CCallTypedef is_tdef (CCall op_str is_asm may_gc cconv) results ar 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 diff --git a/ghc/compiler/nativeGen/MachCode.lhs b/ghc/compiler/nativeGen/MachCode.lhs index cfea55e..fef3596 100644 --- a/ghc/compiler/nativeGen/MachCode.lhs +++ b/ghc/compiler/nativeGen/MachCode.lhs @@ -175,8 +175,8 @@ stmtToInstrs stmt = case stmt of 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). @@ -227,7 +227,7 @@ mangleIndexTree :: StixTree -> StixTree 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 [ @@ -237,7 +237,7 @@ mangleIndexTree (StIndex pk base off) ] where shift :: PrimRep -> Int - shift rep = case (fromInteger (sizeOf rep) :: Int) of + shift rep = case sizeOf rep of 1 -> 0 2 -> 1 4 -> 2 @@ -252,7 +252,7 @@ maybeImm :: StixTree -> Maybe Imm 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)) @@ -479,6 +479,9 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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 @@ -668,6 +671,13 @@ getRegister (StPrim primop [x]) -- unary PrimOps 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 @@ -743,12 +753,16 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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 @@ -922,9 +936,14 @@ getRegister (StInd pk mem) 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) @@ -1103,9 +1122,13 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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 @@ -1123,9 +1146,9 @@ getRegister (StPrim primop [x, y]) -- dyadic PrimOps 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]) @@ -1805,7 +1828,13 @@ assignIntCode pk dst (StInd pks src) 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` @@ -3235,6 +3264,20 @@ coerceFP2Int x -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #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 -> diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs index f7538bb..1f74715 100644 --- a/ghc/compiler/nativeGen/MachMisc.lhs +++ b/ghc/compiler/nativeGen/MachMisc.lhs @@ -97,13 +97,11 @@ eXTRA_STK_ARGS_HERE 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} % - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -237,9 +235,9 @@ data Cond 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 @@ -249,46 +247,55 @@ data Size | 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 diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index b47cfab..ab1e3d9 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -36,7 +36,7 @@ import Maybe ( isJust ) 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,) @@ -89,22 +89,37 @@ pprReg IF_ARCH_i386(s,) r #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 @@ -161,9 +176,9 @@ pprSize :: Size -> SDoc 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 @@ -173,15 +188,19 @@ pprSize x = ptext (case x of 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") @@ -189,7 +208,7 @@ pprSize x = ptext (case x of 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") diff --git a/ghc/compiler/nativeGen/RegAllocInfo.lhs b/ghc/compiler/nativeGen/RegAllocInfo.lhs index 6461871..7fd7e91 100644 --- a/ghc/compiler/nativeGen/RegAllocInfo.lhs +++ b/ghc/compiler/nativeGen/RegAllocInfo.lhs @@ -154,9 +154,9 @@ interesting (RealReg i) = isFastTrue (freeReg i) 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]) diff --git a/ghc/compiler/nativeGen/Stix.lhs b/ghc/compiler/nativeGen/Stix.lhs index 06854db..d3eb3dd 100644 --- a/ghc/compiler/nativeGen/Stix.lhs +++ b/ghc/compiler/nativeGen/Stix.lhs @@ -31,8 +31,8 @@ import Ratio ( Rational ) 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, @@ -163,9 +163,9 @@ pprStixTree t 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) @@ -174,17 +174,15 @@ pprStixTree t 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} @@ -204,11 +202,11 @@ ppStixReg (StixTemp u pr) 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" diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs index c043f8d..5da841e 100644 --- a/ghc/compiler/nativeGen/StixPrim.lhs +++ b/ghc/compiler/nativeGen/StixPrim.lhs @@ -183,76 +183,124 @@ primCode [] WriteForeignObjOp [obj, v] -- 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. @@ -573,8 +621,8 @@ cHARLIKE_closure = StCLbl mkCharlikeClosureLabel 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} diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs index 2d5b2cf..e5c1727 100644 --- a/ghc/compiler/prelude/PrimOp.lhs +++ b/ghc/compiler/prelude/PrimOp.lhs @@ -17,8 +17,6 @@ module PrimOp ( getPrimOpResultInfo, PrimOpResultInfo(..), - pprPrimOp, - CCall(..), CCallTarget(..), ccallMayGC, ccallIsCasm, pprCCallOp, isDynamicTarget, dynamicTarget, setCCallUnique ) where diff --git a/ghc/compiler/prelude/PrimRep.lhs b/ghc/compiler/prelude/PrimRep.lhs index b90c5cd..96a093c 100644 --- a/ghc/compiler/prelude/PrimRep.lhs +++ b/ghc/compiler/prelude/PrimRep.lhs @@ -18,9 +18,6 @@ module PrimRep , getPrimRepSize , getPrimRepSizeInBytes , retPrimRepSize - , showPrimRep - , primRepString - , showPrimRepToUser ) where #include "HsVersions.h" @@ -46,30 +43,21 @@ data PrimRep | 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 @@ -157,33 +145,27 @@ See codeGen/CgCon:cgTopRhsCon. \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. @@ -191,29 +173,27 @@ retPrimRepSize = getPrimRepSize RetRep -- 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} @@ -228,8 +208,6 @@ instance Outputable PrimRep where 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_" @@ -259,23 +237,6 @@ showPrimRep WeakPtrRep = "P_" 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 diff --git a/ghc/compiler/prelude/primops.txt b/ghc/compiler/prelude/primops.txt index 5ea03c4..8b4348c 100644 --- a/ghc/compiler/prelude/primops.txt +++ b/ghc/compiler/prelude/primops.txt @@ -1,5 +1,5 @@ ----------------------------------------------------------------------- --- $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 -- @@ -449,39 +449,47 @@ primop IntegerComplementOp "complementInteger#" GenPrimOp --- 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# --- @@ -491,19 +499,88 @@ primop Word64ToIntegerOp "word64ToInteger#" GenPrimOp 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# #) @@ -552,6 +629,10 @@ primop WriteByteArrayOp_Char "writeCharArray#" GenPrimOp 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 @@ -580,28 +661,28 @@ primop WriteByteArrayOp_Int8 "writeInt8Array#" GenPrimOp MutByteArr# s -> Int# -> Int# -> State# s -> State# s with has_side_effects = True -primop WriteByteArrayOp_Word8 "writeWord8Array#" GenPrimOp - MutByteArr# s -> Int# -> Word# -> State# s -> State# s +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 @@ -609,55 +690,12 @@ 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# @@ -679,24 +717,24 @@ primop IndexOffAddrOp_StablePtr "indexStablePtrOffAddr#" GenPrimOp 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# @@ -704,6 +742,9 @@ primop IndexOffAddrOp_Word64 "indexWord64OffAddr#" GenPrimOp primop IndexOffForeignObjOp_Char "indexCharOffForeignObj#" GenPrimOp ForeignObj# -> Int# -> Char# +primop IndexOffForeignObjOp_WideChar "indexWideCharOffForeignObj#" GenPrimOp + ForeignObj# -> Int# -> Char# + primop IndexOffForeignObjOp_Int "indexIntOffForeignObj#" GenPrimOp ForeignObj# -> Int# -> Int# @@ -725,24 +766,24 @@ primop IndexOffForeignObjOp_StablePtr "indexStablePtrOffForeignObj#" GenPrimOp 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# @@ -751,6 +792,9 @@ primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp 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# #) @@ -772,24 +816,24 @@ primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp 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# #) @@ -798,6 +842,10 @@ primop WriteOffAddrOp_Char "writeCharOffAddr#" GenPrimOp 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 @@ -810,6 +858,10 @@ primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp 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 @@ -822,36 +874,32 @@ primop WriteOffAddrOp_StablePtr "writeStablePtrOffAddr#" GenPrimOp 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 @@ -860,13 +908,6 @@ 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 diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs index a5a993a..2422b42 100644 --- a/ghc/compiler/typecheck/TcGenDeriv.lhs +++ b/ghc/compiler/typecheck/TcGenDeriv.lhs @@ -323,7 +323,7 @@ gen_Ord_binds tycon (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 diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h index 7136b7c..e6d1d40 100644 --- a/ghc/includes/PrimOps.h +++ b/ghc/includes/PrimOps.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -21,68 +21,65 @@ 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) @@ -104,14 +101,14 @@ I_ stg_div (I_ a, I_ b); #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. @@ -165,7 +162,7 @@ typedef union { 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 @@ -174,7 +171,7 @@ typedef union { #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)) @@ -191,11 +188,14 @@ typedef union { #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) @@ -216,74 +216,85 @@ typedef union { 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 /* ----------------------------------------------------------------------------- @@ -355,21 +366,30 @@ typedef union { */ #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) \ @@ -378,10 +398,10 @@ typedef union { \ 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); \ } @@ -391,7 +411,7 @@ typedef union { \ 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); \ } @@ -440,39 +460,38 @@ EXTFUN_RTS(complementIntegerzh_fast); #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; \ } @@ -558,68 +577,68 @@ extern I_ resetGenSymZh(void); #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 @@ -904,22 +923,23 @@ EXTFUN_RTS(mkForeignObjzh_fast); #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 diff --git a/ghc/lib/std/Numeric.lhs b/ghc/lib/std/Numeric.lhs index 167e8e5..6c28117 100644 --- a/ghc/lib/std/Numeric.lhs +++ b/ghc/lib/std/Numeric.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $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 % @@ -41,13 +41,12 @@ import Char #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 @@ -59,18 +58,17 @@ 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 diff --git a/ghc/lib/std/PrelBase.lhs b/ghc/lib/std/PrelBase.lhs index 0cdb208..1ec3111 100644 --- a/ghc/lib/std/PrelBase.lhs +++ b/ghc/lib/std/PrelBase.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $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 % @@ -75,10 +75,12 @@ Other Prelude modules are much easier with fewer complex dependencies. \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 @@ -142,34 +144,35 @@ unpackCStringUtf8# a = error "urk" \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} %********************************************************* @@ -208,11 +211,9 @@ instance (Eq a) => Eq [a] where {- {-# 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 {- @@ -227,9 +228,9 @@ 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 @@ -474,23 +475,28 @@ zeroInt, oneInt, twoInt, maxInt, minInt :: Int 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# @@ -526,6 +532,7 @@ flip f x y = f y x -- right-associating infix application operator (useful in continuation- -- passing style) +{-# INLINE ($) #-} ($) :: (a -> b) -> a -> b f $ x = f x @@ -579,6 +586,20 @@ data a :*: b = a :*: b %* * %********************************************************* +\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. @@ -596,12 +617,14 @@ 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" @@ -617,26 +640,18 @@ gcdInt (I# a) (I# b) = g a b 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} diff --git a/ghc/lib/std/PrelBits.lhs b/ghc/lib/std/PrelBits.lhs index 7d88876..716ee84 100644 --- a/ghc/lib/std/PrelBits.lhs +++ b/ghc/lib/std/PrelBits.lhs @@ -8,6 +8,8 @@ See library document for details on the semantics of the individual operations. \begin{code} +#include "MachDeps.h" + module PrelBits where import Prelude -- To generate the dependency @@ -28,28 +30,53 @@ infixl 5 .|. #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} diff --git a/ghc/lib/std/PrelFloat.lhs b/ghc/lib/std/PrelFloat.lhs index 51a01ab..67eb2a7 100644 --- a/ghc/lib/std/PrelFloat.lhs +++ b/ghc/lib/std/PrelFloat.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $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 % @@ -612,7 +612,7 @@ floatToDigits base x = 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} @@ -874,3 +874,20 @@ foreign import ccall "isDoubleInfinite" unsafe isDoubleInfinite :: Double -> Int 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} diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot index ff89ad1..85d698e 100644 --- a/ghc/lib/std/PrelGHC.hi-boot +++ b/ghc/lib/std/PrelGHC.hi-boot @@ -48,7 +48,7 @@ __export PrelGHC tryTakeMVarzh tryPutMVarzh isEmptyMVarzh - + -- Parallel seqzh parzh @@ -69,7 +69,7 @@ __export PrelGHC leCharzh ordzh chrzh - + -- Int Type Intzh zgzh @@ -91,7 +91,7 @@ __export PrelGHC addIntCzh subIntCzh mulIntCzh - + Wordzh gtWordzh geWordzh @@ -99,6 +99,9 @@ __export PrelGHC neWordzh ltWordzh leWordzh + plusWordzh + minusWordzh + timesWordzh quotWordzh remWordzh andzh @@ -106,14 +109,19 @@ __export PrelGHC notzh xorzh shiftLzh --- shiftRAzh shiftRLzh int2Wordzh word2Intzh - - Word64zh Int64zh + Word64zh + + intToInt8zh + intToInt16zh + intToInt32zh + wordToWord8zh + wordToWord16zh + wordToWord32zh Addrzh gtAddrzh @@ -153,7 +161,7 @@ __export PrelGHC tanhFloatzh powerFloatzh decodeFloatzh - + Doublezh zgzhzh zgzezhzh @@ -184,7 +192,7 @@ __export PrelGHC tanhDoublezh ztztzhzh decodeDoublezh - + cmpIntegerzh cmpIntegerIntzh plusIntegerzh @@ -215,20 +223,21 @@ __export PrelGHC ByteArrayzh MutableArrayzh MutableByteArrayzh - + sameMutableArrayzh sameMutableByteArrayzh - + newArrayzh newByteArrayzh - + indexArrayzh indexCharArrayzh + indexWideCharArrayzh indexIntArrayzh indexWordArrayzh + indexAddrArrayzh indexFloatArrayzh indexDoubleArrayzh - indexAddrArrayzh indexStablePtrArrayzh indexInt8Arrayzh indexInt16Arrayzh @@ -238,9 +247,45 @@ __export PrelGHC 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 @@ -255,8 +300,9 @@ __export PrelGHC indexWord16OffAddrzh indexWord32OffAddrzh indexWord64OffAddrzh - + readCharOffAddrzh + readWideCharOffAddrzh readIntOffAddrzh readWordOffAddrzh readAddrOffAddrzh @@ -273,6 +319,7 @@ __export PrelGHC readWord64OffAddrzh writeCharOffAddrzh + writeWideCharOffAddrzh writeIntOffAddrzh writeWordOffAddrzh writeAddrOffAddrzh @@ -289,8 +336,8 @@ __export PrelGHC writeWord32OffAddrzh writeWord64OffAddrzh --- indexOffForeignObjzh indexCharOffForeignObjzh + indexWideCharOffForeignObjzh indexIntOffForeignObjzh indexWordOffForeignObjzh indexAddrOffForeignObjzh @@ -305,40 +352,6 @@ __export PrelGHC 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 diff --git a/ghc/lib/std/PrelInt.lhs b/ghc/lib/std/PrelInt.lhs index 04c49c8..ed48a37 100644 --- a/ghc/lib/std/PrelInt.lhs +++ b/ghc/lib/std/PrelInt.lhs @@ -1,908 +1,591 @@ % -% (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<>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<>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<>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} diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs index 281ff76..a2bf838 100644 --- a/ghc/lib/std/PrelNum.lhs +++ b/ghc/lib/std/PrelNum.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $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 % @@ -49,20 +49,9 @@ class (Eq a, Show a) => Num a where 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} @@ -74,17 +63,17 @@ ord_0 = ord '0' \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} @@ -436,24 +425,23 @@ dn_list x delta lim = go (x::Integer) %********************************************************* \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} diff --git a/ghc/lib/std/PrelRead.lhs b/ghc/lib/std/PrelRead.lhs index 084a22f..995b9e6 100644 --- a/ghc/lib/std/PrelRead.lhs +++ b/ghc/lib/std/PrelRead.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $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 % @@ -520,26 +520,27 @@ include lexing common prefixes such as '0x' or '0o' etc. 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, diff --git a/ghc/lib/std/PrelReal.lhs b/ghc/lib/std/PrelReal.lhs index acc4877..6748108 100644 --- a/ghc/lib/std/PrelReal.lhs +++ b/ghc/lib/std/PrelReal.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $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 % @@ -97,10 +97,6 @@ class (Real a, Enum a) => Integral a where 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 @@ -267,6 +263,38 @@ instance (Integral a) => Enum (Ratio a) where %********************************************************* %* * +\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} %* * %********************************************************* @@ -320,4 +348,15 @@ lcm x y = abs ((x `quot` (gcd x y)) * y) "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} diff --git a/ghc/lib/std/PrelShow.lhs b/ghc/lib/std/PrelShow.lhs index 2868103..08d728e 100644 --- a/ghc/lib/std/PrelShow.lhs +++ b/ghc/lib/std/PrelShow.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $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 % @@ -107,8 +107,8 @@ instance Show Char where -- 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 @@ -219,9 +219,9 @@ protectEsc p f = f . cont 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} @@ -230,22 +230,24 @@ Code specific for Ints. \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} %********************************************************* diff --git a/ghc/lib/std/PrelStorable.lhs b/ghc/lib/std/PrelStorable.lhs index 7bf23f5..f02b832 100644 --- a/ghc/lib/std/PrelStorable.lhs +++ b/ghc/lib/std/PrelStorable.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $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 % @@ -80,12 +80,6 @@ class Storable a where 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) @@ -98,16 +92,22 @@ instance Storable (FunPtr a) where 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) @@ -178,128 +178,99 @@ Helper functions \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} diff --git a/ghc/lib/std/PrelWord.lhs b/ghc/lib/std/PrelWord.lhs index 5c23fba..0d720dd 100644 --- a/ghc/lib/std/PrelWord.lhs +++ b/ghc/lib/std/PrelWord.lhs @@ -1,5 +1,5 @@ % -% (c) The University of Glasgow, 1997-2000 +% (c) The University of Glasgow, 1997-2001 % \section[PrelWord]{Module @PrelWord@} @@ -9,1072 +9,714 @@ #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} diff --git a/ghc/lib/std/Prelude.lhs b/ghc/lib/std/Prelude.lhs index 0866192..116c466 100644 --- a/ghc/lib/std/Prelude.lhs +++ b/ghc/lib/std/Prelude.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $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 % @@ -179,56 +179,3 @@ mapM_ :: Monad m => (a -> m b) -> [a] -> m () {-# 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} diff --git a/ghc/lib/std/Random.lhs b/ghc/lib/std/Random.lhs index 7e60b47..a6c0055 100644 --- a/ghc/lib/std/Random.lhs +++ b/ghc/lib/std/Random.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $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 % @@ -37,7 +37,6 @@ import PrelShow ( showSignedInt, showSpace ) 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 @@ -175,17 +174,9 @@ instance Random Double where 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} diff --git a/ghc/lib/std/Time.hsc b/ghc/lib/std/Time.hsc index 2dd89d0..1ed8a11 100644 --- a/ghc/lib/std/Time.hsc +++ b/ghc/lib/std/Time.hsc @@ -3,7 +3,7 @@ -- 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 -- @@ -271,7 +271,10 @@ addToClockTime :: TimeDiff -> ClockTime -> ClockTime 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 diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc index b6d52bc..4d453a9 100644 --- a/ghc/rts/PrimOps.hc +++ b/ghc/rts/PrimOps.hc @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -530,12 +530,12 @@ FN_(int64ToIntegerzh_fast) 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 ) { diff --git a/ghc/rts/StgLongLong.c b/ghc/rts/StgLongLong.c index 717a881..a2d884f 100644 --- a/ghc/rts/StgLongLong.c +++ b/ghc/rts/StgLongLong.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $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 * @@ -31,161 +31,61 @@ reason why. #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;} /* 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 */ diff --git a/ghc/tests/numeric/should_run/arith011.hs b/ghc/tests/numeric/should_run/arith011.hs index 8c1a580..5b5842e 100644 --- a/ghc/tests/numeric/should_run/arith011.hs +++ b/ghc/tests/numeric/should_run/arith011.hs @@ -10,17 +10,19 @@ main = test 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 $ "--------------------------------" @@ -33,6 +35,7 @@ testIntlikeNoBits name zero = do testReal zero testIntegral zero testConversions zero + testBits zero True testInteger = do let zero = 0 :: Integer @@ -48,12 +51,6 @@ testInteger = do 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 @@ -83,8 +80,9 @@ testConversions zero = do 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