2 % (c) The AQUA Project, Glasgow University, 1994-1996
5 \section[PrelNum]{Module @PrelNum@}
8 {-# OPTIONS -fno-implicit-prelude #-}
12 import {-# SOURCE #-} PrelErr
19 infixl 7 %, /, `quot`, `rem`, `div`, `mod`
25 %*********************************************************
27 \subsection{Standard numeric classes}
29 %*********************************************************
32 class (Eq a, Show a) => Num a where
33 (+), (-), (*) :: a -> a -> a
36 fromInteger :: Integer -> a
37 fromInt :: Int -> a -- partain: Glasgow extension
41 fromInt (I# i#) = fromInteger (S# i#)
42 -- Go via the standard class-op if the
43 -- non-standard one ain't provided
45 class (Num a, Ord a) => Real a where
46 toRational :: a -> Rational
48 class (Real a, Enum a) => Integral a where
49 quot, rem, div, mod :: a -> a -> a
50 quotRem, divMod :: a -> a -> (a,a)
51 toInteger :: a -> Integer
52 toInt :: a -> Int -- partain: Glasgow extension
54 n `quot` d = q where (q,_) = quotRem n d
55 n `rem` d = r where (_,r) = quotRem n d
56 n `div` d = q where (q,_) = divMod n d
57 n `mod` d = r where (_,r) = divMod n d
58 divMod n d = if signum r == negate (signum d) then (q-1, r+d) else qr
59 where qr@(q,r) = quotRem n d
61 class (Num a) => Fractional a where
64 fromRational :: Rational -> a
69 class (Fractional a) => Floating a where
71 exp, log, sqrt :: a -> a
72 (**), logBase :: a -> a -> a
73 sin, cos, tan :: a -> a
74 asin, acos, atan :: a -> a
75 sinh, cosh, tanh :: a -> a
76 asinh, acosh, atanh :: a -> a
78 x ** y = exp (log x * y)
79 logBase x y = log y / log x
82 tanh x = sinh x / cosh x
84 class (Real a, Fractional a) => RealFrac a where
85 properFraction :: (Integral b) => a -> (b,a)
86 truncate, round :: (Integral b) => a -> b
87 ceiling, floor :: (Integral b) => a -> b
89 truncate x = m where (m,_) = properFraction x
91 round x = let (n,r) = properFraction x
92 m = if r < 0 then n - 1 else n + 1
93 in case signum (abs r - 0.5) of
95 0 -> if even n then n else m
98 ceiling x = if r > 0 then n + 1 else n
99 where (n,r) = properFraction x
101 floor x = if r < 0 then n - 1 else n
102 where (n,r) = properFraction x
104 class (RealFrac a, Floating a) => RealFloat a where
105 floatRadix :: a -> Integer
106 floatDigits :: a -> Int
107 floatRange :: a -> (Int,Int)
108 decodeFloat :: a -> (Integer,Int)
109 encodeFloat :: Integer -> Int -> a
111 significand :: a -> a
112 scaleFloat :: Int -> a -> a
113 isNaN, isInfinite, isDenormalized, isNegativeZero, isIEEE
118 exponent x = if m == 0 then 0 else n + floatDigits x
119 where (m,n) = decodeFloat x
121 significand x = encodeFloat m (negate (floatDigits x))
122 where (m,_) = decodeFloat x
124 scaleFloat k x = encodeFloat m (n+k)
125 where (m,n) = decodeFloat x
129 | x == 0 && y > 0 = pi/2
130 | x < 0 && y > 0 = pi + atan (y/x)
131 |(x <= 0 && y < 0) ||
132 (x < 0 && isNegativeZero y) ||
133 (isNegativeZero x && isNegativeZero y)
135 | y == 0 && (x < 0 || isNegativeZero x)
136 = pi -- must be after the previous test on zero y
137 | x==0 && y==0 = y -- must be after the other double zero tests
138 | otherwise = x + y -- x or y is a NaN, return a NaN (via +)
142 %*********************************************************
144 \subsection{Instances for @Int@}
146 %*********************************************************
149 instance Num Int where
150 (+) x y = plusInt x y
151 (-) x y = minusInt x y
152 negate x = negateInt x
153 (*) x y = timesInt x y
154 abs n = if n `geInt` 0 then n else (negateInt n)
156 signum n | n `ltInt` 0 = negateInt 1
160 fromInteger (S# i#) = I# i#
161 fromInteger (J# s# d#)
162 = case (integer2Int# s# d#) of { i# -> I# i# }
166 instance Real Int where
167 toRational x = toInteger x % 1
169 instance Integral Int where
170 a@(I# _) `quotRem` b@(I# _) = (a `quotInt` b, a `remInt` b)
171 -- OK, so I made it a little stricter. Shoot me. (WDP 94/10)
173 -- Following chks for zero divisor are non-standard (WDP)
174 a `quot` b = if b /= 0
176 else error "Prelude.Integral.quot{Int}: divide by 0"
177 a `rem` b = if b /= 0
179 else error "Prelude.Integral.rem{Int}: divide by 0"
181 x `div` y = if x > 0 && y < 0 then quotInt (x-y-1) y
182 else if x < 0 && y > 0 then quotInt (x-y+1) y
184 x `mod` y = if x > 0 && y < 0 || x < 0 && y > 0 then
185 if r/=0 then r+y else 0
190 divMod x@(I# _) y@(I# _) = (x `div` y, x `mod` y)
191 -- Stricter. Sorry if you don't like it. (WDP 94/10)
193 --OLD: even x = eqInt (x `mod` 2) 0
194 --OLD: odd x = neInt (x `mod` 2) 0
196 toInteger (I# i) = int2Integer i -- give back a full-blown Integer
201 %*********************************************************
203 \subsection{Instances for @Integer@}
205 %*********************************************************
208 toBig (S# i) = case int2Integer# i of { (# s, d #) -> J# s d }
211 instance Num Integer where
212 (+) i1@(S# i) i2@(S# j)
213 = case addIntC# i j of { (# r, c #) ->
214 if c ==# 0# then S# r
215 else toBig i1 + toBig i2 }
216 (+) i1@(J# _ _) i2@(S# _) = i1 + toBig i2
217 (+) i1@(S# _) i2@(J# _ _) = toBig i1 + i2
218 (+) (J# s1 d1) (J# s2 d2)
219 = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
221 (-) i1@(S# i) i2@(S# j)
222 = case subIntC# i j of { (# r, c #) ->
223 if c ==# 0# then S# r
224 else toBig i1 - toBig i2 }
225 (-) i1@(J# _ _) i2@(S# _) = i1 - toBig i2
226 (-) i1@(S# _) i2@(J# _ _) = toBig i1 - i2
227 (-) (J# s1 d1) (J# s2 d2)
228 = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
230 (*) i1@(S# i) i2@(S# j)
231 = case mulIntC# i j of { (# r, c #) ->
232 if c ==# 0# then S# r
233 else toBig i1 * toBig i2 }
234 (*) i1@(J# _ _) i2@(S# _) = i1 * toBig i2
235 (*) i1@(S# _) i2@(J# _ _) = toBig i1 * i2
236 (*) (J# s1 d1) (J# s2 d2)
237 = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d
239 negate (S# (-2147483648#)) = 2147483648
240 negate (S# i) = S# (negateInt# i)
241 negate (J# s d) = J# (negateInt# s) d
243 -- ORIG: abs n = if n >= 0 then n else -n
245 abs (S# (-2147483648#)) = 2147483648
246 abs (S# i) = case abs (I# i) of I# j -> S# j
247 abs n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d
249 signum (S# i) = case signum (I# i) of I# j -> S# j
252 cmp = cmpIntegerInt# s d 0#
254 if cmp ># 0# then S# 1#
255 else if cmp ==# 0# then S# 0#
256 else S# (negateInt# 1#)
260 fromInt (I# i) = S# i
262 instance Real Integer where
265 instance Integral Integer where
266 -- ToDo: a `rem` b returns a small integer if b is small,
267 -- a `quot` b returns a small integer if a is small.
268 quotRem (S# i) (S# j)
269 = case quotRem (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
270 quotRem i1@(J# _ _) i2@(S# _) = quotRem i1 (toBig i2)
271 quotRem i1@(S# _) i2@(J# _ _) = quotRem (toBig i1) i2
272 quotRem (J# s1 d1) (J# s2 d2)
273 = case (quotRemInteger# s1 d1 s2 d2) of
275 -> (J# s3 d3, J# s4 d4)
279 toInt (J# s d) = case (integer2Int# s d) of { n# -> I# n# }
281 -- we've got specialised quot/rem methods for Integer (see below)
282 n `quot` d = n `quotInteger` d
283 n `rem` d = n `remInteger` d
285 n `div` d = q where (q,_) = divMod n d
286 n `mod` d = r where (_,r) = divMod n d
289 = case divMod (I# i) (I# j) of ( I# i, I# j ) -> ( S# i, S# j)
290 divMod i1@(J# _ _) i2@(S# _) = divMod i1 (toBig i2)
291 divMod i1@(S# _) i2@(J# _ _) = divMod (toBig i1) i2
292 divMod (J# s1 d1) (J# s2 d2)
293 = case (divModInteger# s1 d1 s2 d2) of
295 -> (J# s3 d3, J# s4 d4)
297 remInteger :: Integer -> Integer -> Integer
299 = error "Prelude.Integral.rem{Integer}: divide by 0"
300 remInteger (S# a) (S# b) = S# (remInt# a b)
301 remInteger ia@(S# a) (J# sb b)
304 S# (remInt# a (word2Int# (integer2Word# sb b)))
305 else if sb ==# -1# then
306 S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
307 else if 0# <# sb then
311 remInteger (J# sa a) (S# b)
312 = case int2Integer# b of { (# sb, b #) ->
313 case remInteger# sa a sb b of { (# sr, r #) ->
314 S# (sr *# (word2Int# (integer2Word# sr r))) }}
315 remInteger (J# sa a) (J# sb b)
316 = case remInteger# sa a sb b of (# sr, r #) -> J# sr r
318 quotInteger :: Integer -> Integer -> Integer
320 = error "Prelude.Integral.quot{Integer}: divide by 0"
321 quotInteger (S# a) (S# b) = S# (quotInt# a b)
322 quotInteger (S# a) (J# sb b)
325 S# (quotInt# a (word2Int# (integer2Word# sb b)))
326 else if sb ==# -1# then
327 S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
330 quotInteger (J# sa a) (S# b)
331 = case int2Integer# b of { (# sb, b #) ->
332 case quotInteger# sa a sb b of (# sq, q #) -> J# sq q }
333 quotInteger (J# sa a) (J# sb b)
334 = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g
336 zeroInteger :: Integer
339 ------------------------------------------------------------------------
340 instance Enum Integer where
343 toEnum n = toInteger n
346 {-# INLINE enumFrom #-}
347 {-# INLINE enumFromThen #-}
348 {-# INLINE enumFromTo #-}
349 {-# INLINE enumFromThenTo #-}
350 enumFrom x = build (\c _ -> enumDeltaIntegerFB c x 1)
351 enumFromThen x y = build (\c _ -> enumDeltaIntegerFB c x (y-x))
352 enumFromTo x lim = build (\c n -> enumDeltaToIntegerFB c n x 1 lim)
353 enumFromThenTo x y lim = build (\c n -> enumDeltaToIntegerFB c n x (y-x) lim)
355 enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b
356 enumDeltaIntegerFB c x d = x `c` enumDeltaIntegerFB c (x+d) d
358 enumDeltaIntegerList :: Integer -> Integer -> [Integer]
359 enumDeltaIntegerList x d = x : enumDeltaIntegerList (x+d) d
361 enumDeltaToIntegerFB c n x delta lim
362 | delta >= 0 = up_fb c n x delta lim
363 | otherwise = dn_fb c n x delta lim
365 enumDeltaToIntegerList x delta lim
366 | delta >= 0 = up_list x delta lim
367 | otherwise = dn_list x delta lim
369 up_fb c n x delta lim = go (x::Integer)
372 | otherwise = x `c` go (x+delta)
373 dn_fb c n x delta lim = go (x::Integer)
376 | otherwise = x `c` go (x+delta)
378 up_list x delta lim = go (x::Integer)
381 | otherwise = x : go (x+delta)
382 dn_list x delta lim = go (x::Integer)
385 | otherwise = x : go (x+delta)
388 "enumDeltaInteger" enumDeltaIntegerFB (:) = enumDeltaIntegerList
389 "enumDeltaToInteger" enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
393 %*********************************************************
395 \subsection{Show code for Integers}
397 %*********************************************************
400 instance Show Integer where
401 showsPrec x = showSignedInteger x
402 showList = showList__ (showsPrec 0)
404 showSignedInteger :: Int -> Integer -> ShowS
405 showSignedInteger p n r
406 | n < 0 && p > 6 = '(':jtos n (')':r)
407 | otherwise = jtos n r
409 jtos :: Integer -> String -> String
411 | i < 0 = '-' : jtos' (-i) rs
412 | otherwise = jtos' i rs
414 jtos' :: Integer -> String -> String
416 | n < 10 = chr (fromInteger n + (ord_0::Int)) : cs
417 | otherwise = jtos' q (chr (toInt r + (ord_0::Int)) : cs)
419 (q,r) = n `quotRem` 10
422 ord_0 = fromInt (ord '0')
425 %*********************************************************
427 \subsection{The @Ratio@ and @Rational@ types}
429 %*********************************************************
432 data (Integral a) => Ratio a = !a :% !a deriving (Eq)
433 type Rational = Ratio Integer
435 {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-}
436 (%) :: (Integral a) => a -> a -> Ratio a
437 numerator, denominator :: (Integral a) => Ratio a -> a
440 \tr{reduce} is a subsidiary function used only in this module .
441 It normalises a ratio by dividing both numerator and denominator by
442 their greatest common divisor.
445 reduce :: (Integral a) => a -> a -> Ratio a
446 reduce _ 0 = error "Ratio.%: zero denominator"
447 reduce x y = (x `quot` d) :% (y `quot` d)
452 x % y = reduce (x * signum y) (abs y)
454 numerator (x :% _) = x
455 denominator (_ :% y) = y
459 %*********************************************************
461 \subsection{Overloaded numeric functions}
463 %*********************************************************
467 {-# SPECIALISE subtract :: Int -> Int -> Int #-}
468 subtract :: (Num a) => a -> a -> a
471 even, odd :: (Integral a) => a -> Bool
472 even n = n `rem` 2 == 0
475 gcd :: (Integral a) => a -> a -> a
476 gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined"
477 gcd x y = gcd' (abs x) (abs y)
479 gcd' a b = gcd' b (a `rem` b)
481 {-# SPECIALISE lcm ::
483 Integer -> Integer -> Integer #-}
484 lcm :: (Integral a) => a -> a -> a
487 lcm x y = abs ((x `quot` (gcd x y)) * y)
489 {-# SPECIALISE (^) ::
490 Integer -> Integer -> Integer,
491 Integer -> Int -> Integer,
492 Int -> Int -> Int #-}
493 (^) :: (Num a, Integral b) => a -> b -> a
495 x ^ n | n > 0 = f x (n-1) x
497 f a d y = g a d where
498 g b i | even i = g (b*b) (i `quot` 2)
499 | otherwise = f b (i-1) (b*y)
500 _ ^ _ = error "Prelude.^: negative exponent"
502 {- SPECIALISE (^^) ::
503 Double -> Int -> Double,
504 Rational -> Int -> Rational #-}
505 (^^) :: (Fractional a, Integral b) => a -> b -> a
506 x ^^ n = if n >= 0 then x^n else recip (x^(negate n))
509 %*********************************************************
511 \subsection{Specialized versions of gcd/lcm for Int/Integer}
513 %*********************************************************
517 "Int.gcd" forall a b . gcd a b = gcdInt a b
518 "Integer.gcd" forall a b . gcd a b = gcdInteger a b
519 "Integer.lcm" forall a b . lcm a b = lcmInteger a b
522 gcdInt :: Int -> Int -> Int
526 gcdInteger :: Integer -> Integer -> Integer
527 gcdInteger (S# a) (S# b)
528 = case gcdInt# a b of g -> S# g
529 gcdInteger ia@(S# a) ib@(J# sb b)
532 | otherwise = case gcdIntegerInt# sb b a of g -> S# g
533 gcdInteger ia@(J# sa a) ib@(S# b)
536 | otherwise = case gcdIntegerInt# sa a b of g -> S# g
537 gcdInteger (J# sa a) (J# sb b)
538 = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g
540 lcmInteger :: Integer -> Integer -> Integer
546 = (divExact aa (gcdInteger aa ab)) * ab
550 divExact :: Integer -> Integer -> Integer
551 divExact (S# a) (S# b)
553 divExact (S# a) (J# sb b)
554 = S# (quotInt# a (sb *# (word2Int# (integer2Word# sb b))))
555 divExact (J# sa a) (S# b)
556 = case int2Integer# b of
557 (# sb, b #) -> case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
558 divExact (J# sa a) (J# sb b)
559 = case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d