1{-# LANGUAGE BangPatterns #-}
2{-# LANGUAGE CApiFFI #-}
3{-# LANGUAGE MagicHash #-}
4{-# LANGUAGE UnboxedTuples #-}
5{-# LANGUAGE UnliftedFFITypes #-}
6{-# LANGUAGE DeriveDataTypeable #-}
7{-# LANGUAGE GHCForeignImportPrim #-}
8{-# LANGUAGE CPP #-}
9{-# LANGUAGE StandaloneDeriving #-}
10{-# LANGUAGE NoImplicitPrelude #-}
11
12#include "MachDeps.h"
13
14-- |
15-- Module      :  GHC.Integer.GMP.Internals
16-- Copyright   :  (c) Herbert Valerio Riedel 2014
17-- License     :  BSD3
18--
19-- Maintainer  :  ghc-devs@haskell.org
20-- Stability   :  provisional
21-- Portability :  non-portable (GHC Extensions)
22--
23-- This modules provides access to the 'Integer' constructors and
24-- exposes some highly optimized GMP-operations.
25--
26-- Note that since @integer-gmp@ does not depend on `base`, error
27-- reporting via exceptions, 'error', or 'undefined' is not
28-- available. Instead, the low-level functions will crash the runtime
29-- if called with invalid arguments.
30--
31-- See also
32-- <https://gitlab.haskell.org/ghc/ghc/wikis/commentary/libraries/integer GHC Commentary: Libraries/Integer>.
33
34module GHC.Integer.GMP.Internals
35    ( -- * The 'Integer' type
36      Integer(..)
37    , isValidInteger#
38
39      -- ** Basic 'Integer' operations
40
41    , module GHC.Integer
42
43      -- ** Additional 'Integer' operations
44    , gcdInteger
45    , gcdExtInteger
46    , lcmInteger
47    , sqrInteger
48    , powModInteger
49    , powModSecInteger
50    , recipModInteger
51
52      -- ** Additional conversion operations to 'Integer'
53    , wordToNegInteger
54    , bigNatToInteger
55    , bigNatToNegInteger
56
57      -- * The 'BigNat' type
58    , BigNat(..)
59
60    , GmpLimb, GmpLimb#
61    , GmpSize, GmpSize#
62
63      -- **
64
65    , isValidBigNat#
66    , sizeofBigNat#
67    , zeroBigNat
68    , oneBigNat
69    , nullBigNat
70
71      -- ** Conversions to/from 'BigNat'
72
73    , byteArrayToBigNat#
74    , wordToBigNat
75    , wordToBigNat2
76    , bigNatToInt
77    , bigNatToWord
78    , indexBigNat#
79
80      -- ** 'BigNat' arithmetic operations
81    , plusBigNat
82    , plusBigNatWord
83    , minusBigNat
84    , minusBigNatWord
85    , timesBigNat
86    , timesBigNatWord
87    , sqrBigNat
88
89    , quotRemBigNat
90    , quotRemBigNatWord
91    , quotBigNatWord
92    , quotBigNat
93    , remBigNat
94    , remBigNatWord
95
96    , gcdBigNat
97    , gcdBigNatWord
98
99    , powModBigNat
100    , powModBigNatWord
101
102    , recipModBigNat
103
104      -- ** 'BigNat' logic operations
105    , shiftRBigNat
106    , shiftLBigNat
107    , testBitBigNat
108    , clearBitBigNat
109    , complementBitBigNat
110    , setBitBigNat
111    , andBigNat
112    , xorBigNat
113    , popCountBigNat
114    , orBigNat
115    , bitBigNat
116
117      -- ** 'BigNat' comparison predicates
118    , isZeroBigNat
119    , isNullBigNat#
120
121    , compareBigNatWord
122    , compareBigNat
123    , eqBigNatWord
124    , eqBigNatWord#
125    , eqBigNat
126    , eqBigNat#
127    , gtBigNatWord#
128
129      -- * Miscellaneous GMP-provided operations
130    , gcdInt
131    , gcdWord
132    , powModWord
133    , recipModWord
134
135      -- * Primality tests
136    , testPrimeInteger
137    , testPrimeBigNat
138    , testPrimeWord#
139
140    , nextPrimeInteger
141    , nextPrimeBigNat
142    , nextPrimeWord#
143
144      -- * Import/export functions
145      -- ** Compute size of serialisation
146    , sizeInBaseBigNat
147    , sizeInBaseInteger
148    , sizeInBaseWord#
149
150      -- ** Export
151    , exportBigNatToAddr
152    , exportIntegerToAddr
153    , exportWordToAddr
154
155    , exportBigNatToMutableByteArray
156    , exportIntegerToMutableByteArray
157    , exportWordToMutableByteArray
158
159      -- ** Import
160
161    , importBigNatFromAddr
162    , importIntegerFromAddr
163
164    , importBigNatFromByteArray
165    , importIntegerFromByteArray
166    ) where
167
168import GHC.Integer.Type
169import GHC.Integer
170import GHC.Prim
171import GHC.Types
172
173default ()
174
175
176-- | Compute number of digits (without sign) in given @/base/@.
177--
178-- This function wraps @mpz_sizeinbase()@ which has some
179-- implementation pecularities to take into account:
180--
181-- * \"@'sizeInBaseInteger' 0 /base/ = 1@\"
182--   (see also comment in 'exportIntegerToMutableByteArray').
183--
184-- * This function is only defined if @/base/ >= 2#@ and @/base/ <= 256#@
185--   (Note: the documentation claims that only @/base/ <= 62#@ is
186--   supported, however the actual implementation supports up to base 256).
187--
188-- * If @/base/@ is a power of 2, the result will be exact. In other
189--   cases (e.g. for @/base/ = 10#@), the result /may/ be 1 digit too large
190--   sometimes.
191--
192-- * \"@'sizeInBaseInteger' /i/ 2#@\" can be used to determine the most
193--   significant bit of @/i/@.
194--
195-- @since 0.5.1.0
196sizeInBaseInteger :: Integer -> Int# -> Word#
197sizeInBaseInteger (S# i#)  = sizeInBaseWord# (int2Word# (absI# i#))
198sizeInBaseInteger (Jp# bn) = sizeInBaseBigNat bn
199sizeInBaseInteger (Jn# bn) = sizeInBaseBigNat bn
200
201-- | Version of 'sizeInBaseInteger' operating on 'BigNat'
202--
203-- @since 1.0.0.0
204sizeInBaseBigNat :: BigNat -> Int# -> Word#
205sizeInBaseBigNat bn@(BN# ba#) = c_mpn_sizeinbase# ba# (sizeofBigNat# bn)
206
207foreign import ccall unsafe "integer_gmp_mpn_sizeinbase"
208  c_mpn_sizeinbase# :: ByteArray# -> GmpSize# -> Int# -> Word#
209
210-- | Version of 'sizeInBaseInteger' operating on 'Word#'
211--
212-- @since 1.0.0.0
213foreign import ccall unsafe "integer_gmp_mpn_sizeinbase1"
214  sizeInBaseWord# :: Word# -> Int# -> Word#
215
216-- | Dump 'Integer' (without sign) to @/addr/@ in base-256 representation.
217--
218-- @'exportIntegerToAddr' /i/ /addr/ /e/@
219--
220-- See description of 'exportIntegerToMutableByteArray' for more details.
221--
222-- @since 1.0.0.0
223exportIntegerToAddr :: Integer -> Addr# -> Int# -> IO Word
224exportIntegerToAddr (S# i#)  = exportWordToAddr (W# (int2Word# (absI# i#)))
225exportIntegerToAddr (Jp# bn) = exportBigNatToAddr bn
226exportIntegerToAddr (Jn# bn) = exportBigNatToAddr bn
227
228-- | Version of 'exportIntegerToAddr' operating on 'BigNat's.
229exportBigNatToAddr :: BigNat -> Addr# -> Int# -> IO Word
230exportBigNatToAddr bn@(BN# ba#) addr e
231  = c_mpn_exportToAddr# ba# (sizeofBigNat# bn) addr 0# e
232
233foreign import ccall unsafe "integer_gmp_mpn_export"
234  c_mpn_exportToAddr# :: ByteArray# -> GmpSize# -> Addr# -> Int# -> Int#
235                         -> IO Word
236
237-- | Version of 'exportIntegerToAddr' operating on 'Word's.
238exportWordToAddr :: Word -> Addr# -> Int# -> IO Word
239exportWordToAddr (W# w#) addr
240  = c_mpn_export1ToAddr# w# addr 0# -- TODO: we don't calling GMP for that
241
242foreign import ccall unsafe "integer_gmp_mpn_export1"
243  c_mpn_export1ToAddr# :: GmpLimb# -> Addr# -> Int# -> Int#
244                          -> IO Word
245
246-- | Dump 'Integer' (without sign) to mutable byte-array in base-256
247-- representation.
248--
249-- The call
250--
251-- @'exportIntegerToMutableByteArray' /i/ /mba/ /offset/ /msbf/@
252--
253-- writes
254--
255-- * the 'Integer' @/i/@
256--
257-- * into the 'MutableByteArray#' @/mba/@ starting at @/offset/@
258--
259-- * with most significant byte first if @msbf@ is @1#@ or least
260--   significant byte first if @msbf@ is @0#@, and
261--
262-- * returns number of bytes written.
263--
264-- Use \"@'sizeInBaseInteger' /i/ 256#@\" to compute the exact number of
265-- bytes written in advance for @/i/ /= 0@. In case of @/i/ == 0@,
266-- 'exportIntegerToMutableByteArray' will write and report zero bytes
267-- written, whereas 'sizeInBaseInteger' report one byte.
268--
269-- It's recommended to avoid calling 'exportIntegerToMutableByteArray' for small
270-- integers as this function would currently convert those to big
271-- integers in msbf to call @mpz_export()@.
272--
273-- @since 1.0.0.0
274exportIntegerToMutableByteArray :: Integer -> MutableByteArray# RealWorld
275                                -> Word# -> Int# -> IO Word
276exportIntegerToMutableByteArray (S# i#)
277    = exportWordToMutableByteArray (W# (int2Word# (absI# i#)))
278exportIntegerToMutableByteArray (Jp# bn) = exportBigNatToMutableByteArray bn
279exportIntegerToMutableByteArray (Jn# bn) = exportBigNatToMutableByteArray bn
280
281-- | Version of 'exportIntegerToMutableByteArray' operating on 'BigNat's.
282--
283-- @since 1.0.0.0
284exportBigNatToMutableByteArray :: BigNat -> MutableByteArray# RealWorld -> Word#
285                               -> Int# -> IO Word
286exportBigNatToMutableByteArray bn@(BN# ba#)
287  = c_mpn_exportToMutableByteArray# ba# (sizeofBigNat# bn)
288
289foreign import ccall unsafe "integer_gmp_mpn_export"
290  c_mpn_exportToMutableByteArray# :: ByteArray# -> GmpSize#
291                                  -> MutableByteArray# RealWorld -> Word#
292                                  -> Int# -> IO Word
293
294-- | Version of 'exportIntegerToMutableByteArray' operating on 'Word's.
295--
296-- @since 1.0.0.0
297exportWordToMutableByteArray :: Word -> MutableByteArray# RealWorld -> Word#
298                             -> Int# -> IO Word
299exportWordToMutableByteArray (W# w#) = c_mpn_export1ToMutableByteArray# w#
300
301foreign import ccall unsafe "integer_gmp_mpn_export1"
302  c_mpn_export1ToMutableByteArray# :: GmpLimb# -> MutableByteArray# RealWorld
303                                   -> Word# -> Int# -> IO Word
304
305
306-- | Probalistic Miller-Rabin primality test.
307--
308-- \"@'testPrimeInteger' /n/ /k/@\" determines whether @/n/@ is prime
309-- and returns one of the following results:
310--
311-- * @2#@ is returned if @/n/@ is definitely prime,
312--
313-- * @1#@ if @/n/@ is a /probable prime/, or
314--
315-- * @0#@ if @/n/@ is definitely not a prime.
316--
317-- The @/k/@ argument controls how many test rounds are performed for
318-- determining a /probable prime/. For more details, see
319-- <http://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fprobab_005fprime_005fp-360 GMP documentation for `mpz_probab_prime_p()`>.
320--
321-- @since 0.5.1.0
322{-# NOINLINE testPrimeInteger #-}
323testPrimeInteger :: Integer -> Int# -> Int#
324testPrimeInteger (S# i#) = testPrimeWord# (int2Word# (absI# i#))
325testPrimeInteger (Jp# n) = testPrimeBigNat n
326testPrimeInteger (Jn# n) = testPrimeBigNat n
327
328-- | Version of 'testPrimeInteger' operating on 'BigNat's
329--
330-- @since 1.0.0.0
331testPrimeBigNat :: BigNat -> Int# -> Int#
332testPrimeBigNat bn@(BN# ba#) = c_integer_gmp_test_prime# ba# (sizeofBigNat# bn)
333
334foreign import ccall unsafe "integer_gmp_test_prime"
335  c_integer_gmp_test_prime# :: ByteArray# -> GmpSize# -> Int# -> Int#
336
337-- | Version of 'testPrimeInteger' operating on 'Word#'s
338--
339-- @since 1.0.0.0
340foreign import ccall unsafe "integer_gmp_test_prime1"
341  testPrimeWord# :: GmpLimb# -> Int# -> Int#
342
343
344-- | Compute next prime greater than @/n/@ probalistically.
345--
346-- According to the GMP documentation, the underlying function
347-- @mpz_nextprime()@ \"uses a probabilistic algorithm to identify
348-- primes. For practical purposes it's adequate, the chance of a
349-- composite passing will be extremely small.\"
350--
351-- @since 0.5.1.0
352{-# NOINLINE nextPrimeInteger #-}
353nextPrimeInteger :: Integer -> Integer
354nextPrimeInteger (S# i#)
355  | isTrue# (i# ># 1#)    = wordToInteger (nextPrimeWord# (int2Word# i#))
356  | True                  = S# 2#
357nextPrimeInteger (Jp# bn) = Jp# (nextPrimeBigNat bn)
358nextPrimeInteger (Jn# _)  = S# 2#
359
360-- | Version of 'nextPrimeInteger' operating on 'Word#'s
361--
362-- @since 1.0.0.0
363foreign import ccall unsafe "integer_gmp_next_prime1"
364  nextPrimeWord# :: GmpLimb# -> GmpLimb#
365