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