Remove from `base` obsolete CPP for `integer-gmp`
[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 function 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 && isTrue# (sizeofBigNat# bn ># 0#)
161
162 signumNatural :: Natural -> Natural
163 signumNatural (NatS# 0##) = NatS# 0##
164 signumNatural _ = NatS# 1##
165 -- {-# CONSTANT_FOLDED signumNatural #-}
166
167 negateNatural :: Natural -> Natural
168 negateNatural (NatS# 0##) = NatS# 0##
169 negateNatural _ = underflowError
170 -- {-# CONSTANT_FOLDED negateNatural #-}
171
172 -- | @since 4.10.0.0
173 naturalFromInteger :: Integer -> Natural
174 naturalFromInteger (S# i#)
175 | isTrue# (i# >=# 0#) = NatS# (int2Word# i#)
176 naturalFromInteger (Jp# bn) = bigNatToNatural bn
177 naturalFromInteger _ = underflowError
178 {-# CONSTANT_FOLDED naturalFromInteger #-}
179
180 -- | Compute greatest common divisor.
181 gcdNatural :: Natural -> Natural -> Natural
182 gcdNatural (NatS# 0##) y = y
183 gcdNatural x (NatS# 0##) = x
184 gcdNatural (NatS# 1##) _ = NatS# 1##
185 gcdNatural _ (NatS# 1##) = NatS# 1##
186 gcdNatural (NatJ# x) (NatJ# y) = bigNatToNatural (gcdBigNat x y)
187 gcdNatural (NatJ# x) (NatS# y) = NatS# (gcdBigNatWord x y)
188 gcdNatural (NatS# x) (NatJ# y) = NatS# (gcdBigNatWord y x)
189 gcdNatural (NatS# x) (NatS# y) = NatS# (gcdWord x y)
190
191 -- | compute least common multiplier.
192 lcmNatural :: Natural -> Natural -> Natural
193 lcmNatural (NatS# 0##) _ = NatS# 0##
194 lcmNatural _ (NatS# 0##) = NatS# 0##
195 lcmNatural (NatS# 1##) y = y
196 lcmNatural x (NatS# 1##) = x
197 lcmNatural x y = (x `quotNatural` (gcdNatural x y)) `timesNatural` y
198
199 ----------------------------------------------------------------------------
200
201 quotRemNatural :: Natural -> Natural -> (Natural, Natural)
202 quotRemNatural _ (NatS# 0##) = divZeroError
203 quotRemNatural n (NatS# 1##) = (n,NatS# 0##)
204 quotRemNatural n@(NatS# _) (NatJ# _) = (NatS# 0##, n)
205 quotRemNatural (NatS# n) (NatS# d) = case quotRemWord# n d of
206 (# q, r #) -> (NatS# q, NatS# r)
207 quotRemNatural (NatJ# n) (NatS# d) = case quotRemBigNatWord n d of
208 (# q, r #) -> (bigNatToNatural q, NatS# r)
209 quotRemNatural (NatJ# n) (NatJ# d) = case quotRemBigNat n d of
210 (# q, r #) -> (bigNatToNatural q, bigNatToNatural r)
211 -- {-# CONSTANT_FOLDED quotRemNatural #-}
212
213 quotNatural :: Natural -> Natural -> Natural
214 quotNatural _ (NatS# 0##) = divZeroError
215 quotNatural n (NatS# 1##) = n
216 quotNatural (NatS# _) (NatJ# _) = NatS# 0##
217 quotNatural (NatS# n) (NatS# d) = NatS# (quotWord# n d)
218 quotNatural (NatJ# n) (NatS# d) = bigNatToNatural (quotBigNatWord n d)
219 quotNatural (NatJ# n) (NatJ# d) = bigNatToNatural (quotBigNat n d)
220 -- {-# CONSTANT_FOLDED quotNatural #-}
221
222 remNatural :: Natural -> Natural -> Natural
223 remNatural _ (NatS# 0##) = divZeroError
224 remNatural _ (NatS# 1##) = NatS# 0##
225 remNatural n@(NatS# _) (NatJ# _) = n
226 remNatural (NatS# n) (NatS# d) = NatS# (remWord# n d)
227 remNatural (NatJ# n) (NatS# d) = NatS# (remBigNatWord n d)
228 remNatural (NatJ# n) (NatJ# d) = bigNatToNatural (remBigNat n d)
229 -- {-# CONSTANT_FOLDED remNatural #-}
230
231 -- | @since 4.X.0.0
232 naturalToInteger :: Natural -> Integer
233 naturalToInteger (NatS# w) = wordToInteger w
234 naturalToInteger (NatJ# bn) = Jp# bn
235 {-# CONSTANT_FOLDED naturalToInteger #-}
236
237 andNatural :: Natural -> Natural -> Natural
238 andNatural (NatS# n) (NatS# m) = NatS# (n `and#` m)
239 andNatural (NatS# n) (NatJ# m) = NatS# (n `and#` bigNatToWord m)
240 andNatural (NatJ# n) (NatS# m) = NatS# (bigNatToWord n `and#` m)
241 andNatural (NatJ# n) (NatJ# m) = bigNatToNatural (andBigNat n m)
242 -- {-# CONSTANT_FOLDED andNatural #-}
243
244 orNatural :: Natural -> Natural -> Natural
245 orNatural (NatS# n) (NatS# m) = NatS# (n `or#` m)
246 orNatural (NatS# n) (NatJ# m) = NatJ# (orBigNat (wordToBigNat n) m)
247 orNatural (NatJ# n) (NatS# m) = NatJ# (orBigNat n (wordToBigNat m))
248 orNatural (NatJ# n) (NatJ# m) = NatJ# (orBigNat n m)
249 -- {-# CONSTANT_FOLDED orNatural #-}
250
251 xorNatural :: Natural -> Natural -> Natural
252 xorNatural (NatS# n) (NatS# m) = NatS# (n `xor#` m)
253 xorNatural (NatS# n) (NatJ# m) = NatJ# (xorBigNat (wordToBigNat n) m)
254 xorNatural (NatJ# n) (NatS# m) = NatJ# (xorBigNat n (wordToBigNat m))
255 xorNatural (NatJ# n) (NatJ# m) = bigNatToNatural (xorBigNat n m)
256 -- {-# CONSTANT_FOLDED xorNatural #-}
257
258 bitNatural :: Int# -> Natural
259 bitNatural i#
260 | isTrue# (i# <# WORD_SIZE_IN_BITS#) = NatS# (1## `uncheckedShiftL#` i#)
261 | True = NatJ# (bitBigNat i#)
262 -- {-# CONSTANT_FOLDED bitNatural #-}
263
264 testBitNatural :: Natural -> Int -> Bool
265 testBitNatural (NatS# w) (I# i#)
266 | isTrue# (i# <# WORD_SIZE_IN_BITS#) =
267 isTrue# ((w `and#` (1## `uncheckedShiftL#` i#)) `neWord#` 0##)
268 | True = False
269 testBitNatural (NatJ# bn) (I# i#) = testBitBigNat bn i#
270 -- {-# CONSTANT_FOLDED testBitNatural #-}
271
272 popCountNatural :: Natural -> Int
273 popCountNatural (NatS# w) = I# (word2Int# (popCnt# w))
274 popCountNatural (NatJ# bn) = I# (popCountBigNat bn)
275 -- {-# CONSTANT_FOLDED popCountNatural #-}
276
277 shiftLNatural :: Natural -> Int -> Natural
278 shiftLNatural n (I# 0#) = n
279 shiftLNatural (NatS# 0##) _ = NatS# 0##
280 shiftLNatural (NatS# 1##) (I# i#) = bitNatural i#
281 shiftLNatural (NatS# w) (I# i#)
282 = bigNatToNatural (shiftLBigNat (wordToBigNat w) i#)
283 shiftLNatural (NatJ# bn) (I# i#)
284 = bigNatToNatural (shiftLBigNat bn i#)
285 -- {-# CONSTANT_FOLDED shiftLNatural #-}
286
287 shiftRNatural :: Natural -> Int -> Natural
288 shiftRNatural n (I# 0#) = n
289 shiftRNatural (NatS# w) (I# i#)
290 | isTrue# (i# >=# WORD_SIZE_IN_BITS#) = NatS# 0##
291 | True = NatS# (w `uncheckedShiftRL#` i#)
292 shiftRNatural (NatJ# bn) (I# i#) = bigNatToNatural (shiftRBigNat bn i#)
293 -- {-# CONSTANT_FOLDED shiftRNatural #-}
294
295 ----------------------------------------------------------------------------
296
297 -- | 'Natural' Addition
298 plusNatural :: Natural -> Natural -> Natural
299 plusNatural (NatS# 0##) y = y
300 plusNatural x (NatS# 0##) = x
301 plusNatural (NatS# x) (NatS# y)
302 = case plusWord2# x y of
303 (# 0##, l #) -> NatS# l
304 (# h, l #) -> NatJ# (wordToBigNat2 h l)
305 plusNatural (NatS# x) (NatJ# y) = NatJ# (plusBigNatWord y x)
306 plusNatural (NatJ# x) (NatS# y) = NatJ# (plusBigNatWord x y)
307 plusNatural (NatJ# x) (NatJ# y) = NatJ# (plusBigNat x y)
308 {-# CONSTANT_FOLDED plusNatural #-}
309
310 -- | 'Natural' multiplication
311 timesNatural :: Natural -> Natural -> Natural
312 timesNatural _ (NatS# 0##) = NatS# 0##
313 timesNatural (NatS# 0##) _ = NatS# 0##
314 timesNatural x (NatS# 1##) = x
315 timesNatural (NatS# 1##) y = y
316 timesNatural (NatS# x) (NatS# y) = case timesWord2# x y of
317 (# 0##, 0## #) -> NatS# 0##
318 (# 0##, xy #) -> NatS# xy
319 (# h , l #) -> NatJ# (wordToBigNat2 h l)
320 timesNatural (NatS# x) (NatJ# y) = NatJ# (timesBigNatWord y x)
321 timesNatural (NatJ# x) (NatS# y) = NatJ# (timesBigNatWord x y)
322 timesNatural (NatJ# x) (NatJ# y) = NatJ# (timesBigNat x y)
323 {-# CONSTANT_FOLDED timesNatural #-}
324
325 -- | 'Natural' subtraction. May @'Control.Exception.throw'
326 -- 'Control.Exception.Underflow'@.
327 minusNatural :: Natural -> Natural -> Natural
328 minusNatural x (NatS# 0##) = x
329 minusNatural (NatS# x) (NatS# y) = case subWordC# x y of
330 (# l, 0# #) -> NatS# l
331 _ -> underflowError
332 minusNatural (NatS# _) (NatJ# _) = underflowError
333 minusNatural (NatJ# x) (NatS# y)
334 = bigNatToNatural (minusBigNatWord x y)
335 minusNatural (NatJ# x) (NatJ# y)
336 = bigNatToNatural (minusBigNat x y)
337 {-# CONSTANT_FOLDED minusNatural #-}
338
339 -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.
340 --
341 -- @since 4.8.0.0
342 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
343 minusNaturalMaybe x (NatS# 0##) = Just x
344 minusNaturalMaybe (NatS# x) (NatS# y) = case subWordC# x y of
345 (# l, 0# #) -> Just (NatS# l)
346 _ -> Nothing
347 minusNaturalMaybe (NatS# _) (NatJ# _) = Nothing
348 minusNaturalMaybe (NatJ# x) (NatS# y)
349 = Just (bigNatToNatural (minusBigNatWord x y))
350 minusNaturalMaybe (NatJ# x) (NatJ# y)
351 | isTrue# (isNullBigNat# res) = Nothing
352 | True = Just (bigNatToNatural res)
353 where
354 res = minusBigNat x y
355
356 -- | Convert 'BigNat' to 'Natural'.
357 -- Throws 'Control.Exception.Underflow' if passed a 'nullBigNat'.
358 bigNatToNatural :: BigNat -> Natural
359 bigNatToNatural bn
360 | isTrue# (sizeofBigNat# bn ==# 1#) = NatS# (bigNatToWord bn)
361 | isTrue# (isNullBigNat# bn) = underflowError
362 | True = NatJ# bn
363
364 naturalToBigNat :: Natural -> BigNat
365 naturalToBigNat (NatS# w#) = wordToBigNat w#
366 naturalToBigNat (NatJ# bn) = bn
367
368 naturalToWord :: Natural -> Word
369 naturalToWord (NatS# w#) = W# w#
370 naturalToWord (NatJ# bn) = W# (bigNatToWord bn)
371
372 naturalToInt :: Natural -> Int
373 naturalToInt (NatS# w#) = I# (word2Int# w#)
374 naturalToInt (NatJ# bn) = I# (bigNatToInt bn)
375
376 ----------------------------------------------------------------------------
377
378 -- | Convert a Word# into a Natural
379 --
380 -- Built-in rule ensures that applications of this function to literal Word# are
381 -- lifted into Natural literals.
382 wordToNatural# :: Word# -> Natural
383 wordToNatural# w# = NatS# w#
384 {-# CONSTANT_FOLDED wordToNatural# #-}
385
386 -- | Convert a Word# into a Natural
387 --
388 -- In base we can't use wordToNatural# as built-in rules transform some of them
389 -- into Natural literals. Use this function instead.
390 wordToNaturalBase :: Word# -> Natural
391 wordToNaturalBase w# = NatS# w#
392
393 #else /* !defined(MIN_VERSION_integer_gmp) */
394 ----------------------------------------------------------------------------
395 -- Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package
396
397 -- | Type representing arbitrary-precision non-negative integers.
398 --
399 -- Operations whose result would be negative @'Control.Exception.throw'
400 -- ('Control.Exception.Underflow' :: 'Control.Exception.ArithException')@.
401 --
402 -- @since 4.8.0.0
403 newtype Natural = Natural Integer -- ^ __Invariant__: non-negative 'Integer'
404 deriving (Eq,Ord)
405
406
407 -- | Test whether all internal invariants are satisfied by 'Natural' value
408 --
409 -- This operation is mostly useful for test-suites and/or code which
410 -- constructs 'Natural' values directly.
411 --
412 -- @since 4.8.0.0
413 isValidNatural :: Natural -> Bool
414 isValidNatural (Natural i) = i >= wordToInteger 0##
415
416 -- | Convert a 'Word#' into a 'Natural'
417 --
418 -- Built-in rule ensures that applications of this function to literal 'Word#'
419 -- are lifted into 'Natural' literals.
420 wordToNatural# :: Word# -> Natural
421 wordToNatural# w## = Natural (wordToInteger w##)
422 {-# CONSTANT_FOLDED wordToNatural# #-}
423
424 -- | Convert a 'Word#' into a Natural
425 --
426 -- In base we can't use wordToNatural# as built-in rules transform some of them
427 -- into Natural literals. Use this function instead.
428 wordToNaturalBase :: Word# -> Natural
429 wordToNaturalBase w## = Natural (wordToInteger w##)
430
431 -- | @since 4.10.0.0
432 naturalFromInteger :: Integer -> Natural
433 naturalFromInteger n
434 | n >= wordToInteger 0## = Natural n
435 | True = underflowError
436 {-# INLINE naturalFromInteger #-}
437
438
439 -- | Compute greatest common divisor.
440 gcdNatural :: Natural -> Natural -> Natural
441 gcdNatural (Natural n) (Natural m) = Natural (n `gcdInteger` m)
442
443 -- | Compute lowest common multiple.
444 lcmNatural :: Natural -> Natural -> Natural
445 lcmNatural (Natural n) (Natural m) = Natural (n `lcmInteger` m)
446
447 -- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.
448 --
449 -- @since 4.8.0.0
450 minusNaturalMaybe :: Natural -> Natural -> Maybe Natural
451 minusNaturalMaybe (Natural x) (Natural y)
452 | x >= y = Just (Natural (x `minusInteger` y))
453 | True = Nothing
454
455 shiftLNatural :: Natural -> Int -> Natural
456 shiftLNatural (Natural n) (I# i) = Natural (n `shiftLInteger` i)
457 -- {-# CONSTANT_FOLDED shiftLNatural #-}
458
459 shiftRNatural :: Natural -> Int -> Natural
460 shiftRNatural (Natural n) (I# i) = Natural (n `shiftRInteger` i)
461 -- {-# CONSTANT_FOLDED shiftRNatural #-}
462
463 plusNatural :: Natural -> Natural -> Natural
464 plusNatural (Natural x) (Natural y) = Natural (x `plusInteger` y)
465 {-# CONSTANT_FOLDED plusNatural #-}
466
467 minusNatural :: Natural -> Natural -> Natural
468 minusNatural (Natural x) (Natural y)
469 = if z `ltInteger` wordToInteger 0## then underflowError else Natural z
470 where z = x `minusInteger` y
471 {-# CONSTANT_FOLDED minusNatural #-}
472
473 timesNatural :: Natural -> Natural -> Natural
474 timesNatural (Natural x) (Natural y) = Natural (x `timesInteger` y)
475 {-# CONSTANT_FOLDED timesNatural #-}
476
477 orNatural :: Natural -> Natural -> Natural
478 orNatural (Natural x) (Natural y) = Natural (x `orInteger` y)
479 -- {-# CONSTANT_FOLDED orNatural #-}
480
481 xorNatural :: Natural -> Natural -> Natural
482 xorNatural (Natural x) (Natural y) = Natural (x `xorInteger` y)
483 -- {-# CONSTANT_FOLDED xorNatural #-}
484
485 andNatural :: Natural -> Natural -> Natural
486 andNatural (Natural x) (Natural y) = Natural (x `andInteger` y)
487 -- {-# CONSTANT_FOLDED andNatural #-}
488
489 naturalToInt :: Natural -> Int
490 naturalToInt (Natural i) = I# (integerToInt i)
491
492 naturalToWord :: Natural -> Word
493 naturalToWord (Natural i) = W# (integerToWord i)
494
495 naturalToInteger :: Natural -> Integer
496 naturalToInteger (Natural i) = i
497 {-# CONSTANT_FOLDED naturalToInteger #-}
498
499 testBitNatural :: Natural -> Int -> Bool
500 testBitNatural (Natural n) (I# i) = testBitInteger n i
501 -- {-# CONSTANT_FOLDED testBitNatural #-}
502
503 popCountNatural :: Natural -> Int
504 popCountNatural (Natural n) = I# (popCountInteger n)
505
506 bitNatural :: Int# -> Natural
507 bitNatural i#
508 | isTrue# (i# <# WORD_SIZE_IN_BITS#) = wordToNaturalBase (1## `uncheckedShiftL#` i#)
509 | True = Natural (1 `shiftLInteger` i#)
510 -- {-# CONSTANT_FOLDED bitNatural #-}
511
512 quotNatural :: Natural -> Natural -> Natural
513 quotNatural n@(Natural x) (Natural y)
514 | y == wordToInteger 0## = divZeroError
515 | y == wordToInteger 1## = n
516 | True = Natural (x `quotInteger` y)
517 -- {-# CONSTANT_FOLDED quotNatural #-}
518
519 remNatural :: Natural -> Natural -> Natural
520 remNatural (Natural x) (Natural y)
521 | y == wordToInteger 0## = divZeroError
522 | y == wordToInteger 1## = wordToNaturalBase 0##
523 | True = Natural (x `remInteger` y)
524 -- {-# CONSTANT_FOLDED remNatural #-}
525
526 quotRemNatural :: Natural -> Natural -> (Natural, Natural)
527 quotRemNatural n@(Natural x) (Natural y)
528 | y == wordToInteger 0## = divZeroError
529 | y == wordToInteger 1## = (n,wordToNaturalBase 0##)
530 | True = case quotRemInteger x y of
531 (# k, r #) -> (Natural k, Natural r)
532 -- {-# CONSTANT_FOLDED quotRemNatural #-}
533
534 signumNatural :: Natural -> Natural
535 signumNatural (Natural x)
536 | x == wordToInteger 0## = wordToNaturalBase 0##
537 | True = wordToNaturalBase 1##
538 -- {-# CONSTANT_FOLDED signumNatural #-}
539
540 negateNatural :: Natural -> Natural
541 negateNatural (Natural x)
542 | x == wordToInteger 0## = wordToNaturalBase 0##
543 | True = underflowError
544 -- {-# CONSTANT_FOLDED negateNatural #-}
545
546 #endif
547
548 -- | Construct 'Natural' from 'Word' value.
549 --
550 -- @since 4.8.0.0
551 wordToNatural :: Word -> Natural
552 wordToNatural (W# w#) = wordToNatural# w#
553
554 -- | Try downcasting 'Natural' to 'Word' value.
555 -- Returns 'Nothing' if value doesn't fit in 'Word'.
556 --
557 -- @since 4.8.0.0
558 naturalToWordMaybe :: Natural -> Maybe Word
559 #if defined(MIN_VERSION_integer_gmp)
560 naturalToWordMaybe (NatS# w#) = Just (W# w#)
561 naturalToWordMaybe (NatJ# _) = Nothing
562 #else
563 naturalToWordMaybe (Natural i)
564 | i < maxw = Just (W# (integerToWord i))
565 | True = Nothing
566 where
567 maxw = 1 `shiftLInteger` WORD_SIZE_IN_BITS#
568 #endif
569
570 -- | \"@'powModNatural' /b/ /e/ /m/@\" computes base @/b/@ raised to
571 -- exponent @/e/@ modulo @/m/@.
572 --
573 -- @since 4.8.0.0
574 powModNatural :: Natural -> Natural -> Natural -> Natural
575 #if defined(MIN_VERSION_integer_gmp)
576 powModNatural _ _ (NatS# 0##) = divZeroError
577 powModNatural _ _ (NatS# 1##) = NatS# 0##
578 powModNatural _ (NatS# 0##) _ = NatS# 1##
579 powModNatural (NatS# 0##) _ _ = NatS# 0##
580 powModNatural (NatS# 1##) _ _ = NatS# 1##
581 powModNatural (NatS# b) (NatS# e) (NatS# m) = NatS# (powModWord b e m)
582 powModNatural b e (NatS# m)
583 = NatS# (powModBigNatWord (naturalToBigNat b) (naturalToBigNat e) m)
584 powModNatural b e (NatJ# m)
585 = bigNatToNatural (powModBigNat (naturalToBigNat b) (naturalToBigNat e) m)
586 #else
587 -- Portable reference fallback implementation
588 powModNatural (Natural b0) (Natural e0) (Natural m)
589 | m == wordToInteger 0## = divZeroError
590 | m == wordToInteger 1## = wordToNaturalBase 0##
591 | e0 == wordToInteger 0## = wordToNaturalBase 1##
592 | b0 == wordToInteger 0## = wordToNaturalBase 0##
593 | b0 == wordToInteger 1## = wordToNaturalBase 1##
594 | True = go b0 e0 (wordToInteger 1##)
595 where
596 go !b e !r
597 | e `testBitInteger` 0# = go b' e' ((r `timesInteger` b) `modInteger` m)
598 | e == wordToInteger 0## = naturalFromInteger r
599 | True = go b' e' r
600 where
601 b' = (b `timesInteger` b) `modInteger` m
602 e' = e `shiftRInteger` 1# -- slightly faster than "e `div` 2"
603 #endif
604
605
606 -- | Construct 'Natural' value from list of 'Word's.
607 --
608 -- This function is used by GHC for constructing 'Natural' literals.
609 mkNatural :: [Word] -- ^ value expressed in 32 bit chunks, least
610 -- significant first
611 -> Natural
612 mkNatural [] = wordToNaturalBase 0##
613 mkNatural (W# i : is') = wordToNaturalBase (i `and#` 0xffffffff##) `orNatural`
614 shiftLNatural (mkNatural is') 32
615 {-# CONSTANT_FOLDED mkNatural #-}
616
617 -- | Convert 'Int' to 'Natural'.
618 -- Throws 'Control.Exception.Underflow' when passed a negative 'Int'.
619 intToNatural :: Int -> Natural
620 intToNatural (I# i#)
621 | isTrue# (i# <# 0#) = underflowError
622 | True = wordToNaturalBase (int2Word# i#)