PrelNum.lhs 13.4 KB
Newer Older
1
2
3
4
5
6
%
% (c) The AQUA Project, Glasgow University, 1994-1996
%

\section[PrelNum]{Module @PrelNum@}

7
8
9
10
11
12
13
14
15
The class

	Num

and the type

	Integer


16
\begin{code}
17
{-# OPTIONS -fno-implicit-prelude #-}
sof's avatar
sof committed
18

19
20
module PrelNum where

21
import {-# SOURCE #-} PrelErr
22
23
24
25
import PrelBase
import PrelList
import PrelEnum
import PrelShow
26

27
28
29
infixl 7  *
infixl 6  +, -

30
31
default ()		-- Double isn't available yet, 
			-- and we shouldn't be using defaults anyway
32
33
34
35
\end{code}

%*********************************************************
%*							*
36
\subsection{Standard numeric class}
37
38
39
40
%*							*
%*********************************************************

\begin{code}
41
42
43
44
45
46
47
48
49
50
51
52
class  (Eq a, Show a) => Num a  where
    (+), (-), (*)	:: a -> a -> a
    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
53
\end{code}
54

55
A few small numeric functions
sof's avatar
sof committed
56

57
58
59
60
61
62
63
\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')
64
65
\end{code}

66

67
68
69
70
71
72
73
%*********************************************************
%*							*
\subsection{Instances for @Int@}
%*							*
%*********************************************************

\begin{code}
74
75
76
77
78
79
80
81
82
83
84
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)

    signum n | n `ltInt` 0 = negateInt 1
	     | n `eqInt` 0 = 0
	     | otherwise   = 1

85
86
87
    fromInteger n = integer2Int n
    fromInt n	  = n
\end{code}
88
89


90
91
92
\begin{code}
-- These can't go in PrelBase with the defn of Int, because
-- we don't have pairs defined at that time!
93

94
95
quotRemInt :: Int -> Int -> (Int, Int)
a@(I# _) `quotRemInt` b@(I# _) = (a `quotInt` b, a `remInt` b)
96
97
    -- OK, so I made it a little stricter.  Shoot me.  (WDP 94/10)

98
99
divModInt ::  Int -> Int -> (Int, Int)
divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y)
100
    -- Stricter.  Sorry if you don't like it.  (WDP 94/10)
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
\end{code}


%*********************************************************
%*							*
\subsection{The @Integer@ type}
%*							*
%*********************************************************

\begin{code}
data Integer	
   = S# Int#				-- small integers
   | J# Int# ByteArray#			-- large integers
\end{code}

Convenient boxed Integer PrimOps. 

\begin{code}
zeroInteger :: Integer
zeroInteger = S# 0#
121

122
123
124
int2Integer :: Int -> Integer
{-# INLINE int2Integer #-}
int2Integer (I# i) = S# i
125

126
127
128
integer2Int :: Integer -> Int
integer2Int (S# i)   = I# i
integer2Int (J# s d) = case (integer2Int# s d) of { n# -> I# n# }
129

130
131
132
133
134
135
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
136
137
\end{code}

138

139
140
%*********************************************************
%*							*
141
\subsection{Dividing @Integers@}
142
143
144
145
%*							*
%*********************************************************

\begin{code}
146
quotRemInteger :: Integer -> Integer -> (Integer, Integer)
147
148
149
quotRemInteger a@(S# (-2147483648#)) 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 ) 
150
151
152
153
154
155
156
quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2)
quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2
quotRemInteger (J# s1 d1) (J# s2 d2)
  = case (quotRemInteger# s1 d1 s2 d2) of
	  (# s3, d3, s4, d4 #)
	    -> (J# s3 d3, J# s4 d4)

157
158
159
divModInteger a@(S# (-2147483648#)) 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) 
160
161
162
163
164
165
166
167
168
169
divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2)
divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2
divModInteger (J# s1 d1) (J# s2 d2)
  = case (divModInteger# s1 d1 s2 d2) of
	  (# s3, d3, s4, d4 #)
	    -> (J# s3 d3, J# s4 d4)

remInteger :: Integer -> Integer -> Integer
remInteger ia 0
  = error "Prelude.Integral.rem{Integer}: divide by 0"
170
171
remInteger a@(S# (-2147483648#)) b = remInteger (toBig a) b
remInteger (S# a) (S# b) = S# (remInt# a b)
172
173
{- 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
175
176
177
178
remInteger ia@(S# a) (J# sb b)
  | sb ==# 1#  = S# (remInt# a (word2Int# (integer2Word# sb b)))
  | sb ==# -1# = S# (remInt# a (0# -# (word2Int# (integer2Word# sb b))))
  | 0# <# sb   = ia
  | otherwise  = S# (0# -# a)
179
180
-}
remInteger ia@(S# _) ib@(J# _ _) = remInteger (toBig ia) ib
181
182
183
184
185
186
187
188
189
190
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))) }}
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"
191
192
quotInteger a@(S# (-2147483648#)) b = quotInteger (toBig a) b
quotInteger (S# a) (S# b) = S# (quotInt# a b)
193
{- Special case disabled, see remInteger above
194
195
196
197
quotInteger (S# a) (J# sb b)
  | sb ==# 1#  = S# (quotInt# a (word2Int# (integer2Word# sb b)))
  | sb ==# -1# = S# (quotInt# a (0# -# (word2Int# (integer2Word# sb b))))
  | otherwise  = zeroInteger
198
199
-}
quotInteger ia@(S# _) ib@(J# _ _) = quotInteger (toBig ia) ib
200
201
202
203
204
205
206
207
208
209
210
quotInteger (J# sa a) (S# b)
  = case int2Integer# b of { (# sb, b #) ->
    case quotInteger# sa a sb b of (# sq, q #) -> J# sq q }
quotInteger (J# sa a) (J# sb b)
  = case quotInteger# sa a sb b of (# sg, g #) -> J# sg g
\end{code}



\begin{code}
gcdInteger :: Integer -> Integer -> Integer
211
212
213
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)
214
215
216
gcdInteger ia@(S# a) ib@(J# sb b)
  | a  ==# 0#  = abs ib
  | sb ==# 0#  = abs ia
217
  | otherwise  = S# (gcdIntegerInt# sb b a)
218
219
220
gcdInteger ia@(J# sa a) ib@(S# b)
  | sa ==# 0#  = abs ib
  | b ==# 0#   = abs ia
221
  | otherwise  = S# (gcdIntegerInt# sa a b)
222
223
224
225
226
227
228
229
230
231
232
233
234
235
gcdInteger (J# sa a) (J# sb b)
  = case gcdInteger# sa a sb b of (# sg, g #) -> J# sg g

lcmInteger :: Integer -> Integer -> Integer
lcmInteger a 0
  = zeroInteger
lcmInteger 0 b
  = zeroInteger
lcmInteger a b
  = (divExact aa (gcdInteger aa ab)) * ab
  where aa = abs a
        ab = abs b

divExact :: Integer -> Integer -> Integer
236
237
divExact a@(S# (-2147483648#)) b = divExact (toBig a) b
divExact (S# a) (S# b) = S# (quotInt# a b)
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
divExact (S# a) (J# sb b)
  = S# (quotInt# a (sb *# (word2Int# (integer2Word# 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
divExact (J# sa a) (J# sb b)
  = case divExactInteger# sa a sb b of (# sd, d #) -> J# sd d
\end{code}


%*********************************************************
%*							*
\subsection{The @Integer@ instances for @Eq@, @Ord@}
%*							*
%*********************************************************

\begin{code}
instance  Eq Integer  where
    (S# i)     ==  (S# j)     = i ==# j
    (S# i)     ==  (J# s d)   = cmpIntegerInt# s d i ==# 0#
    (J# s d)   ==  (S# i)     = cmpIntegerInt# s d i ==# 0#
    (J# s1 d1) ==  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ==# 0#

    (S# i)     /=  (S# j)     = i /=# j
    (S# i)     /=  (J# s d)   = cmpIntegerInt# s d i /=# 0#
    (J# s d)   /=  (S# i)     = cmpIntegerInt# s d i /=# 0#
    (J# s1 d1) /=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) /=# 0#

------------------------------------------------------------------------
instance  Ord Integer  where
    (S# i)     <=  (S# j)     = i <=# j
    (J# s d)   <=  (S# i)     = cmpIntegerInt# s d i <=# 0#
    (S# i)     <=  (J# s d)   = cmpIntegerInt# s d i >=# 0#
    (J# s1 d1) <=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <=# 0#

    (S# i)     >   (S# j)     = i ># j
    (J# s d)   >   (S# i)     = cmpIntegerInt# s d i ># 0#
    (S# i)     >   (J# s d)   = cmpIntegerInt# s d i <# 0#
    (J# s1 d1) >   (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) ># 0#

    (S# i)     <   (S# j)     = i <# j
    (J# s d)   <   (S# i)     = cmpIntegerInt# s d i <# 0#
    (S# i)     <   (J# s d)   = cmpIntegerInt# s d i ># 0#
    (J# s1 d1) <   (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) <# 0#

    (S# i)     >=  (S# j)     = i >=# j
    (J# s d)   >=  (S# i)     = cmpIntegerInt# s d i >=# 0#
    (S# i)     >=  (J# s d)   = cmpIntegerInt# s d i <=# 0#
    (J# s1 d1) >=  (J# s2 d2) = (cmpInteger# s1 d1 s2 d2) >=# 0#

    compare (S# i)  (S# j)
       | i ==# j = EQ
       | i <=# j = LT
       | otherwise = GT
    compare (J# s d) (S# i)
       = case cmpIntegerInt# s d i of { res# ->
	 if res# <# 0# then LT else 
	 if res# ># 0# then GT else EQ
	 }
    compare (S# i) (J# s d)
       = case cmpIntegerInt# s d i of { res# ->
	 if res# ># 0# then LT else 
	 if res# <# 0# then GT else EQ
	 }
    compare (J# s1 d1) (J# s2 d2)
       = case cmpInteger# s1 d1 s2 d2 of { res# ->
	 if res# <# 0# then LT else 
	 if res# ># 0# then GT else EQ
	 }
\end{code}


%*********************************************************
%*							*
\subsection{The @Integer@ instances for @Num@}
%*							*
%*********************************************************
315

316
\begin{code}
317
318
319
320
321
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 }
322
323
    (+) i1@(J# _ _) i2@(S# _)	= i1 + toBig i2
    (+) i1@(S# _) i2@(J# _ _)	= toBig i1 + i2
324
325
326
327
328
329
330
    (+) (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 }
331
332
    (-) i1@(J# _ _) i2@(S# _)	= i1 - toBig i2
    (-) i1@(S# _) i2@(J# _ _)	= toBig i1 - i2
333
334
335
336
337
338
339
    (-) (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 }
340
341
    (*) i1@(J# _ _) i2@(S# _)	= i1 * toBig i2
    (*) i1@(S# _) i2@(J# _ _)	= toBig i1 * i2
342
343
344
    (*) (J# s1 d1) (J# s2 d2)
      = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d

345
    negate (S# (-2147483648#)) = 2147483648
346
347
    negate (S# i) = S# (negateInt# i)
    negate (J# s d) = J# (negateInt# s) d
348
349
350

    -- ORIG: abs n = if n >= 0 then n else -n

351
    abs (S# (-2147483648#)) = 2147483648
352
    abs (S# i) = case abs (I# i) of I# j -> S# j
353
    abs n@(J# s d) = if (s >=# 0#) then n else J# (negateInt# s) d
354

355
356
357
358
    signum (S# i) = case signum (I# i) of I# j -> S# j
    signum (J# s d)
      = let
	    cmp = cmpIntegerInt# s d 0#
359
	in
360
361
362
	if      cmp >#  0# then S# 1#
	else if cmp ==# 0# then S# 0#
	else			S# (negateInt# 1#)
363
364
365

    fromInteger	x	=  x

366
    fromInt (I# i)	=  S# i
367
\end{code}
368

369

370
371
372
373
374
%*********************************************************
%*							*
\subsection{The @Integer@ instance for @Enum@}
%*							*
%*********************************************************
375

376
\begin{code}
377
instance  Enum Integer  where
sof's avatar
sof committed
378
379
    succ x		 = x + 1
    pred x		 = x - 1
380
381
    toEnum n		 = int2Integer n
    fromEnum n		 = integer2Int n
382
383
384
385
386

    {-# INLINE enumFrom #-}
    {-# INLINE enumFromThen #-}
    {-# INLINE enumFromTo #-}
    {-# INLINE enumFromThenTo #-}
387
388
    enumFrom x             = build (\c _ -> enumDeltaIntegerFB 	 c   x 1)
    enumFromThen x y       = build (\c _ -> enumDeltaIntegerFB 	 c   x (y-x))
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    enumFromTo x lim	   = build (\c n -> enumDeltaToIntegerFB c n x 1     lim)
    enumFromThenTo x y lim = build (\c n -> enumDeltaToIntegerFB c n x (y-x) lim)

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

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
  | delta >= 0 = up_list x delta lim
  | otherwise  = dn_list x delta lim

up_fb c n x delta lim = go (x::Integer)
		      where
			go x | x > lim   = n
			     | otherwise = x `c` go (x+delta)
dn_fb c n x delta lim = go (x::Integer)
		      where
			go x | x < lim   = n
			     | otherwise = x `c` go (x+delta)

up_list x delta lim = go (x::Integer)
		    where
			go x | x > lim   = []
			     | otherwise = x : go (x+delta)
dn_list x delta lim = go (x::Integer)
		    where
			go x | x < lim   = []
			     | otherwise = x : go (x+delta)

{-# RULES
"enumDeltaInteger" 	enumDeltaIntegerFB   (:)    = enumDeltaIntegerList
"enumDeltaToInteger" 	enumDeltaToIntegerFB (:) [] = enumDeltaToIntegerList
 #-}
428
\end{code}
429

430

431
432
%*********************************************************
%*							*
433
\subsection{The @Integer@ instances for @Show@}
434
435
%*							*
%*********************************************************
436

437
\begin{code}
438
439
440
441
instance  Show Integer  where
    showsPrec   x = showSignedInteger x
    showList = showList__ (showsPrec 0) 

442
443
showSignedInteger :: Int -> Integer -> ShowS
showSignedInteger p n r
sof's avatar
sof committed
444
445
446
447
448
449
450
451
452
453
454
  | n < 0 && p > 6 = '(':jtos n (')':r)
  | otherwise      = jtos n r

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
455
   | otherwise = jtos' q (chr (integer2Int r + (ord_0::Int)) : cs)
sof's avatar
sof committed
456
    where
457
     (q,r) = n `quotRemInteger` 10
458
\end{code}