X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FNum.lhs;h=52c2a7b871a419dd1771099ccdb1e99993e865e8;hb=0cfe27e61d58380603acbec3ba8e5aefcdcf5420;hp=c8355314885216eef68631d53841de257ccb52ab;hpb=7f1f4e7a695c402ddd3a1dc2cc7114e649a78ebc;p=ghc-base.git diff --git a/GHC/Num.lhs b/GHC/Num.lhs index c835531..52c2a7b 100644 --- a/GHC/Num.lhs +++ b/GHC/Num.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: Num.lhs,v 1.1 2001/06/28 14:15:03 simonmar Exp $ +% $Id: Num.lhs,v 1.4 2002/02/05 17:32:26 simonmar Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -18,6 +18,15 @@ and the type \begin{code} {-# OPTIONS -fno-implicit-prelude #-} +#include "MachDeps.h" +#if SIZEOF_HSWORD == 4 +#define LEFTMOST_BIT 2147483648 +#elif SIZEOF_HSWORD == 8 +#define LEFTMOST_BIT 9223372036854775808 +#else +#error Please define LEFTMOST_BIT to be 2^(SIZEOF_HSWORD*8-1) +#endif + module GHC.Num where import {-# SOURCE #-} GHC.Err @@ -100,7 +109,13 @@ divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y) \begin{code} data Integer = S# Int# -- small integers +#ifndef ILX | J# Int# ByteArray# -- large integers +#else + | J# Void BigInteger -- .NET big ints + +foreign type dotnet "BigInteger" BigInteger +#endif \end{code} Convenient boxed Integer PrimOps. @@ -130,7 +145,7 @@ toBig i@(J# _ _) = i \begin{code} quotRemInteger :: Integer -> Integer -> (Integer, Integer) -quotRemInteger a@(S# (-2147483648#)) b = quotRemInteger (toBig a) b +quotRemInteger a@(S# (-LEFTMOST_BIT#)) b = quotRemInteger (toBig a) b quotRemInteger (S# i) (S# j) = case quotRemInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j ) quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2) @@ -140,7 +155,7 @@ quotRemInteger (J# s1 d1) (J# s2 d2) (# s3, d3, s4, d4 #) -> (J# s3 d3, J# s4 d4) -divModInteger a@(S# (-2147483648#)) b = divModInteger (toBig a) b +divModInteger a@(S# (-LEFTMOST_BIT#)) b = divModInteger (toBig a) b divModInteger (S# i) (S# j) = case divModInt (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j) divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2) @@ -153,7 +168,7 @@ divModInteger (J# s1 d1) (J# s2 d2) remInteger :: Integer -> Integer -> Integer remInteger ia 0 = error "Prelude.Integral.rem{Integer}: divide by 0" -remInteger a@(S# (-2147483648#)) b = remInteger (toBig a) b +remInteger a@(S# (-LEFTMOST_BIT#)) b = remInteger (toBig a) b remInteger (S# a) (S# b) = S# (remInt# a b) {- Special case doesn't work, because a 1-element J# has the range -(2^32-1) -- 2^32-1, whereas S# has the range -2^31 -- (2^31-1) @@ -174,7 +189,7 @@ remInteger (J# sa a) (J# sb b) quotInteger :: Integer -> Integer -> Integer quotInteger ia 0 = error "Prelude.Integral.quot{Integer}: divide by 0" -quotInteger a@(S# (-2147483648#)) b = quotInteger (toBig a) b +quotInteger a@(S# (-LEFTMOST_BIT#)) b = quotInteger (toBig a) b quotInteger (S# a) (S# b) = S# (quotInt# a b) {- Special case disabled, see remInteger above quotInteger (S# a) (J# sb b) @@ -195,8 +210,8 @@ quotInteger (J# sa a) (J# sb b) \begin{code} gcdInteger :: Integer -> Integer -> Integer -- SUP: Do we really need the first two cases? -gcdInteger a@(S# (-2147483648#)) b = gcdInteger (toBig a) b -gcdInteger a b@(S# (-2147483648#)) = gcdInteger a (toBig b) +gcdInteger a@(S# (-LEFTMOST_BIT#)) b = gcdInteger (toBig a) b +gcdInteger a b@(S# (-LEFTMOST_BIT#)) = gcdInteger a (toBig b) gcdInteger (S# a) (S# b) = case gcdInt (I# a) (I# b) of { I# c -> S# c } gcdInteger ia@(S# 0#) ib@(J# 0# _) = error "GHC.Num.gcdInteger: gcd 0 0 is undefined" gcdInteger ia@(S# a) ib@(J# sb b) @@ -221,7 +236,7 @@ lcmInteger a b ab = abs b divExact :: Integer -> Integer -> Integer -divExact a@(S# (-2147483648#)) b = divExact (toBig a) b +divExact a@(S# (-LEFTMOST_BIT#)) b = divExact (toBig a) b divExact (S# a) (S# b) = S# (quotInt# a b) divExact (S# a) (J# sb b) = S# (quotInt# a (integer2Int# sb b)) @@ -310,7 +325,7 @@ instance Num Integer where fromInteger x = x -- ORIG: abs n = if n >= 0 then n else -n - abs (S# (-2147483648#)) = 2147483648 + abs (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT abs (S# i) = case abs (I# i) of I# j -> S# j abs n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d @@ -337,14 +352,14 @@ minusInteger i1@(J# _ _) i2@(S# _) = i1 - toBig i2 minusInteger i1@(S# _) i2@(J# _ _) = toBig i1 - i2 minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d -timesInteger i1@(S# i) i2@(S# j) = case mulIntC# i j of { (# r, c #) -> - if c ==# 0# then S# r - else toBig i1 * toBig i2 } +timesInteger i1@(S# i) i2@(S# j) = if mulIntMayOflo# i j ==# 0# + then S# (i *# j) + else toBig i1 * toBig i2 timesInteger i1@(J# _ _) i2@(S# _) = i1 * toBig i2 timesInteger i1@(S# _) i2@(J# _ _) = toBig i1 * i2 timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d -negateInteger (S# (-2147483648#)) = 2147483648 +negateInteger (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT negateInteger (S# i) = S# (negateInt# i) negateInteger (J# s d) = J# (negateInt# s) d \end{code} @@ -367,33 +382,29 @@ instance Enum Integer where {-# INLINE enumFromThen #-} {-# INLINE enumFromTo #-} {-# INLINE enumFromThenTo #-} - enumFrom x = efdInteger x 1 - enumFromThen x y = efdInteger x (y-x) - enumFromTo x lim = efdtInteger x 1 lim - enumFromThenTo x y lim = efdtInteger x (y-x) lim - - -efdInteger = enumDeltaIntegerList -efdtInteger = enumDeltaToIntegerList + enumFrom x = enumDeltaInteger x 1 + enumFromThen x y = enumDeltaInteger x (y-x) + enumFromTo x lim = enumDeltaToInteger x 1 lim + enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim {-# RULES -"efdInteger" forall x y. efdInteger x y = build (\c _ -> enumDeltaIntegerFB c x y) -"efdtInteger" forall x y l.efdtInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l) -"enumDeltaInteger" enumDeltaIntegerFB (:) = enumDeltaIntegerList -"enumDeltaToInteger" enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList +"enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y) +"efdtInteger" [~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l) +"enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger +"enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger #-} enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d -enumDeltaIntegerList :: Integer -> Integer -> [Integer] -enumDeltaIntegerList x d = x : enumDeltaIntegerList (x+d) d +enumDeltaInteger :: Integer -> Integer -> [Integer] +enumDeltaInteger x d = x : enumDeltaInteger (x+d) d enumDeltaToIntegerFB c n x delta lim | delta >= 0 = up_fb c n x delta lim | otherwise = dn_fb c n x delta lim -enumDeltaToIntegerList x delta lim +enumDeltaToInteger x delta lim | delta >= 0 = up_list x delta lim | otherwise = dn_list x delta lim @@ -427,7 +438,10 @@ dn_list x delta lim = go (x::Integer) \begin{code} instance Show Integer where showsPrec p n r - | n < 0 && p > 6 = '(' : jtos n (')' : r) + | p > 6 && n < 0 = '(' : jtos n (')' : r) + -- Minor point: testing p first gives better code + -- in the not-uncommon case where the p argument + -- is a constant | otherwise = jtos n r showList = showList__ (showsPrec 0)