X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelNum.lhs;h=49bf878eceb7fa95c04d54c23d8a9868a15143d0;hb=239e9471e104fd88ec93bf42623c3a68a496657a;hp=92ce9ae7052b0126bdd5dd1be5b9f0e5c17748ea;hpb=a103a9dc0de992716e62c30d7ac81c0bc0dbcdc5;p=ghc-hetmet.git diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs index 92ce9ae..49bf878 100644 --- a/ghc/lib/std/PrelNum.lhs +++ b/ghc/lib/std/PrelNum.lhs @@ -1,5 +1,7 @@ +% ------------------------------------------------------------------------------ +% $Id: PrelNum.lhs,v 1.46 2002/01/29 09:58:21 simonpj Exp $ % -% (c) The AQUA Project, Glasgow University, 1994-1996 +% (c) The University of Glasgow, 1994-2000 % \section[PrelNum]{Module @PrelNum@} @@ -14,7 +16,16 @@ and the type \begin{code} -{-# OPTIONS -fcompiling-prelude -fno-implicit-prelude #-} +{-# 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 PrelNum where @@ -43,24 +54,13 @@ class (Eq a, Show a) => Num a where negate :: a -> a abs, signum :: a -> a fromInteger :: Integer -> a - fromInt :: Int -> a -- partain: Glasgow extension x - y = x + negate y negate x = 0 - x - fromInt (I# i#) = fromInteger (S# i#) - -- Go via the standard class-op if the - -- non-standard one ain't provided -\end{code} - -A few small numeric functions -\begin{code} -subtract :: (Num a) => a -> a -> a {-# INLINE subtract #-} -subtract x y = y - x - -ord_0 :: Num a => a -ord_0 = fromInt (ord '0') +subtract :: (Num a) => a -> a -> a +subtract x y = y - x \end{code} @@ -72,18 +72,17 @@ ord_0 = fromInt (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 - fromInt n = n + fromInteger = integer2Int \end{code} @@ -110,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. @@ -127,10 +132,6 @@ integer2Int :: Integer -> Int integer2Int (S# i) = I# i integer2Int (J# s d) = case (integer2Int# s d) of { n# -> I# n# } -addr2Integer :: Addr# -> Integer -{-# INLINE addr2Integer #-} -addr2Integer x = case addr2Integer# x of (# s, d #) -> J# s d - toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d } toBig i@(J# _ _) = i \end{code} @@ -144,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) @@ -154,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) @@ -167,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) @@ -181,14 +182,14 @@ remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib remInteger (J# sa a) (S# b) = case int2Integer# b of { (# sb, b #) -> case remInteger# sa a sb b of { (# sr, r #) -> - S# (sr *# (word2Int# (integer2Word# sr r))) }} + S# (integer2Int# sr r) }} remInteger (J# sa a) (J# sb b) = case remInteger# sa a sb b of (# sr, r #) -> J# sr r 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) @@ -208,17 +209,19 @@ quotInteger (J# sa a) (J# sb b) \begin{code} gcdInteger :: Integer -> Integer -> Integer -gcdInteger a@(S# (-2147483648#)) b = gcdInteger (toBig a) b -gcdInteger a b@(S# (-2147483648#)) = gcdInteger a (toBig b) -gcdInteger (S# a) (S# b) = S# (gcdInt# a b) -gcdInteger ia@(S# a) ib@(J# sb b) +-- SUP: Do we really need the first two cases? +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 "PrelNum.gcdInteger: gcd 0 0 is undefined" +gcdInteger ia@(S# a) ib@(J# sb b) | a ==# 0# = abs ib | sb ==# 0# = abs ia - | otherwise = S# (gcdIntegerInt# sb b a) -gcdInteger ia@(J# sa a) ib@(S# b) - | sa ==# 0# = abs ib - | b ==# 0# = abs ia - | otherwise = S# (gcdIntegerInt# sa a b) + | otherwise = S# (gcdIntegerInt# absSb b absA) + where absA = if a <# 0# then negateInt# a else a + absSb = if sb <# 0# then negateInt# sb else sb +gcdInteger ia@(J# _ _) ib@(S# _) = gcdInteger ib ia +gcdInteger (J# 0# _) (J# 0# _) = error "PrelNum.gcdInteger: gcd 0 0 is undefined" gcdInteger (J# sa a) (J# sb b) = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g @@ -233,10 +236,10 @@ 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 (sb *# (word2Int# (integer2Word# sb b)))) + = S# (quotInt# a (integer2Int# sb b)) divExact (J# sa a) (S# b) = case int2Integer# b of (# sb, b #) -> case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d @@ -315,40 +318,14 @@ instance Ord Integer where \begin{code} instance Num Integer where - (+) i1@(S# i) i2@(S# j) - = case addIntC# i j of { (# r, c #) -> - if c ==# 0# then S# r - else toBig i1 + toBig i2 } - (+) i1@(J# _ _) i2@(S# _) = i1 + toBig i2 - (+) i1@(S# _) i2@(J# _ _) = toBig i1 + i2 - (+) (J# s1 d1) (J# s2 d2) - = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d - - (-) i1@(S# i) i2@(S# j) - = case subIntC# i j of { (# r, c #) -> - if c ==# 0# then S# r - else toBig i1 - toBig i2 } - (-) i1@(J# _ _) i2@(S# _) = i1 - toBig i2 - (-) i1@(S# _) i2@(J# _ _) = toBig i1 - i2 - (-) (J# s1 d1) (J# s2 d2) - = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d - - (*) i1@(S# i) i2@(S# j) - = case mulIntC# i j of { (# r, c #) -> - if c ==# 0# then S# r - else toBig i1 * toBig i2 } - (*) i1@(J# _ _) i2@(S# _) = i1 * toBig i2 - (*) i1@(S# _) i2@(J# _ _) = toBig i1 * i2 - (*) (J# s1 d1) (J# s2 d2) - = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d - - negate (S# (-2147483648#)) = 2147483648 - negate (S# i) = S# (negateInt# i) - negate (J# s d) = J# (negateInt# s) d + (+) = plusInteger + (-) = minusInteger + (*) = timesInteger + negate = negateInteger + 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 @@ -361,9 +338,30 @@ instance Num Integer where else if cmp ==# 0# then S# 0# else S# (negateInt# 1#) - fromInteger x = x - - fromInt (I# i) = S# i +plusInteger i1@(S# i) i2@(S# j) = case addIntC# i j of { (# r, c #) -> + if c ==# 0# then S# r + else toBig i1 + toBig i2 } +plusInteger i1@(J# _ _) i2@(S# _) = i1 + toBig i2 +plusInteger i1@(S# _) i2@(J# _ _) = toBig i1 + i2 +plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d + +minusInteger i1@(S# i) i2@(S# j) = case subIntC# i j of { (# r, c #) -> + if c ==# 0# then S# r + else toBig i1 - toBig i2 } +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) = 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# (-LEFTMOST_BIT#)) = LEFTMOST_BIT +negateInteger (S# i) = S# (negateInt# i) +negateInteger (J# s d) = J# (negateInt# s) d \end{code} @@ -384,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 @@ -442,24 +436,26 @@ 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 + | 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) 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}