32cf2d2579c1501af70aa39051c0c84ba2e3cfb8
[ghc.git] / libraries / base / GHC / Natural.hs
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE CPP #-}
3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
4 {-# LANGUAGE MagicHash #-}
5 {-# LANGUAGE NoImplicitPrelude #-}
6 {-# LANGUAGE UnboxedTuples #-}
7 {-# LANGUAGE Unsafe #-}
8
9 {-# OPTIONS_HADDOCK not-home #-}
10
11 -----------------------------------------------------------------------------
12 -- |
13 -- Module : GHC.Natural
14 -- Copyright : (C) 2014 Herbert Valerio Riedel,
15 -- (C) 2011 Edward Kmett
16 -- License : see libraries/base/LICENSE
17 --
18 -- Maintainer : libraries@haskell.org
19 -- Stability : internal
20 -- Portability : non-portable (GHC Extensions)
21 --
22 -- The arbitrary-precision 'Natural' number type.
23 --
24 -- __Note__: This is an internal GHC module with an API subject to
25 -- change. It's recommended use the "Numeric.Natural" module to import
26 -- the 'Natural' type.
27 --
28 -- @since 4.8.0.0
29 -----------------------------------------------------------------------------
30 module GHC.Natural
31 ( -- * The 'Natural' number type
32 --
33 -- | __Warning__: The internal implementation of 'Natural'
34 -- (i.e. which constructors are available) depends on the
35 -- 'Integer' backend used!
36 Natural(..)
37 , isValidNatural
38 -- * Conversions
39 , naturalFromInteger
40 , wordToNatural
41 , naturalToWordMaybe
42 -- * Checked subtraction
43 , minusNaturalMaybe
44 -- * Modular arithmetic
45 , powModNatural
46 ) where
47
48 #include "MachDeps.h"
49
50 import GHC.Arr
51 import GHC.Base
52 import {-# SOURCE #-} GHC.Exception (underflowException)
53 #if defined(MIN_VERSION_integer_gmp)
54 import GHC.Integer.GMP.Internals
55 import Data.Word
56 import Data.Int
57 #endif
58 import GHC.Num
59 import GHC.Real
60 import GHC.Read
61 import GHC.Show
62 import GHC.Enum
63 import GHC.List
64
65 import Data.Bits
66
67 default ()
68
69 -------------------------------------------------------------------------------
70 -- Arithmetic underflow
71 -------------------------------------------------------------------------------
72
73 -- We put them here because they are needed relatively early
74 -- in the libraries before the Exception type has been defined yet.
75
76 {-# NOINLINE underflowError #-}
77 underflowError :: a
78 underflowError = raise# underflowException
79
80 -------------------------------------------------------------------------------
81 -- Natural type
82 -------------------------------------------------------------------------------
83
84 #if defined(MIN_VERSION_integer_gmp)
85 -- TODO: if saturated arithmetic is to used, replace 'underflowError' by '0'
86
87 -- | Type representing arbitrary-precision non-negative integers.
88 --
89 -- >>> 2^20 :: Natural
90 -- 1267650600228229401496703205376
91 --
92 -- Operations whose result would be negative @'throw' ('Underflow' :: 'ArithException')@,
93 --
94 -- >>> -1 :: Natural
95 -- *** Exception: arithmetic underflow
96 --
97 -- @since 4.8.0.0
98 data Natural = NatS# GmpLimb# -- ^ in @[0, maxBound::Word]@
99 | NatJ# {-# UNPACK #-} !BigNat -- ^ in @]maxBound::Word, +inf[@
100 --
101 -- __Invariant__: 'NatJ#' is used
102 -- /iff/ value doesn't fit in
103 -- 'NatS#' constructor.
104 -- NB: Order of constructors *must*
105 -- coincide with 'Ord' relation
106 deriving ( Eq -- ^ @since 4.8.0.0
107 , Ord -- ^ @since 4.8.0.0
108 )
109
110
111 -- | Test whether all internal invariants are satisfied by 'Natural' value
112 --
113 -- This operation is mostly useful for test-suites and/or code which
114 -- constructs 'Integer' values directly.
115 --
116 -- @since 4.8.0.0
117 isValidNatural :: Natural -> Bool
118 isValidNatural (NatS# _) = True
119 isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn)
120 && I# (sizeofBigNat# bn) > 0
121
122 {-# RULES
123 "fromIntegral/Natural->Natural" fromIntegral = id :: Natural -> Natural
124 "fromIntegral/Natural->Integer" fromIntegral = toInteger :: Natural->Integer
125 "fromIntegral/Natural->Word" fromIntegral = naturalToWord
126 "fromIntegral/Natural->Word8"
127 fromIntegral = (fromIntegral :: Word -> Word8) . naturalToWord
128 "fromIntegral/Natural->Word16"
129 fromIntegral = (fromIntegral :: Word -> Word16) . naturalToWord
130 "fromIntegral/Natural->Word32"
131 fromIntegral = (fromIntegral :: Word -> Word32) . naturalToWord
132 "fromIntegral/Natural->Int8"
133 fromIntegral = (fromIntegral :: Int -> Int8) . naturalToInt
134 "fromIntegral/Natural->Int16"
135 fromIntegral = (fromIntegral :: Int -> Int16) . naturalToInt
136 "fromIntegral/Natural->Int32"
137 fromIntegral = (fromIntegral :: Int -> Int32) . naturalToInt
138 #-}
139
140 {-# RULES
141 "fromIntegral/Word->Natural" fromIntegral = wordToNatural
142 "fromIntegral/Word8->Natural"
143 fromIntegral = wordToNatural . (fromIntegral :: Word8 -> Word)
144 "fromIntegral/Word16->Natural"
145 fromIntegral = wordToNatural . (fromIntegral :: Word16 -> Word)
146 "fromIntegral/Word32->Natural"
147 fromIntegral = wordToNatural . (fromIntegral :: Word32 -> Word)
148 "fromIntegral/Int->Natural" fromIntegral = intToNatural
149 "fromIntegral/Int8->Natural"
150 fromIntegral = intToNatural . (fromIntegral :: Int8 -> Int)
151 "fromIntegral/Int16->Natural"
152 fromIntegral = intToNatural . (fromIntegral :: Int16 -> Int)
153 "fromIntegral/Int32->Natural"
154 fromIntegral = intToNatural . (fromIntegral :: Int32 -> Int)
155 #-}
156
157 #if WORD_SIZE_IN_BITS == 64
158 -- these RULES are valid for Word==Word64 & Int==Int64
159 {-# RULES
160 "fromIntegral/Natural->Word64"
161 fromIntegral = (fromIntegral :: Word -> Word64) . naturalToWord
162 "fromIntegral/Natural->Int64"
163 fromIntegral = (fromIntegral :: Int -> Int64) . naturalToInt
164 "fromIntegral/Word64->Natural"
165 fromIntegral = wordToNatural . (fromIntegral :: Word64 -> Word)
166 "fromIntegral/Int64->Natural"
167 fromIntegral = intToNatural . (fromIntegral :: Int64 -> Int)
168 #-}
169 #endif
170
171 -- | @since 4.8.0.0
172 instance Show Natural where
173 showsPrec p (NatS# w#) = showsPrec p (W# w#)
174 showsPrec p (NatJ# bn) = showsPrec p (Jp# bn)
175
176 -- | @since 4.8.0.0
177 instance Read Natural where
178 readsPrec d = map (\(n, s) -> (fromInteger n, s))
179 . filter ((>= 0) . (\(x,_)->x)) . readsPrec d
180
181 -- | @since 4.8.0.0
182 instance Num Natural where
183 fromInteger = naturalFromInteger
184
185 (+) = plusNatural
186 (*) = timesNatural
187 (-) = minusNatural
188
189 abs = id
190
191 signum (NatS# 0##) = NatS# 0##
192 signum _ = NatS# 1##
193
194 negate (NatS# 0##) = NatS# 0##
195 negate _ = underflowError
196
197 -- | @since 4.10.0.0
198 naturalFromInteger :: Integer -> Natural
199 naturalFromInteger (S# i#) | I# i# >= 0 = NatS# (int2Word# i#)
200 naturalFromInteger (Jp# bn) = bigNatToNatural bn
201 naturalFromInteger _ = underflowError
202 {-# INLINE naturalFromInteger #-}
203
204 -- | @since 4.8.0.0
205 instance Real Natural where
206 toRational (NatS# w) = toRational (W# w)
207 toRational (NatJ# bn) = toRational (Jp# bn)
208
209 #if OPTIMISE_INTEGER_GCD_LCM
210 {-# RULES
211 "gcd/Natural->Natural->Natural" gcd = gcdNatural
212 "lcm/Natural->Natural->Natural" lcm = lcmNatural
213 #-}
214
215 -- | Compute greatest common divisor.
216 gcdNatural :: Natural -> Natural -> Natural
217 gcdNatural (NatS# 0##) y = y
218 gcdNatural x (NatS# 0##) = x
219 gcdNatural (NatS# 1##) _ = (NatS# 1##)
220 gcdNatural _ (NatS# 1##) = (NatS# 1##)
221 gcdNatural (NatJ# x) (NatJ# y) = bigNatToNatural (gcdBigNat x y)
222 gcdNatural (NatJ# x) (NatS# y) = NatS# (gcdBigNatWord x y)
223 gcdNatural (NatS# x) (NatJ# y) = NatS# (gcdBigNatWord y x)
224 gcdNatural (NatS# x) (NatS# y) = NatS# (gcdWord x y)
225
226 -- | compute least common multiplier.
227 lcmNatural :: Natural -> Natural -> Natural
228 lcmNatural (NatS# 0##) _ = (NatS# 0##)
229 lcmNatural _ (NatS# 0##) = (NatS# 0##)
230 lcmNatural (NatS# 1##) y = y
231 lcmNatural x (NatS# 1##) = x
232 lcmNatural x y = (x `quot` (gcdNatural x y)) * y
233
234 #endif
235
236 -- | @since 4.8.0.0
237 instance Enum Natural where
238 succ n = n `plusNatural` NatS# 1##
239 pred n = n `minusNatural` NatS# 1##
240
241 toEnum = intToNatural
242
243 fromEnum (NatS# w) | i >= 0 = i
244 where
245 i = fromIntegral (W# w)
246 fromEnum _ = errorWithoutStackTrace "fromEnum: out of Int range"
247
248 enumFrom x = enumDeltaNatural x (NatS# 1##)
249 enumFromThen x y
250 | x <= y = enumDeltaNatural x (y-x)
251 | otherwise = enumNegDeltaToNatural x (x-y) (NatS# 0##)
252
253 enumFromTo x lim = enumDeltaToNatural x (NatS# 1##) lim
254 enumFromThenTo x y lim
255 | x <= y = enumDeltaToNatural x (y-x) lim
256 | otherwise = enumNegDeltaToNatural x (x-y) lim
257
258 ----------------------------------------------------------------------------
259 -- Helpers for 'Enum Natural'; TODO: optimise & make fusion work
260
261 enumDeltaNatural :: Natural -> Natural -> [Natural]
262 enumDeltaNatural !x d = x : enumDeltaNatural (x+d) d
263
264 enumDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
265 enumDeltaToNatural x0 delta lim = go x0
266 where
267 go x | x > lim = []
268 | otherwise = x : go (x+delta)
269
270 enumNegDeltaToNatural :: Natural -> Natural -> Natural -> [Natural]
271 enumNegDeltaToNatural x0 ndelta lim = go x0
272 where
273 go x | x < lim = []
274 | x >= ndelta = x : go (x-ndelta)
275 | otherwise = [x]
276
277 ----------------------------------------------------------------------------
278
279 -- | @since 4.8.0.0
280 instance Integral Natural where
281 toInteger (NatS# w) = wordToInteger w
282 toInteger (NatJ# bn) = Jp# bn
283
284 divMod = quotRem
285 div = quot
286 mod = rem
287
288 quotRem _ (NatS# 0##) = divZeroError
289 quotRem n (NatS# 1##) = (n,NatS# 0##)
290 quotRem n@(NatS# _) (NatJ# _) = (NatS# 0##, n)
291 quotRem (NatS# n) (NatS# d) = case quotRem (W# n) (W# d) of
292 (q,r) -> (wordToNatural q, wordToNatural r)
293 quotRem (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of
294 (# q,r #) -> (bigNatToNatural q, NatS# r)
295 quotRem (NatJ# n) (NatJ# d) = case quotRemBigNat n d of
296 (# q,r #) -> (bigNatToNatural q, bigNatToNatural r)
297
298 quot _ (NatS# 0##) = divZeroError
299 quot n (NatS# 1##) = n
300 quot (NatS# _) (NatJ# _) = NatS# 0##
301 quot (NatS# n) (NatS# d) = wordToNatural (quot (W# n) (W# d))
302 quot (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d)
303 quot (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d)
304
305 rem _ (NatS# 0##) = divZeroError
306 rem _ (NatS# 1##) = NatS# 0##
307 rem n@(NatS# _) (NatJ# _) = n
308 rem (NatS# n) (NatS# d) = wordToNatural (rem (W# n) (W# d))
309 rem (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d)
310 rem (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d)
311
312 -- | @since 4.8.0.0
313 instance Ix Natural where
314 range (m,n) = [m..n]
315 inRange (m,n) i = m <= i && i <= n
316 unsafeIndex (m,_) i = fromIntegral (i-m)
317 index b i | inRange b i = unsafeIndex b i
318 | otherwise = indexError b i "Natural"
319
320
321 -- | @since 4.8.0.0
322 instance Bits Natural where
323 NatS# n .&. NatS# m = wordToNatural (W# n .&. W# m)
324 NatS# n .&. NatJ# m = wordToNatural (W# n .&. W# (bigNatToWord m))
325 NatJ# n .&. NatS# m = wordToNatural (W# (bigNatToWord n) .&. W# m)
326 NatJ# n .&. NatJ# m = bigNatToNatural (andBigNat n m)
327
328 NatS# n .|. NatS# m = wordToNatural (W# n .|. W# m)
329 NatS# n .|. NatJ# m = NatJ# (orBigNat (wordToBigNat n) m)
330 NatJ# n .|. NatS# m = NatJ# (orBigNat n (wordToBigNat m))
331 NatJ# n .|. NatJ# m = NatJ# (orBigNat n m)
332
333 NatS# n `xor` NatS# m = wordToNatural (W# n `xor` W# m)
334 NatS# n `xor` NatJ# m = NatJ# (xorBigNat (wordToBigNat n) m)
335 NatJ# n `xor` NatS# m = NatJ# (xorBigNat n (wordToBigNat m))
336 NatJ# n `xor` NatJ# m = bigNatToNatural (xorBigNat n m)
337
338 complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
339
340 bitSizeMaybe _ = Nothing
341 bitSize = errorWithoutStackTrace "Natural: bitSize"
342 isSigned _ = False
343
344 bit i@(I# i#) | i < finiteBitSize (0::Word) = wordToNatural (bit i)
345 | otherwise = NatJ# (bitBigNat i#)
346
347 testBit (NatS# w) i = testBit (W# w) i
348 testBit (NatJ# bn) (I# i#) = testBitBigNat bn i#
349
350 clearBit n@(NatS# w#) i
351 | i < finiteBitSize (0::Word) = let !(W# w2#) = clearBit (W# w#) i in NatS# w2#
352 | otherwise = n
353 clearBit (NatJ# bn) (I# i#) = bigNatToNatural (clearBitBigNat bn i#)
354
355 setBit (NatS# w#) i@(I# i#)
356 | i < finiteBitSize (0::Word) = let !(W# w2#) = setBit (W# w#) i in NatS# w2#
357 | otherwise = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#)
358 setBit (NatJ# bn) (I# i#) = bigNatToNatural (setBitBigNat bn i#)
359
360 complementBit (NatS# w#) i@(I# i#)
361 | i < finiteBitSize (0::Word) = let !(W# w2#) = complementBit (W# w#) i in NatS# w2#
362 | otherwise = bigNatToNatural (setBitBigNat (wordToBigNat w#) i#)
363 complementBit (NatJ# bn) (I# i#) = bigNatToNatural (complementBitBigNat bn i#)
364
365 shiftL n 0 = n
366 shiftL (NatS# 0##) _ = NatS# 0##
367 shiftL (NatS# 1##) i = bit i
368 shiftL (NatS# w) (I# i#)
369 = bigNatToNatural $ shiftLBigNat (wordToBigNat w) i#
370 shiftL (NatJ# bn) (I# i#)
371 = bigNatToNatural $ shiftLBigNat bn i#
372
373 shiftR n 0 = n
374 shiftR (NatS# w) i = wordToNatural $ shiftR (W# w) i
375 shiftR (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#)
376
377 rotateL = shiftL
378 rotateR = shiftR
379
380 popCount (NatS# w) = popCount (W# w)
381 popCount (NatJ# bn) = I# (popCountBigNat bn)
382
383 zeroBits = NatS# 0##
384
385 ----------------------------------------------------------------------------
386
387 -- | 'Natural' Addition
388 plusNatural :: Natural -> Natural -> Natural
389 plusNatural (NatS# 0##) y = y
390 plusNatural x (NatS# 0##) = x
391 plusNatural (NatS# x) (NatS# y)
392 = case plusWord2# x y of
393 (# 0##, l #) -> NatS# l
394 (# h, l #) -> NatJ# (wordToBigNat2 h l)
395 plusNatural (NatS# x) (NatJ# y) = NatJ# (plusBigNatWord y x)
396 plusNatural (NatJ# x) (NatS# y) = NatJ# (plusBigNatWord x y)
397 plusNatural (NatJ# x) (NatJ# y) = NatJ# (plusBigNat x y)
398
399 -- | 'Natural' multiplication
400 timesNatural :: Natural -> Natural -> Natural
401 timesNatural _ (NatS# 0##) = NatS# 0##
402 timesNatural (NatS# 0##) _ = NatS# 0##
403 timesNatural x (NatS# 1##) = x
404 timesNatural (NatS# 1##) y = y
405 timesNatural (NatS# x) (NatS# y) = case timesWord2# x y of
406 (# 0##, 0## #) -> NatS# 0##
407 (# 0##, xy #) -> NatS# xy
408 (# h , l #) -> NatJ# $ wordToBigNat2 h l
409 timesNatural (NatS# x) (NatJ# y) = NatJ# $ timesBigNatWord y x
410 timesNatural (NatJ# x) (NatS# y) = NatJ# $ timesBigNatWord x y
411 timesNatural (NatJ# x) (NatJ# y) = NatJ# $ timesBigNat x y
412
413 -- | 'Natural' subtraction. May @'throw' 'Underflow'@.
414 minusNatural :: Natural -> Natural -> Natural
415 minusNatural x (NatS# 0##) = x
416 minusNatural (NatS# x) (NatS# y) = case subWordC# x y of
417 (# l, 0# #) -> NatS# l
418 _ -> underflowError
419 minusNatural (NatS# _) (NatJ# _) = underflowError
420 minusNatural (NatJ# x) (NatS# y)
421 = bigNatToNatural $ minusBigNatWord x y
422 minusNatural (NatJ# x) (NatJ# y)
423 = bigNatToNatural $ minusBigNat x y
424
425 -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.
426 --
427 -- @since 4.8.0.0
428 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
429 minusNaturalMaybe x (NatS# 0##) = Just x
430 minusNaturalMaybe (NatS# x) (NatS# y) = case subWordC# x y of
431 (# l, 0# #) -> Just (NatS# l)
432 _ -> Nothing
433 where
434 minusNaturalMaybe (NatS# _) (NatJ# _) = Nothing
435 minusNaturalMaybe (NatJ# x) (NatS# y)
436 = Just $ bigNatToNatural $ minusBigNatWord x y
437 minusNaturalMaybe (NatJ# x) (NatJ# y)
438 | isTrue# (isNullBigNat# res) = Nothing
439 | otherwise = Just (bigNatToNatural res)
440 where
441 res = minusBigNat x y
442
443 -- | Convert 'BigNat' to 'Natural'.
444 -- Throws 'Underflow' if passed a 'nullBigNat'.
445 bigNatToNatural :: BigNat -> Natural
446 bigNatToNatural bn
447 | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)
448 | isTrue# (isNullBigNat# bn) = underflowError
449 | otherwise = NatJ# bn
450
451 naturalToBigNat :: Natural -> BigNat
452 naturalToBigNat (NatS# w#) = wordToBigNat w#
453 naturalToBigNat (NatJ# bn) = bn
454
455 -- | Convert 'Int' to 'Natural'.
456 -- Throws 'Underflow' when passed a negative 'Int'.
457 intToNatural :: Int -> Natural
458 intToNatural i | i<0 = underflowError
459 intToNatural (I# i#) = NatS# (int2Word# i#)
460
461 naturalToWord :: Natural -> Word
462 naturalToWord (NatS# w#) = W# w#
463 naturalToWord (NatJ# bn) = W# (bigNatToWord bn)
464
465 naturalToInt :: Natural -> Int
466 naturalToInt (NatS# w#) = I# (word2Int# w#)
467 naturalToInt (NatJ# bn) = I# (bigNatToInt bn)
468
469 #else /* !defined(MIN_VERSION_integer_gmp) */
470 ----------------------------------------------------------------------------
471 -- Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package
472
473 -- | Type representing arbitrary-precision non-negative integers.
474 --
475 -- Operations whose result would be negative
476 -- @'throw' ('Underflow' :: 'ArithException')@.
477 --
478 -- @since 4.8.0.0
479 newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer'
480 deriving (Eq,Ord,Ix)
481
482 -- | Test whether all internal invariants are satisfied by 'Natural' value
483 --
484 -- This operation is mostly useful for test-suites and/or code which
485 -- constructs 'Integer' values directly.
486 --
487 -- @since 4.8.0.0
488 isValidNatural :: Natural -> Bool
489 isValidNatural (Natural i) = i >= 0
490
491 -- | @since 4.8.0.0
492 instance Read Natural where
493 readsPrec d = map (\(n, s) -> (Natural n, s))
494 . filter ((>= 0) . (\(x,_)->x)) . readsPrec d
495
496 -- | @since 4.8.0.0
497 instance Show Natural where
498 showsPrec d (Natural i) = showsPrec d i
499
500 -- | @since 4.8.0.0
501 instance Num Natural where
502 Natural n + Natural m = Natural (n + m)
503 {-# INLINE (+) #-}
504 Natural n * Natural m = Natural (n * m)
505 {-# INLINE (*) #-}
506 Natural n - Natural m | result < 0 = underflowError
507 | otherwise = Natural result
508 where result = n - m
509 {-# INLINE (-) #-}
510 abs (Natural n) = Natural n
511 {-# INLINE abs #-}
512 signum (Natural n) = Natural (signum n)
513 {-# INLINE signum #-}
514 fromInteger = naturalFromInteger
515 {-# INLINE fromInteger #-}
516
517 -- | @since 4.10.0.0
518 naturalFromInteger :: Integer -> Natural
519 naturalFromInteger n
520 | n >= 0 = Natural n
521 | otherwise = underflowError
522 {-# INLINE naturalFromInteger #-}
523
524 -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.
525 --
526 -- @since 4.8.0.0
527 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
528 minusNaturalMaybe x y
529 | x >= y = Just (x - y)
530 | otherwise = Nothing
531
532 -- | @since 4.8.0.0
533 instance Bits Natural where
534 Natural n .&. Natural m = Natural (n .&. m)
535 {-# INLINE (.&.) #-}
536 Natural n .|. Natural m = Natural (n .|. m)
537 {-# INLINE (.|.) #-}
538 xor (Natural n) (Natural m) = Natural (xor n m)
539 {-# INLINE xor #-}
540 complement _ = errorWithoutStackTrace "Bits.complement: Natural complement undefined"
541 {-# INLINE complement #-}
542 shift (Natural n) = Natural . shift n
543 {-# INLINE shift #-}
544 rotate (Natural n) = Natural . rotate n
545 {-# INLINE rotate #-}
546 bit = Natural . bit
547 {-# INLINE bit #-}
548 setBit (Natural n) = Natural . setBit n
549 {-# INLINE setBit #-}
550 clearBit (Natural n) = Natural . clearBit n
551 {-# INLINE clearBit #-}
552 complementBit (Natural n) = Natural . complementBit n
553 {-# INLINE complementBit #-}
554 testBit (Natural n) = testBit n
555 {-# INLINE testBit #-}
556 bitSizeMaybe _ = Nothing
557 {-# INLINE bitSizeMaybe #-}
558 bitSize = errorWithoutStackTrace "Natural: bitSize"
559 {-# INLINE bitSize #-}
560 isSigned _ = False
561 {-# INLINE isSigned #-}
562 shiftL (Natural n) = Natural . shiftL n
563 {-# INLINE shiftL #-}
564 shiftR (Natural n) = Natural . shiftR n
565 {-# INLINE shiftR #-}
566 rotateL (Natural n) = Natural . rotateL n
567 {-# INLINE rotateL #-}
568 rotateR (Natural n) = Natural . rotateR n
569 {-# INLINE rotateR #-}
570 popCount (Natural n) = popCount n
571 {-# INLINE popCount #-}
572 zeroBits = Natural 0
573
574 -- | @since 4.8.0.0
575 instance Real Natural where
576 toRational (Natural a) = toRational a
577 {-# INLINE toRational #-}
578
579 -- | @since 4.8.0.0
580 instance Enum Natural where
581 pred (Natural 0) = errorWithoutStackTrace "Natural.pred: 0"
582 pred (Natural n) = Natural (pred n)
583 {-# INLINE pred #-}
584 succ (Natural n) = Natural (succ n)
585 {-# INLINE succ #-}
586 fromEnum (Natural n) = fromEnum n
587 {-# INLINE fromEnum #-}
588 toEnum n | n < 0 = errorWithoutStackTrace "Natural.toEnum: negative"
589 | otherwise = Natural (toEnum n)
590 {-# INLINE toEnum #-}
591
592 enumFrom = coerce (enumFrom :: Integer -> [Integer])
593 enumFromThen x y
594 | x <= y = coerce (enumFromThen :: Integer -> Integer -> [Integer]) x y
595 | otherwise = enumFromThenTo x y 0
596
597 enumFromTo = coerce (enumFromTo :: Integer -> Integer -> [Integer])
598 enumFromThenTo
599 = coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer])
600
601 -- | @since 4.8.0.0
602 instance Integral Natural where
603 quot (Natural a) (Natural b) = Natural (quot a b)
604 {-# INLINE quot #-}
605 rem (Natural a) (Natural b) = Natural (rem a b)
606 {-# INLINE rem #-}
607 div (Natural a) (Natural b) = Natural (div a b)
608 {-# INLINE div #-}
609 mod (Natural a) (Natural b) = Natural (mod a b)
610 {-# INLINE mod #-}
611 divMod (Natural a) (Natural b) = (Natural q, Natural r)
612 where (q,r) = divMod a b
613 {-# INLINE divMod #-}
614 quotRem (Natural a) (Natural b) = (Natural q, Natural r)
615 where (q,r) = quotRem a b
616 {-# INLINE quotRem #-}
617 toInteger (Natural a) = a
618 {-# INLINE toInteger #-}
619 #endif
620
621 -- | Construct 'Natural' from 'Word' value.
622 --
623 -- @since 4.8.0.0
624 wordToNatural :: Word -> Natural
625 #if defined(MIN_VERSION_integer_gmp)
626 wordToNatural (W# w#) = NatS# w#
627 #else
628 wordToNatural w = Natural (fromIntegral w)
629 #endif
630
631 -- | Try downcasting 'Natural' to 'Word' value.
632 -- Returns 'Nothing' if value doesn't fit in 'Word'.
633 --
634 -- @since 4.8.0.0
635 naturalToWordMaybe :: Natural -> Maybe Word
636 #if defined(MIN_VERSION_integer_gmp)
637 naturalToWordMaybe (NatS# w#) = Just (W# w#)
638 naturalToWordMaybe (NatJ# _) = Nothing
639 #else
640 naturalToWordMaybe (Natural i)
641 | i <= maxw = Just (fromIntegral i)
642 | otherwise = Nothing
643 where
644 maxw = toInteger (maxBound :: Word)
645 #endif
646
647 -- | \"@'powModNatural' /b/ /e/ /m/@\" computes base @/b/@ raised to
648 -- exponent @/e/@ modulo @/m/@.
649 --
650 -- @since 4.8.0.0
651 powModNatural :: Natural -> Natural -> Natural -> Natural
652 #if defined(MIN_VERSION_integer_gmp)
653 powModNatural _ _ (NatS# 0##) = divZeroError
654 powModNatural _ _ (NatS# 1##) = NatS# 0##
655 powModNatural _ (NatS# 0##) _ = NatS# 1##
656 powModNatural (NatS# 0##) _ _ = NatS# 0##
657 powModNatural (NatS# 1##) _ _ = NatS# 1##
658 powModNatural (NatS# b) (NatS# e) (NatS# m) = NatS# (powModWord b e m)
659 powModNatural b e (NatS# m)
660 = NatS# (powModBigNatWord (naturalToBigNat b) (naturalToBigNat e) m)
661 powModNatural b e (NatJ# m)
662 = bigNatToNatural (powModBigNat (naturalToBigNat b) (naturalToBigNat e) m)
663 #else
664 -- Portable reference fallback implementation
665 powModNatural _ _ 0 = divZeroError
666 powModNatural _ _ 1 = 0
667 powModNatural _ 0 _ = 1
668 powModNatural 0 _ _ = 0
669 powModNatural 1 _ _ = 1
670 powModNatural b0 e0 m = go b0 e0 1
671 where
672 go !b e !r
673 | odd e = go b' e' (r*b `mod` m)
674 | e == 0 = r
675 | otherwise = go b' e' r
676 where
677 b' = b*b `mod` m
678 e' = e `unsafeShiftR` 1 -- slightly faster than "e `div` 2"
679 #endif