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