Fix isValidNatural: The BigNat in NatJ# must have at least 2 limbs
[ghc.git] / libraries / base / GHC / Natural.hs
1 {-# LANGUAGE NoImplicitPrelude #-}
2 {-# LANGUAGE BangPatterns #-}
3 {-# LANGUAGE CPP #-}
4 {-# LANGUAGE MagicHash #-}
5 {-# LANGUAGE UnboxedTuples #-}
6
7 -----------------------------------------------------------------------------
8 -- |
9 -- Module : GHC.Natural
10 -- Copyright : (C) 2014 Herbert Valerio Riedel,
11 -- (C) 2011 Edward Kmett
12 -- License : see libraries/base/LICENSE
13 --
14 -- Maintainer : libraries@haskell.org
15 -- Stability : internal
16 -- Portability : non-portable (GHC Extensions)
17 --
18 -- The arbitrary-precision 'Natural' number type.
19 --
20 -- __Note__: This is an internal GHC module with an API subject to
21 -- change. It's recommended use the "Numeric.Natural" module to import
22 -- the 'Natural' type.
23 --
24 -- @since 4.8.0.0
25 -----------------------------------------------------------------------------
26 module GHC.Natural
27 ( -- * The 'Natural' number type
28 --
29 -- | __Warning__: The internal implementation of 'Natural'
30 -- (i.e. which constructors are available) depends on the
31 -- 'Integer' backend used!
32 Natural(..)
33 , mkNatural
34 , isValidNatural
35 -- * Arithmetic
36 , plusNatural
37 , minusNatural
38 , minusNaturalMaybe
39 , timesNatural
40 , negateNatural
41 , signumNatural
42 , quotRemNatural
43 , quotNatural
44 , remNatural
45 , gcdNatural
46 , lcmNatural
47 -- * Bits
48 , andNatural
49 , orNatural
50 , xorNatural
51 , bitNatural
52 , testBitNatural
53 , popCountNatural
54 , shiftLNatural
55 , shiftRNatural
56 -- * Conversions
57 , naturalToInteger
58 , naturalToWord
59 , naturalToInt
60 , naturalFromInteger
61 , wordToNatural
62 , intToNatural
63 , naturalToWordMaybe
64 , wordToNatural#
65 , wordToNaturalBase
66 -- * Modular arithmetic
67 , powModNatural
68 ) where
69
70 #include "MachDeps.h"
71
72 import GHC.Classes
73 import GHC.Maybe
74 import GHC.Types
75 import GHC.Prim
76 import {-# SOURCE #-} GHC.Exception.Type (underflowException, divZeroException)
77 #if defined(MIN_VERSION_integer_gmp)
78 import GHC.Integer.GMP.Internals
79 #else
80 import GHC.Integer
81 #endif
82
83 default ()
84
85 -- Most high-level operations need to be marked `NOINLINE` as
86 -- otherwise GHC doesn't recognize them and fails to apply constant
87 -- folding to `Natural`-typed expression.
88 --
89 -- To this end, the CPP hack below allows to write the pseudo-pragma
90 --
91 -- {-# CONSTANT_FOLDED plusNatural #-}
92 --
93 -- which is simply expanded into a
94 --
95 -- {-# NOINLINE plusNatural #-}
96 --
97 --
98 -- TODO: Note that some functions have commented CONSTANT_FOLDED annotations,
99 -- that's because the Integer counter-parts of these functions do actually have
100 -- a builtinRule in PrelRules, where the Natural functions do not. The plan is
101 -- to eventually also add builtin rules for those functions on Natural.
102 #define CONSTANT_FOLDED NOINLINE
103
104 -------------------------------------------------------------------------------
105 -- Arithmetic underflow
106 -------------------------------------------------------------------------------
107
108 -- We put them here because they are needed relatively early
109 -- in the libraries before the Exception type has been defined yet.
110
111 {-# NOINLINE underflowError #-}
112 underflowError :: a
113 underflowError = raise# underflowException
114
115 {-# NOINLINE divZeroError #-}
116 divZeroError :: a
117 divZeroError = raise# divZeroException
118
119 -------------------------------------------------------------------------------
120 -- Natural type
121 -------------------------------------------------------------------------------
122
123 #if defined(MIN_VERSION_integer_gmp)
124 -- TODO: if saturated arithmetic is to used, replace 'underflowError' by '0'
125
126 -- | Type representing arbitrary-precision non-negative integers.
127 --
128 -- >>> 2^100 :: Natural
129 -- 1267650600228229401496703205376
130 --
131 -- Operations whose result would be negative @'Control.Exception.throw'
132 -- ('Control.Exception.Underflow' :: 'Control.Exception.ArithException')@,
133 --
134 -- >>> -1 :: Natural
135 -- *** Exception: arithmetic underflow
136 --
137 -- @since 4.8.0.0
138 data Natural = NatS# GmpLimb# -- ^ in @[0, maxBound::Word]@
139 | NatJ# {-# UNPACK #-} !BigNat -- ^ in @]maxBound::Word, +inf[@
140 --
141 -- __Invariant__: 'NatJ#' is used
142 -- /iff/ value doesn't fit in
143 -- 'NatS#' constructor.
144 -- NB: Order of constructors *must*
145 -- coincide with 'Ord' relation
146 deriving ( Eq -- ^ @since 4.8.0.0
147 , Ord -- ^ @since 4.8.0.0
148 )
149
150
151 -- | Test whether all internal invariants are satisfied by 'Natural' value
152 --
153 -- This operation is mostly useful for test-suites and/or code which
154 -- constructs 'Integer' values directly.
155 --
156 -- @since 4.8.0.0
157 isValidNatural :: Natural -> Bool
158 isValidNatural (NatS# _) = True
159 isValidNatural (NatJ# bn) = isTrue# (isValidBigNat# bn)
160 -- A 1-limb BigNat could fit into a NatS#, so we
161 -- require at least 2 limbs.
162 && isTrue# (sizeofBigNat# bn ># 1#)
163
164 signumNatural :: Natural -> Natural
165 signumNatural (NatS# 0##) = NatS# 0##
166 signumNatural _ = NatS# 1##
167 -- {-# CONSTANT_FOLDED signumNatural #-}
168
169 negateNatural :: Natural -> Natural
170 negateNatural (NatS# 0##) = NatS# 0##
171 negateNatural _ = underflowError
172 -- {-# CONSTANT_FOLDED negateNatural #-}
173
174 -- | @since 4.10.0.0
175 naturalFromInteger :: Integer -> Natural
176 naturalFromInteger (S# i#)
177 | isTrue# (i# >=# 0#) = NatS# (int2Word# i#)
178 naturalFromInteger (Jp# bn) = bigNatToNatural bn
179 naturalFromInteger _ = underflowError
180 {-# CONSTANT_FOLDED naturalFromInteger #-}
181
182 -- | Compute greatest common divisor.
183 gcdNatural :: Natural -> Natural -> Natural
184 gcdNatural (NatS# 0##) y = y
185 gcdNatural x (NatS# 0##) = x
186 gcdNatural (NatS# 1##) _ = NatS# 1##
187 gcdNatural _ (NatS# 1##) = NatS# 1##
188 gcdNatural (NatJ# x) (NatJ# y) = bigNatToNatural (gcdBigNat x y)
189 gcdNatural (NatJ# x) (NatS# y) = NatS# (gcdBigNatWord x y)
190 gcdNatural (NatS# x) (NatJ# y) = NatS# (gcdBigNatWord y x)
191 gcdNatural (NatS# x) (NatS# y) = NatS# (gcdWord x y)
192
193 -- | Compute least common multiple.
194 lcmNatural :: Natural -> Natural -> Natural
195 lcmNatural (NatS# 0##) _ = NatS# 0##
196 lcmNatural _ (NatS# 0##) = NatS# 0##
197 lcmNatural (NatS# 1##) y = y
198 lcmNatural x (NatS# 1##) = x
199 lcmNatural x y = (x `quotNatural` (gcdNatural x y)) `timesNatural` y
200
201 ----------------------------------------------------------------------------
202
203 quotRemNatural :: Natural -> Natural -> (Natural, Natural)
204 quotRemNatural _ (NatS# 0##) = divZeroError
205 quotRemNatural n (NatS# 1##) = (n,NatS# 0##)
206 quotRemNatural n@(NatS# _) (NatJ# _) = (NatS# 0##, n)
207 quotRemNatural (NatS# n) (NatS# d) = case quotRemWord# n d of
208 (# q, r #) -> (NatS# q, NatS# r)
209 quotRemNatural (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of
210 (# q, r #) -> (bigNatToNatural q, NatS# r)
211 quotRemNatural (NatJ# n) (NatJ# d) = case quotRemBigNat n d of
212 (# q, r #) -> (bigNatToNatural q, bigNatToNatural r)
213 -- {-# CONSTANT_FOLDED quotRemNatural #-}
214
215 quotNatural :: Natural -> Natural -> Natural
216 quotNatural _ (NatS# 0##) = divZeroError
217 quotNatural n (NatS# 1##) = n
218 quotNatural (NatS# _) (NatJ# _) = NatS# 0##
219 quotNatural (NatS# n) (NatS# d) = NatS# (quotWord# n d)
220 quotNatural (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d)
221 quotNatural (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d)
222 -- {-# CONSTANT_FOLDED quotNatural #-}
223
224 remNatural :: Natural -> Natural -> Natural
225 remNatural _ (NatS# 0##) = divZeroError
226 remNatural _ (NatS# 1##) = NatS# 0##
227 remNatural n@(NatS# _) (NatJ# _) = n
228 remNatural (NatS# n) (NatS# d) = NatS# (remWord# n d)
229 remNatural (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d)
230 remNatural (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d)
231 -- {-# CONSTANT_FOLDED remNatural #-}
232
233 -- | @since 4.X.0.0
234 naturalToInteger :: Natural -> Integer
235 naturalToInteger (NatS# w) = wordToInteger w
236 naturalToInteger (NatJ# bn) = Jp# bn
237 {-# CONSTANT_FOLDED naturalToInteger #-}
238
239 andNatural :: Natural -> Natural -> Natural
240 andNatural (NatS# n) (NatS# m) = NatS# (n `and#` m)
241 andNatural (NatS# n) (NatJ# m) = NatS# (n `and#` bigNatToWord m)
242 andNatural (NatJ# n) (NatS# m) = NatS# (bigNatToWord n `and#` m)
243 andNatural (NatJ# n) (NatJ# m) = bigNatToNatural (andBigNat n m)
244 -- {-# CONSTANT_FOLDED andNatural #-}
245
246 orNatural :: Natural -> Natural -> Natural
247 orNatural (NatS# n) (NatS# m) = NatS# (n `or#` m)
248 orNatural (NatS# n) (NatJ# m) = NatJ# (orBigNat (wordToBigNat n) m)
249 orNatural (NatJ# n) (NatS# m) = NatJ# (orBigNat n (wordToBigNat m))
250 orNatural (NatJ# n) (NatJ# m) = NatJ# (orBigNat n m)
251 -- {-# CONSTANT_FOLDED orNatural #-}
252
253 xorNatural :: Natural -> Natural -> Natural
254 xorNatural (NatS# n) (NatS# m) = NatS# (n `xor#` m)
255 xorNatural (NatS# n) (NatJ# m) = NatJ# (xorBigNat (wordToBigNat n) m)
256 xorNatural (NatJ# n) (NatS# m) = NatJ# (xorBigNat n (wordToBigNat m))
257 xorNatural (NatJ# n) (NatJ# m) = bigNatToNatural (xorBigNat n m)
258 -- {-# CONSTANT_FOLDED xorNatural #-}
259
260 bitNatural :: Int# -> Natural
261 bitNatural i#
262 | isTrue# (i# <# WORD_SIZE_IN_BITS#) = NatS# (1## `uncheckedShiftL#` i#)
263 | True = NatJ# (bitBigNat i#)
264 -- {-# CONSTANT_FOLDED bitNatural #-}
265
266 testBitNatural :: Natural -> Int -> Bool
267 testBitNatural (NatS# w) (I# i#)
268 | isTrue# (i# <# WORD_SIZE_IN_BITS#) =
269 isTrue# ((w `and#` (1## `uncheckedShiftL#` i#)) `neWord#` 0##)
270 | True = False
271 testBitNatural (NatJ# bn) (I# i#) = testBitBigNat bn i#
272 -- {-# CONSTANT_FOLDED testBitNatural #-}
273
274 popCountNatural :: Natural -> Int
275 popCountNatural (NatS# w) = I# (word2Int# (popCnt# w))
276 popCountNatural (NatJ# bn) = I# (popCountBigNat bn)
277 -- {-# CONSTANT_FOLDED popCountNatural #-}
278
279 shiftLNatural :: Natural -> Int -> Natural
280 shiftLNatural n (I# 0#) = n
281 shiftLNatural (NatS# 0##) _ = NatS# 0##
282 shiftLNatural (NatS# 1##) (I# i#) = bitNatural i#
283 shiftLNatural (NatS# w) (I# i#)
284 = bigNatToNatural (shiftLBigNat (wordToBigNat w) i#)
285 shiftLNatural (NatJ# bn) (I# i#)
286 = bigNatToNatural (shiftLBigNat bn i#)
287 -- {-# CONSTANT_FOLDED shiftLNatural #-}
288
289 shiftRNatural :: Natural -> Int -> Natural
290 shiftRNatural n (I# 0#) = n
291 shiftRNatural (NatS# w) (I# i#)
292 | isTrue# (i# >=# WORD_SIZE_IN_BITS#) = NatS# 0##
293 | True = NatS# (w `uncheckedShiftRL#` i#)
294 shiftRNatural (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#)
295 -- {-# CONSTANT_FOLDED shiftRNatural #-}
296
297 ----------------------------------------------------------------------------
298
299 -- | 'Natural' Addition
300 plusNatural :: Natural -> Natural -> Natural
301 plusNatural (NatS# 0##) y = y
302 plusNatural x (NatS# 0##) = x
303 plusNatural (NatS# x) (NatS# y)
304 = case plusWord2# x y of
305 (# 0##, l #) -> NatS# l
306 (# h, l #) -> NatJ# (wordToBigNat2 h l)
307 plusNatural (NatS# x) (NatJ# y) = NatJ# (plusBigNatWord y x)
308 plusNatural (NatJ# x) (NatS# y) = NatJ# (plusBigNatWord x y)
309 plusNatural (NatJ# x) (NatJ# y) = NatJ# (plusBigNat x y)
310 {-# CONSTANT_FOLDED plusNatural #-}
311
312 -- | 'Natural' multiplication
313 timesNatural :: Natural -> Natural -> Natural
314 timesNatural _ (NatS# 0##) = NatS# 0##
315 timesNatural (NatS# 0##) _ = NatS# 0##
316 timesNatural x (NatS# 1##) = x
317 timesNatural (NatS# 1##) y = y
318 timesNatural (NatS# x) (NatS# y) = case timesWord2# x y of
319 (# 0##, 0## #) -> NatS# 0##
320 (# 0##, xy #) -> NatS# xy
321 (# h , l #) -> NatJ# (wordToBigNat2 h l)
322 timesNatural (NatS# x) (NatJ# y) = NatJ# (timesBigNatWord y x)
323 timesNatural (NatJ# x) (NatS# y) = NatJ# (timesBigNatWord x y)
324 timesNatural (NatJ# x) (NatJ# y) = NatJ# (timesBigNat x y)
325 {-# CONSTANT_FOLDED timesNatural #-}
326
327 -- | 'Natural' subtraction. May @'Control.Exception.throw'
328 -- 'Control.Exception.Underflow'@.
329 minusNatural :: Natural -> Natural -> Natural
330 minusNatural x (NatS# 0##) = x
331 minusNatural (NatS# x) (NatS# y) = case subWordC# x y of
332 (# l, 0# #) -> NatS# l
333 _ -> underflowError
334 minusNatural (NatS# _) (NatJ# _) = underflowError
335 minusNatural (NatJ# x) (NatS# y)
336 = bigNatToNatural (minusBigNatWord x y)
337 minusNatural (NatJ# x) (NatJ# y)
338 = bigNatToNatural (minusBigNat x y)
339 {-# CONSTANT_FOLDED minusNatural #-}
340
341 -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.
342 --
343 -- @since 4.8.0.0
344 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
345 minusNaturalMaybe x (NatS# 0##) = Just x
346 minusNaturalMaybe (NatS# x) (NatS# y) = case subWordC# x y of
347 (# l, 0# #) -> Just (NatS# l)
348 _ -> Nothing
349 minusNaturalMaybe (NatS# _) (NatJ# _) = Nothing
350 minusNaturalMaybe (NatJ# x) (NatS# y)
351 = Just (bigNatToNatural (minusBigNatWord x y))
352 minusNaturalMaybe (NatJ# x) (NatJ# y)
353 | isTrue# (isNullBigNat# res) = Nothing
354 | True = Just (bigNatToNatural res)
355 where
356 res = minusBigNat x y
357
358 -- | Convert 'BigNat' to 'Natural'.
359 -- Throws 'Control.Exception.Underflow' if passed a 'nullBigNat'.
360 bigNatToNatural :: BigNat -> Natural
361 bigNatToNatural bn
362 | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)
363 | isTrue# (isNullBigNat# bn) = underflowError
364 | True = NatJ# bn
365
366 naturalToBigNat :: Natural -> BigNat
367 naturalToBigNat (NatS# w#) = wordToBigNat w#
368 naturalToBigNat (NatJ# bn) = bn
369
370 naturalToWord :: Natural -> Word
371 naturalToWord (NatS# w#) = W# w#
372 naturalToWord (NatJ# bn) = W# (bigNatToWord bn)
373
374 naturalToInt :: Natural -> Int
375 naturalToInt (NatS# w#) = I# (word2Int# w#)
376 naturalToInt (NatJ# bn) = I# (bigNatToInt bn)
377
378 ----------------------------------------------------------------------------
379
380 -- | Convert a Word# into a Natural
381 --
382 -- Built-in rule ensures that applications of this function to literal Word# are
383 -- lifted into Natural literals.
384 wordToNatural# :: Word# -> Natural
385 wordToNatural# w# = NatS# w#
386 {-# CONSTANT_FOLDED wordToNatural# #-}
387
388 -- | Convert a Word# into a Natural
389 --
390 -- In base we can't use wordToNatural# as built-in rules transform some of them
391 -- into Natural literals. Use this function instead.
392 wordToNaturalBase :: Word# -> Natural
393 wordToNaturalBase w# = NatS# w#
394
395 #else /* !defined(MIN_VERSION_integer_gmp) */
396 ----------------------------------------------------------------------------
397 -- Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package
398
399 -- | Type representing arbitrary-precision non-negative integers.
400 --
401 -- Operations whose result would be negative @'Control.Exception.throw'
402 -- ('Control.Exception.Underflow' :: 'Control.Exception.ArithException')@.
403 --
404 -- @since 4.8.0.0
405 newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer'
406 deriving (Eq,Ord)
407
408
409 -- | Test whether all internal invariants are satisfied by 'Natural' value
410 --
411 -- This operation is mostly useful for test-suites and/or code which
412 -- constructs 'Natural' values directly.
413 --
414 -- @since 4.8.0.0
415 isValidNatural :: Natural -> Bool
416 isValidNatural (Natural i) = i >= wordToInteger 0##
417
418 -- | Convert a 'Word#' into a 'Natural'
419 --
420 -- Built-in rule ensures that applications of this function to literal 'Word#'
421 -- are lifted into 'Natural' literals.
422 wordToNatural# :: Word# -> Natural
423 wordToNatural# w## = Natural (wordToInteger w##)
424 {-# CONSTANT_FOLDED wordToNatural# #-}
425
426 -- | Convert a 'Word#' into a Natural
427 --
428 -- In base we can't use wordToNatural# as built-in rules transform some of them
429 -- into Natural literals. Use this function instead.
430 wordToNaturalBase :: Word# -> Natural
431 wordToNaturalBase w## = Natural (wordToInteger w##)
432
433 -- | @since 4.10.0.0
434 naturalFromInteger :: Integer -> Natural
435 naturalFromInteger n
436 | n >= wordToInteger 0## = Natural n
437 | True = underflowError
438 {-# INLINE naturalFromInteger #-}
439
440
441 -- | Compute greatest common divisor.
442 gcdNatural :: Natural -> Natural -> Natural
443 gcdNatural (Natural n) (Natural m) = Natural (n `gcdInteger` m)
444
445 -- | Compute lowest common multiple.
446 lcmNatural :: Natural -> Natural -> Natural
447 lcmNatural (Natural n) (Natural m) = Natural (n `lcmInteger` m)
448
449 -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.
450 --
451 -- @since 4.8.0.0
452 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
453 minusNaturalMaybe (Natural x) (Natural y)
454 | x >= y = Just (Natural (x `minusInteger` y))
455 | True = Nothing
456
457 shiftLNatural :: Natural -> Int -> Natural
458 shiftLNatural (Natural n) (I# i) = Natural (n `shiftLInteger` i)
459 -- {-# CONSTANT_FOLDED shiftLNatural #-}
460
461 shiftRNatural :: Natural -> Int -> Natural
462 shiftRNatural (Natural n) (I# i) = Natural (n `shiftRInteger` i)
463 -- {-# CONSTANT_FOLDED shiftRNatural #-}
464
465 plusNatural :: Natural -> Natural -> Natural
466 plusNatural (Natural x) (Natural y) = Natural (x `plusInteger` y)
467 {-# CONSTANT_FOLDED plusNatural #-}
468
469 minusNatural :: Natural -> Natural -> Natural
470 minusNatural (Natural x) (Natural y)
471 = if z `ltInteger` wordToInteger 0## then underflowError else Natural z
472 where z = x `minusInteger` y
473 {-# CONSTANT_FOLDED minusNatural #-}
474
475 timesNatural :: Natural -> Natural -> Natural
476 timesNatural (Natural x) (Natural y) = Natural (x `timesInteger` y)
477 {-# CONSTANT_FOLDED timesNatural #-}
478
479 orNatural :: Natural -> Natural -> Natural
480 orNatural (Natural x) (Natural y) = Natural (x `orInteger` y)
481 -- {-# CONSTANT_FOLDED orNatural #-}
482
483 xorNatural :: Natural -> Natural -> Natural
484 xorNatural (Natural x) (Natural y) = Natural (x `xorInteger` y)
485 -- {-# CONSTANT_FOLDED xorNatural #-}
486
487 andNatural :: Natural -> Natural -> Natural
488 andNatural (Natural x) (Natural y) = Natural (x `andInteger` y)
489 -- {-# CONSTANT_FOLDED andNatural #-}
490
491 naturalToInt :: Natural -> Int
492 naturalToInt (Natural i) = I# (integerToInt i)
493
494 naturalToWord :: Natural -> Word
495 naturalToWord (Natural i) = W# (integerToWord i)
496
497 naturalToInteger :: Natural -> Integer
498 naturalToInteger (Natural i) = i
499 {-# CONSTANT_FOLDED naturalToInteger #-}
500
501 testBitNatural :: Natural -> Int -> Bool
502 testBitNatural (Natural n) (I# i) = testBitInteger n i
503 -- {-# CONSTANT_FOLDED testBitNatural #-}
504
505 popCountNatural :: Natural -> Int
506 popCountNatural (Natural n) = I# (popCountInteger n)
507
508 bitNatural :: Int# -> Natural
509 bitNatural i#
510 | isTrue# (i# <# WORD_SIZE_IN_BITS#) = wordToNaturalBase (1## `uncheckedShiftL#` i#)
511 | True = Natural (1 `shiftLInteger` i#)
512 -- {-# CONSTANT_FOLDED bitNatural #-}
513
514 quotNatural :: Natural -> Natural -> Natural
515 quotNatural n@(Natural x) (Natural y)
516 | y == wordToInteger 0## = divZeroError
517 | y == wordToInteger 1## = n
518 | True = Natural (x `quotInteger` y)
519 -- {-# CONSTANT_FOLDED quotNatural #-}
520
521 remNatural :: Natural -> Natural -> Natural
522 remNatural (Natural x) (Natural y)
523 | y == wordToInteger 0## = divZeroError
524 | y == wordToInteger 1## = wordToNaturalBase 0##
525 | True = Natural (x `remInteger` y)
526 -- {-# CONSTANT_FOLDED remNatural #-}
527
528 quotRemNatural :: Natural -> Natural -> (Natural, Natural)
529 quotRemNatural n@(Natural x) (Natural y)
530 | y == wordToInteger 0## = divZeroError
531 | y == wordToInteger 1## = (n,wordToNaturalBase 0##)
532 | True = case quotRemInteger x y of
533 (# k, r #) -> (Natural k, Natural r)
534 -- {-# CONSTANT_FOLDED quotRemNatural #-}
535
536 signumNatural :: Natural -> Natural
537 signumNatural (Natural x)
538 | x == wordToInteger 0## = wordToNaturalBase 0##
539 | True = wordToNaturalBase 1##
540 -- {-# CONSTANT_FOLDED signumNatural #-}
541
542 negateNatural :: Natural -> Natural
543 negateNatural (Natural x)
544 | x == wordToInteger 0## = wordToNaturalBase 0##
545 | True = underflowError
546 -- {-# CONSTANT_FOLDED negateNatural #-}
547
548 #endif
549
550 -- | Construct 'Natural' from 'Word' value.
551 --
552 -- @since 4.8.0.0
553 wordToNatural :: Word -> Natural
554 wordToNatural (W# w#) = wordToNatural# w#
555
556 -- | Try downcasting 'Natural' to 'Word' value.
557 -- Returns 'Nothing' if value doesn't fit in 'Word'.
558 --
559 -- @since 4.8.0.0
560 naturalToWordMaybe :: Natural -> Maybe Word
561 #if defined(MIN_VERSION_integer_gmp)
562 naturalToWordMaybe (NatS# w#) = Just (W# w#)
563 naturalToWordMaybe (NatJ# _) = Nothing
564 #else
565 naturalToWordMaybe (Natural i)
566 | i < maxw = Just (W# (integerToWord i))
567 | True = Nothing
568 where
569 maxw = 1 `shiftLInteger` WORD_SIZE_IN_BITS#
570 #endif
571
572 -- | \"@'powModNatural' /b/ /e/ /m/@\" computes base @/b/@ raised to
573 -- exponent @/e/@ modulo @/m/@.
574 --
575 -- @since 4.8.0.0
576 powModNatural :: Natural -> Natural -> Natural -> Natural
577 #if defined(MIN_VERSION_integer_gmp)
578 powModNatural _ _ (NatS# 0##) = divZeroError
579 powModNatural _ _ (NatS# 1##) = NatS# 0##
580 powModNatural _ (NatS# 0##) _ = NatS# 1##
581 powModNatural (NatS# 0##) _ _ = NatS# 0##
582 powModNatural (NatS# 1##) _ _ = NatS# 1##
583 powModNatural (NatS# b) (NatS# e) (NatS# m) = NatS# (powModWord b e m)
584 powModNatural b e (NatS# m)
585 = NatS# (powModBigNatWord (naturalToBigNat b) (naturalToBigNat e) m)
586 powModNatural b e (NatJ# m)
587 = bigNatToNatural (powModBigNat (naturalToBigNat b) (naturalToBigNat e) m)
588 #else
589 -- Portable reference fallback implementation
590 powModNatural (Natural b0) (Natural e0) (Natural m)
591 | m == wordToInteger 0## = divZeroError
592 | m == wordToInteger 1## = wordToNaturalBase 0##
593 | e0 == wordToInteger 0## = wordToNaturalBase 1##
594 | b0 == wordToInteger 0## = wordToNaturalBase 0##
595 | b0 == wordToInteger 1## = wordToNaturalBase 1##
596 | True = go b0 e0 (wordToInteger 1##)
597 where
598 go !b e !r
599 | e `testBitInteger` 0# = go b' e' ((r `timesInteger` b) `modInteger` m)
600 | e == wordToInteger 0## = naturalFromInteger r
601 | True = go b' e' r
602 where
603 b' = (b `timesInteger` b) `modInteger` m
604 e' = e `shiftRInteger` 1# -- slightly faster than "e `div` 2"
605 #endif
606
607
608 -- | Construct 'Natural' value from list of 'Word's.
609 --
610 -- This function is used by GHC for constructing 'Natural' literals.
611 mkNatural :: [Word] -- ^ value expressed in 32 bit chunks, least
612 -- significant first
613 -> Natural
614 mkNatural [] = wordToNaturalBase 0##
615 mkNatural (W# i : is') = wordToNaturalBase (i `and#` 0xffffffff##) `orNatural`
616 shiftLNatural (mkNatural is') 32
617 {-# CONSTANT_FOLDED mkNatural #-}
618
619 -- | Convert 'Int' to 'Natural'.
620 -- Throws 'Control.Exception.Underflow' when passed a negative 'Int'.
621 intToNatural :: Int -> Natural
622 intToNatural (I# i#)
623 | isTrue# (i# <# 0#) = underflowError
624 | True = wordToNaturalBase (int2Word# i#)