Movatterモバイル変換

{-# LANGUAGE NoImplicitPrelude #-}{-# LANGUAGE BangPatterns #-}{-# LANGUAGE CPP #-}{-# LANGUAGE DeriveDataTypeable #-}{-# LANGUAGE GHCForeignImportPrim #-}{-# LANGUAGE MagicHash #-}{-# LANGUAGE UnboxedTuples #-}{-# LANGUAGE UnliftedFFITypes #-}{-# LANGUAGE RebindableSyntax #-}{-# LANGUAGE NegativeLiterals #-}{-# LANGUAGE ExplicitForAll #-}-- |-- Module      :  GHC.Integer.Type-- Copyright   :  (c) Herbert Valerio Riedel 2014-- License     :  BSD3---- Maintainer  :  ghc-devs@haskell.org-- Stability   :  provisional-- Portability :  non-portable (GHC Extensions)---- GHC needs this module to be named "GHC.Integer.Type" and provide-- all the low-level 'Integer' operations.moduleGHC.Integer.Typewhere#include "MachDeps.h"#include "HsIntegerGmp.h"-- Sanity check as CPP defines are implicitly 0-valued when undefined#if !(defined(SIZEOF_LONG) && defined(SIZEOF_HSWORD) \           && defined(WORD_SIZE_IN_BITS))# error missing defines#endifimportGHC.ClassesimportGHC.MagicimportGHC.PrimimportGHC.Types#if WORD_SIZE_IN_BITS < 64importGHC.IntWord64#endifdefault()-- Most high-level operations need to be marked `NOINLINE` as-- otherwise GHC doesn't recognize them and fails to apply constant-- folding to `Integer`-typed expression.---- To this end, the CPP hack below allows to write the pseudo-pragma----   {-# CONSTANT_FOLDED plusInteger #-}---- which is simply expaned into a----   {-# NOINLINE plusInteger #-}--#define CONSTANT_FOLDED NOINLINE------------------------------------------------------------------------------ type definitions-- NB: all code assumes GMP_LIMB_BITS == WORD_SIZE_IN_BITS-- The C99 code in cbits/wrappers.c will fail to compile if this doesn't hold-- | Type representing a GMP LimbtypeGmpLimb=Word-- actually, 'CULong'typeGmpLimb#=Word#-- | Count of 'GmpLimb's, must be positive (unless specified otherwise).typeGmpSize=Int-- actually, a 'CLong'typeGmpSize#=Int#narrowGmpSize#::Int#->Int##if SIZEOF_LONG == SIZEOF_HSWORDnarrowGmpSize#x=x#elif (SIZEOF_LONG == 4) && (SIZEOF_HSWORD == 8)-- On IL32P64 (i.e. Win64), we have to be careful with CLong not being-- 64bit.  This is mostly an issue on values returned from C functions-- due to sign-extension.narrowGmpSize#=narrow32Int##endiftypeGmpBitCnt=Word-- actually, 'CULong'typeGmpBitCnt#=Word#-- actually, 'CULong'-- Pseudo FFI CTypetypeCInt=InttypeCInt#=Int#narrowCInt#::Int#->Int#narrowCInt#=narrow32Int#-- | Bits in a 'GmpLimb'. Same as @WORD_SIZE_IN_BITS@.gmpLimbBits::Word-- 8 `shiftL` gmpLimbShiftgmpLimbBits=W#WORD_SIZE_IN_BITS###if WORD_SIZE_IN_BITS == 64# define GMP_LIMB_SHIFT   3# define GMP_LIMB_BYTES   8# define GMP_LIMB_BITS    64# define INT_MINBOUND     -0x8000000000000000# define INT_MAXBOUND      0x7fffffffffffffff# define ABS_INT_MINBOUND  0x8000000000000000# define SQRT_INT_MAXBOUND 0xb504f333#elif WORD_SIZE_IN_BITS == 32# define GMP_LIMB_SHIFT   2# define GMP_LIMB_BYTES   4# define GMP_LIMB_BITS    32# define INT_MINBOUND     -0x80000000# define INT_MAXBOUND      0x7fffffff# define ABS_INT_MINBOUND  0x80000000# define SQRT_INT_MAXBOUND 0xb504#else# error unsupported WORD_SIZE_IN_BITS config#endif-- | Type representing /raw/ arbitrary-precision Naturals---- This is common type used by 'Natural' and 'Integer'.  As this type-- consists of a single constructor wrapping a 'ByteArray#' it can be-- unpacked.---- Essential invariants:----  - 'ByteArray#' size is an exact multiple of 'Word#' size--  - limbs are stored in least-significant-limb-first order,--  - the most-significant limb must be non-zero, except for--  - @0@ which is represented as a 1-limb.dataBigNat=BN#ByteArray#instanceEqBigNatwhere(==)=eqBigNatinstanceOrdBigNatwherecompare=compareBigNat-- | Invariant: 'Jn#' and 'Jp#' are used iff value doesn't fit in 'S#'---- Useful properties resulting from the invariants:----  - @abs ('S#' _) <= abs ('Jp#' _)@--  - @abs ('S#' _) <  abs ('Jn#' _)@--dataInteger=S#!Int#-- ^ iff value in @[minBound::'Int', maxBound::'Int']@ range|Jp#{-# UNPACK#-}!BigNat-- ^ iff value in @]maxBound::'Int', +inf[@ range|Jn#{-# UNPACK#-}!BigNat-- ^ iff value in @]-inf, minBound::'Int'[@ range-- TODO: experiment with different constructor-orderinginstanceEqIntegerwhere(==)=eqInteger(/=)=neqIntegerinstanceOrdIntegerwherecompare=compareInteger(>)=gtInteger(>=)=geInteger(<)=ltInteger(<=)=leInteger------------------------------------------------------------------------------ | Construct 'Integer' value from list of 'Int's.---- This function is used by GHC for constructing 'Integer' literals.mkInteger::Bool-- ^ sign of integer ('True' if non-negative)->[Int]-- ^ absolute value expressed in 31 bit chunks, least--   significant first (ideally these would be machine-word--   'Word's rather than 31-bit truncated 'Int's)->IntegermkIntegernonNegativeis|nonNegative=fis|True=negateInteger(fis)wheref[]=S#0#f(I#i:is')=smallInteger(i`andI#`0x7fffffff#)`orInteger`shiftLInteger(fis')31#{-# CONSTANT_FOLDED mkInteger #-}-- | Test whether all internal invariants are satisfied by 'Integer' value---- Returns @1#@ if valid, @0#@ otherwise.---- This operation is mostly useful for test-suites and/or code which-- constructs 'Integer' values directly.isValidInteger#::Integer->Int#isValidInteger#(S#_)=1#isValidInteger#(Jp#bn)=isValidBigNat#bn`andI#`(bn`gtBigNatWord#`INT_MAXBOUND##)isValidInteger#(Jn#bn)=isValidBigNat#bn`andI#`(bn`gtBigNatWord#`ABS_INT_MINBOUND##)-- | Should rather be called @intToInteger@smallInteger::Int#->IntegersmallIntegeri#=S#i#{-# CONSTANT_FOLDED smallInteger #-}------------------------------------------------------------------------------ Int64/Word64 specific primitives#if WORD_SIZE_IN_BITS < 64int64ToInteger::Int64#->Integerint64ToIntegeri|isTrue#(i`leInt64#`intToInt64#0x7FFFFFFF#),isTrue#(i`geInt64#`intToInt64#-0x80000000#)=S#(int64ToInt#i)|isTrue#(i`geInt64#`intToInt64#0#)=Jp#(word64ToBigNat(int64ToWord64#i))|True=Jn#(word64ToBigNat(int64ToWord64#(negateInt64#i))){-# CONSTANT_FOLDED int64ToInteger #-}word64ToInteger::Word64#->Integerword64ToIntegerw|isTrue#(w`leWord64#`wordToWord64#0x7FFFFFFF##)=S#(int64ToInt#(word64ToInt64#w))|True=Jp#(word64ToBigNatw){-# CONSTANT_FOLDED word64ToInteger #-}integerToInt64::Integer->Int64#integerToInt64(S#i#)=intToInt64#i#integerToInt64(Jp#bn)=word64ToInt64#(bigNatToWord64bn)integerToInt64(Jn#bn)=negateInt64#(word64ToInt64#(bigNatToWord64bn)){-# CONSTANT_FOLDED integerToInt64 #-}integerToWord64::Integer->Word64#integerToWord64(S#i#)=int64ToWord64#(intToInt64#i#)integerToWord64(Jp#bn)=bigNatToWord64bnintegerToWord64(Jn#bn)=int64ToWord64#(negateInt64#(word64ToInt64#(bigNatToWord64bn))){-# CONSTANT_FOLDED integerToWord64 #-}#if GMP_LIMB_BITS == 32word64ToBigNat::Word64#->BigNatword64ToBigNatw64=wordToBigNat2wh#wl#wherewh#=word64ToWord#(uncheckedShiftRL64#w6432#)wl#=word64ToWord#w64bigNatToWord64::BigNat->Word64#bigNatToWord64bn|isTrue#(sizeofBigNat#bn>#1#)=letwh#=wordToWord64#(indexBigNat#bn1#)inuncheckedShiftL64#wh#32#`or64#`wl#|True=wl#wherewl#=wordToWord64#(bigNatToWordbn)#endif#endif-- End of Int64/Word64 specific primitives------------------------------------------------------------------------------ | Truncates 'Integer' to least-significant 'Int#'integerToInt::Integer->Int#integerToInt(S#i#)=i#integerToInt(Jp#bn)=bigNatToIntbnintegerToInt(Jn#bn)=negateInt#(bigNatToIntbn){-# CONSTANT_FOLDED integerToInt #-}hashInteger::Integer->Int#hashInteger=integerToInt-- emulating what integer-{simple,gmp} already dointegerToWord::Integer->Word#integerToWord(S#i#)=int2Word#i#integerToWord(Jp#bn)=bigNatToWordbnintegerToWord(Jn#bn)=int2Word#(negateInt#(bigNatToIntbn)){-# CONSTANT_FOLDED integerToWord #-}wordToInteger::Word#->IntegerwordToIntegerw#|isTrue#(i#>=#0#)=S#i#|True=Jp#(wordToBigNatw#)wherei#=word2Int#w#{-# CONSTANT_FOLDED wordToInteger #-}wordToNegInteger::Word#->IntegerwordToNegIntegerw#|isTrue#(i#<=#0#)=S#i#|True=Jn#(wordToBigNatw#)wherei#=negateInt#(word2Int#w#)-- we could almost auto-derive Ord if it wasn't for the Jn#-Jn# casecompareInteger::Integer->Integer->OrderingcompareInteger(Jn#x)(Jn#y)=compareBigNatyxcompareInteger(S#x)(S#y)=compareInt#xycompareInteger(Jp#x)(Jp#y)=compareBigNatxycompareInteger(Jn#_)_=LTcompareInteger(S#_)(Jp#_)=LTcompareInteger(S#_)(Jn#_)=GTcompareInteger(Jp#_)_=GT{-# CONSTANT_FOLDED compareInteger #-}isNegInteger#::Integer->Int#isNegInteger#(S#i#)=i#<#0#isNegInteger#(Jp#_)=0#isNegInteger#(Jn#_)=1#-- | Not-equal predicate.neqInteger::Integer->Integer->BoolneqIntegerxy=isTrue#(neqInteger#xy)eqInteger,leInteger,ltInteger,gtInteger,geInteger::Integer->Integer->BooleqIntegerxy=isTrue#(eqInteger#xy)leIntegerxy=isTrue#(leInteger#xy)ltIntegerxy=isTrue#(ltInteger#xy)gtIntegerxy=isTrue#(gtInteger#xy)geIntegerxy=isTrue#(geInteger#xy)eqInteger#,neqInteger#,leInteger#,ltInteger#,gtInteger#,geInteger#::Integer->Integer->Int#eqInteger#(S#x#)(S#y#)=x#==#y#eqInteger#(Jn#x)(Jn#y)=eqBigNat#xyeqInteger#(Jp#x)(Jp#y)=eqBigNat#xyeqInteger#__=0#{-# CONSTANT_FOLDED eqInteger# #-}neqInteger#(S#x#)(S#y#)=x#/=#y#neqInteger#(Jn#x)(Jn#y)=neqBigNat#xyneqInteger#(Jp#x)(Jp#y)=neqBigNat#xyneqInteger#__=1#{-# CONSTANT_FOLDED neqInteger# #-}gtInteger#(S#x#)(S#y#)=x#>#y#gtInteger#xy|inlinecompareIntegerxy==GT=1#gtInteger#__=0#{-# CONSTANT_FOLDED gtInteger# #-}leInteger#(S#x#)(S#y#)=x#<=#y#leInteger#xy|inlinecompareIntegerxy/=GT=1#leInteger#__=0#{-# CONSTANT_FOLDED leInteger# #-}ltInteger#(S#x#)(S#y#)=x#<#y#ltInteger#xy|inlinecompareIntegerxy==LT=1#ltInteger#__=0#{-# CONSTANT_FOLDED ltInteger# #-}geInteger#(S#x#)(S#y#)=x#>=#y#geInteger#xy|inlinecompareIntegerxy/=LT=1#geInteger#__=0#{-# CONSTANT_FOLDED geInteger# #-}-- | Compute absolute value of an 'Integer'absInteger::Integer->IntegerabsInteger(Jn#n)=Jp#nabsInteger(S#INT_MINBOUND#)=Jp#(wordToBigNatABS_INT_MINBOUND##)absInteger(S#i#)|isTrue#(i#<#0#)=S#(negateInt#i#)absIntegeri@(S#_)=iabsIntegeri@(Jp#_)=i{-# CONSTANT_FOLDED absInteger #-}-- | Return @-1@, @0@, and @1@ depending on whether argument is-- negative, zero, or positive, respectivelysignumInteger::Integer->IntegersignumIntegerj=S#(signumInteger#j){-# CONSTANT_FOLDED signumInteger #-}-- | Return @-1#@, @0#@, and @1#@ depending on whether argument is-- negative, zero, or positive, respectivelysignumInteger#::Integer->Int#signumInteger#(Jn#_)=-1#signumInteger#(S#i#)=sgnI#i#signumInteger#(Jp#_)=1#-- | Negate 'Integer'negateInteger::Integer->IntegernegateInteger(Jn#n)=Jp#nnegateInteger(S#INT_MINBOUND#)=Jp#(wordToBigNatABS_INT_MINBOUND##)negateInteger(S#i#)=S#(negateInt#i#)negateInteger(Jp#bn)|isTrue#(eqBigNatWord#bnABS_INT_MINBOUND##)=S#INT_MINBOUND#|True=Jn#bn{-# CONSTANT_FOLDED negateInteger #-}-- one edge-case issue to take into account is that Int's range is not-- symmetric around 0.  I.e. @minBound+maxBound = -1@---- Jp# is used iff n > maxBound::Int-- Jn# is used iff n < minBound::Int-- | Add two 'Integer'splusInteger::Integer->Integer->IntegerplusIntegerx(S#0#)=xplusInteger(S#0#)y=yplusInteger(S#x#)(S#y#)=caseaddIntC#x#y#of(#z#,0##)->S#z#(#0#,_#)->Jn#(wordToBigNat21##0##)-- 2*minBound::Int(#z#,_#)|isTrue#(z#>#0#)->Jn#(wordToBigNat((int2Word#(negateInt#z#))))|True->Jp#(wordToBigNat((int2Word#z#)))plusIntegery@(S#_)x=plusIntegerxy-- no S# as first arg from here onplusInteger(Jp#x)(Jp#y)=Jp#(plusBigNatxy)plusInteger(Jn#x)(Jn#y)=Jn#(plusBigNatxy)plusInteger(Jp#x)(S#y#)-- edge-case: @(maxBound+1) + minBound == 0@|isTrue#(y#>=#0#)=Jp#(plusBigNatWordx(int2Word#y#))|True=bigNatToInteger(minusBigNatWordx(int2Word#(negateInt#y#)))plusInteger(Jn#x)(S#y#)-- edge-case: @(minBound-1) + maxBound == -2@|isTrue#(y#>=#0#)=bigNatToNegInteger(minusBigNatWordx(int2Word#y#))|True=Jn#(plusBigNatWordx(int2Word#(negateInt#y#)))plusIntegery@(Jn#_)x@(Jp#_)=plusIntegerxyplusInteger(Jp#x)(Jn#y)=casecompareBigNatxyofLT->bigNatToNegInteger(minusBigNatyx)EQ->S#0#GT->bigNatToInteger(minusBigNatxy){-# CONSTANT_FOLDED plusInteger #-}-- | Subtract one 'Integer' from another.minusInteger::Integer->Integer->IntegerminusIntegerx(S#0#)=xminusInteger(S#x#)(S#y#)=casesubIntC#x#y#of(#z#,0##)->S#z#(#0#,_#)->Jn#(wordToBigNat21##0##)(#z#,_#)|isTrue#(z#>#0#)->Jn#(wordToBigNat((int2Word#(negateInt#z#))))|True->Jp#(wordToBigNat((int2Word#z#)))minusInteger(S#x#)(Jp#y)|isTrue#(x#>=#0#)=bigNatToNegInteger(minusBigNatWordy(int2Word#x#))|True=Jn#(plusBigNatWordy(int2Word#(negateInt#x#)))minusInteger(S#x#)(Jn#y)|isTrue#(x#>=#0#)=Jp#(plusBigNatWordy(int2Word#x#))|True=bigNatToInteger(minusBigNatWordy(int2Word#(negateInt#x#)))minusInteger(Jp#x)(Jp#y)=casecompareBigNatxyofLT->bigNatToNegInteger(minusBigNatyx)EQ->S#0#GT->bigNatToInteger(minusBigNatxy)minusInteger(Jp#x)(Jn#y)=Jp#(plusBigNatxy)minusInteger(Jn#x)(Jp#y)=Jn#(plusBigNatxy)minusInteger(Jn#x)(Jn#y)=casecompareBigNatxyofLT->bigNatToInteger(minusBigNatyx)EQ->S#0#GT->bigNatToNegInteger(minusBigNatxy)minusInteger(Jp#x)(S#y#)|isTrue#(y#>=#0#)=bigNatToInteger(minusBigNatWordx(int2Word#y#))|True=Jp#(plusBigNatWordx(int2Word#(negateInt#y#)))minusInteger(Jn#x)(S#y#)|isTrue#(y#>=#0#)=Jn#(plusBigNatWordx(int2Word#y#))|True=bigNatToNegInteger(minusBigNatWordx(int2Word#(negateInt#y#))){-# CONSTANT_FOLDED minusInteger #-}-- | Multiply two 'Integer'stimesInteger::Integer->Integer->IntegertimesInteger!_(S#0#)=S#0#timesInteger(S#0#)_=S#0#timesIntegerx(S#1#)=xtimesInteger(S#1#)y=ytimesIntegerx(S#-1#)=negateIntegerxtimesInteger(S#-1#)y=negateIntegerytimesInteger(S#x#)(S#y#)=casemulIntMayOflo#x#y#of0#->S#(x#*#y#)_->timesInt2Integerx#y#timesIntegerx@(S#_)y=timesIntegeryx-- no S# as first arg from here ontimesInteger(Jp#x)(Jp#y)=Jp#(timesBigNatxy)timesInteger(Jp#x)(Jn#y)=Jn#(timesBigNatxy)timesInteger(Jp#x)(S#y#)|isTrue#(y#>=#0#)=Jp#(timesBigNatWordx(int2Word#y#))|True=Jn#(timesBigNatWordx(int2Word#(negateInt#y#)))timesInteger(Jn#x)(Jn#y)=Jp#(timesBigNatxy)timesInteger(Jn#x)(Jp#y)=Jn#(timesBigNatxy)timesInteger(Jn#x)(S#y#)|isTrue#(y#>=#0#)=Jn#(timesBigNatWordx(int2Word#y#))|True=Jp#(timesBigNatWordx(int2Word#(negateInt#y#))){-# CONSTANT_FOLDED timesInteger #-}-- | Square 'Integer'sqrInteger::Integer->IntegersqrInteger(S#INT_MINBOUND#)=timesInt2IntegerINT_MINBOUND#INT_MINBOUND#sqrInteger(S#j#)|isTrue#(absI#j#<=#SQRT_INT_MAXBOUND#)=S#(j#*#j#)sqrInteger(S#j#)=timesInt2Integerj#j#sqrInteger(Jp#bn)=Jp#(sqrBigNatbn)sqrInteger(Jn#bn)=Jp#(sqrBigNatbn)-- | Construct 'Integer' from the product of two 'Int#'stimesInt2Integer::Int#->Int#->IntegertimesInt2Integerx#y#=case(#isTrue#(x#>=#0#),isTrue#(y#>=#0#)#)of(#False,False#)->casetimesWord2#(int2Word#(negateInt#x#))(int2Word#(negateInt#y#))of(#0##,l#)->inlinewordToIntegerl(#h,l#)->Jp#(wordToBigNat2hl)(#True,False#)->casetimesWord2#(int2Word#x#)(int2Word#(negateInt#y#))of(#0##,l#)->wordToNegIntegerl(#h,l#)->Jn#(wordToBigNat2hl)(#False,True#)->casetimesWord2#(int2Word#(negateInt#x#))(int2Word#y#)of(#0##,l#)->wordToNegIntegerl(#h,l#)->Jn#(wordToBigNat2hl)(#True,True#)->casetimesWord2#(int2Word#x#)(int2Word#y#)of(#0##,l#)->inlinewordToIntegerl(#h,l#)->Jp#(wordToBigNat2hl)bigNatToInteger::BigNat->IntegerbigNatToIntegerbn|isTrue#((sizeofBigNat#bn==#1#)`andI#`(i#>=#0#))=S#i#|True=Jp#bnwherei#=word2Int#(bigNatToWordbn)bigNatToNegInteger::BigNat->IntegerbigNatToNegIntegerbn|isTrue#((sizeofBigNat#bn==#1#)`andI#`(i#<=#0#))=S#i#|True=Jn#bnwherei#=negateInt#(word2Int#(bigNatToWordbn))-- | Count number of set bits. For negative arguments returns negative-- population count of negated argument.popCountInteger::Integer->Int#popCountInteger(S#i#)|isTrue#(i#>=#0#)=popCntI#i#|True=negateInt#(popCntI#(negateInt#i#))popCountInteger(Jp#bn)=popCountBigNatbnpopCountInteger(Jn#bn)=negateInt#(popCountBigNatbn){-# CONSTANT_FOLDED popCountInteger #-}-- | 'Integer' for which only /n/-th bit is set. Undefined behaviour-- for negative /n/ values.bitInteger::Int#->IntegerbitIntegeri#|isTrue#(i#<#(GMP_LIMB_BITS#-#1#))=S#(uncheckedIShiftL#1#i#)|True=Jp#(bitBigNati#){-# CONSTANT_FOLDED bitInteger #-}-- | Test if /n/-th bit is set.testBitInteger::Integer->Int#->BooltestBitInteger!_n#|isTrue#(n#<#0#)=FalsetestBitInteger(S#i#)n#|isTrue#(n#<#GMP_LIMB_BITS#)=isTrue#(((uncheckedIShiftL#1#n#)`andI#`i#)/=#0#)|True=isTrue#(i#<#0#)testBitInteger(Jp#bn)n=testBitBigNatbnntestBitInteger(Jn#bn)n=testBitNegBigNatbnn{-# CONSTANT_FOLDED testBitInteger #-}-- | Bitwise @NOT@ operationcomplementInteger::Integer->IntegercomplementInteger(S#i#)=S#(notI#i#)complementInteger(Jp#bn)=Jn#(plusBigNatWordbn1##)complementInteger(Jn#bn)=Jp#(minusBigNatWordbn1##){-# CONSTANT_FOLDED complementInteger #-}-- | Arithmetic shift-right operation---- Even though the shift-amount is expressed as `Int#`, the result is-- undefined for negative shift-amounts.shiftRInteger::Integer->Int#->IntegershiftRIntegerx0#=xshiftRInteger(S#i#)n#=S#(iShiftRA#i#n#)whereiShiftRA#ab|isTrue#(b>=#WORD_SIZE_IN_BITS#)=(a<#0#)*#(-1#)|True=a`uncheckedIShiftRA#`bshiftRInteger(Jp#bn)n#=bigNatToInteger(shiftRBigNatbnn#)shiftRInteger(Jn#bn)n#=casebigNatToNegInteger(shiftRNegBigNatbnn#)ofS#0#->S#-1#r->r{-# CONSTANT_FOLDED shiftRInteger #-}-- | Shift-left operation---- Even though the shift-amount is expressed as `Int#`, the result is-- undefined for negative shift-amounts.shiftLInteger::Integer->Int#->IntegershiftLIntegerx0#=xshiftLInteger(S#0#)_=S#0#shiftLInteger(S#1#)n#=bitIntegern#shiftLInteger(S#i#)n#|isTrue#(i#>=#0#)=bigNatToInteger(shiftLBigNat(wordToBigNat(int2Word#i#))n#)|True=bigNatToNegInteger(shiftLBigNat(wordToBigNat(int2Word#(negateInt#i#)))n#)shiftLInteger(Jp#bn)n#=Jp#(shiftLBigNatbnn#)shiftLInteger(Jn#bn)n#=Jn#(shiftLBigNatbnn#){-# CONSTANT_FOLDED shiftLInteger #-}-- | Bitwise OR operationorInteger::Integer->Integer->Integer-- short-cutsorInteger(S#0#)y=yorIntegerx(S#0#)=xorInteger(S#-1#)_=S#-1#orInteger_(S#-1#)=S#-1#-- base-casesorInteger(S#x#)(S#y#)=S#(orI#x#y#)orInteger(Jp#x)(Jp#y)=Jp#(orBigNatxy)orInteger(Jn#x)(Jn#y)=bigNatToNegInteger(plusBigNatWord(andBigNat(minusBigNatWordx1##)(minusBigNatWordy1##))1##)orIntegerx@(Jn#_)y@(Jp#_)=orIntegeryx-- retry with swapped argsorInteger(Jp#x)(Jn#y)=bigNatToNegInteger(plusBigNatWord(andnBigNat(minusBigNatWordy1##)x)1##)-- TODO/FIXpromotion-hackorIntegerx@(S#_)y=orInteger(unsafePromotex)yorIntegerxy{- S# -}=orIntegerx(unsafePromotey){-# CONSTANT_FOLDED orInteger #-}-- | Bitwise XOR operationxorInteger::Integer->Integer->Integer-- short-cutsxorInteger(S#0#)y=yxorIntegerx(S#0#)=x-- TODO: (S# -1) cases-- base-casesxorInteger(S#x#)(S#y#)=S#(xorI#x#y#)xorInteger(Jp#x)(Jp#y)=bigNatToInteger(xorBigNatxy)xorInteger(Jn#x)(Jn#y)=bigNatToInteger(xorBigNat(minusBigNatWordx1##)(minusBigNatWordy1##))xorIntegerx@(Jn#_)y@(Jp#_)=xorIntegeryx-- retry with swapped argsxorInteger(Jp#x)(Jn#y)=bigNatToNegInteger(plusBigNatWord(xorBigNatx(minusBigNatWordy1##))1##)-- TODO/FIXME promotion-hackxorIntegerx@(S#_)y=xorInteger(unsafePromotex)yxorIntegerxy{- S# -}=xorIntegerx(unsafePromotey){-# CONSTANT_FOLDED xorInteger #-}-- | Bitwise AND operationandInteger::Integer->Integer->Integer-- short-cutsandInteger(S#0#)!_=S#0#andInteger_(S#0#)=S#0#andInteger(S#-1#)y=yandIntegerx(S#-1#)=x-- base-casesandInteger(S#x#)(S#y#)=S#(andI#x#y#)andInteger(Jp#x)(Jp#y)=bigNatToInteger(andBigNatxy)andInteger(Jn#x)(Jn#y)=bigNatToNegInteger(plusBigNatWord(orBigNat(minusBigNatWordx1##)(minusBigNatWordy1##))1##)andIntegerx@(Jn#_)y@(Jp#_)=andIntegeryxandInteger(Jp#x)(Jn#y)=bigNatToInteger(andnBigNatx(minusBigNatWordy1##))-- TODO/FIXME promotion-hackandIntegerx@(S#_)y=andInteger(unsafePromotex)yandIntegerxy{- S# -}=andIntegerx(unsafePromotey){-# CONSTANT_FOLDED andInteger #-}-- HACK warning! breaks invariant on purposeunsafePromote::Integer->IntegerunsafePromote(S#x#)|isTrue#(x#>=#0#)=Jp#(wordToBigNat(int2Word#x#))|True=Jn#(wordToBigNat(int2Word#(negateInt#x#)))unsafePromotex=x-- | Simultaneous 'quotInteger' and 'remInteger'.---- Divisor must be non-zero otherwise the GHC runtime will terminate-- with a division-by-zero fault.quotRemInteger::Integer->Integer->(#Integer,Integer#)quotRemIntegern(S#1#)=(#n,S#0##)quotRemIntegern(S#-1#)=let!q=negateIntegernin(#q,(S#0#)#)quotRemInteger!_(S#0#)=(#S#(quotInt#0#0#),S#(remInt#0#0#)#)quotRemInteger(S#0#)_=(#S#0#,S#0##)quotRemInteger(S#n#)(S#d#)=casequotRemInt#n#d#of(#q#,r##)->(#S#q#,S#r##)quotRemInteger(Jp#n)(Jp#d)=casequotRemBigNatndof(#q,r#)->(#bigNatToIntegerq,bigNatToIntegerr#)quotRemInteger(Jp#n)(Jn#d)=casequotRemBigNatndof(#q,r#)->(#bigNatToNegIntegerq,bigNatToIntegerr#)quotRemInteger(Jn#n)(Jn#d)=casequotRemBigNatndof(#q,r#)->(#bigNatToIntegerq,bigNatToNegIntegerr#)quotRemInteger(Jn#n)(Jp#d)=casequotRemBigNatndof(#q,r#)->(#bigNatToNegIntegerq,bigNatToNegIntegerr#)quotRemInteger(Jp#n)(S#d#)|isTrue#(d#>=#0#)=casequotRemBigNatWordn(int2Word#d#)of(#q,r##)->(#bigNatToIntegerq,inlinewordToIntegerr##)|True=casequotRemBigNatWordn(int2Word#(negateInt#d#))of(#q,r##)->(#bigNatToNegIntegerq,inlinewordToIntegerr##)quotRemInteger(Jn#n)(S#d#)|isTrue#(d#>=#0#)=casequotRemBigNatWordn(int2Word#d#)of(#q,r##)->(#bigNatToNegIntegerq,wordToNegIntegerr##)|True=casequotRemBigNatWordn(int2Word#(negateInt#d#))of(#q,r##)->(#bigNatToIntegerq,wordToNegIntegerr##)quotRemIntegern@(S#_)(Jn#_)=(#S#0#,n#)-- since @n < d@quotRemIntegern@(S#n#)(Jp#d)-- need to account for (S# minBound)|isTrue#(n#>#0#)=(#S#0#,n#)|isTrue#(gtBigNatWord#d(int2Word#(negateInt#n#)))=(#S#0#,n#)|True{- abs(n) == d -}=(#S#-1#,S#0##){-# CONSTANT_FOLDED quotRemInteger #-}quotInteger::Integer->Integer->IntegerquotIntegern(S#1#)=nquotIntegern(S#-1#)=negateIntegernquotInteger!_(S#0#)=S#(quotInt#0#0#)quotInteger(S#0#)_=S#0#quotInteger(S#n#)(S#d#)=S#(quotInt#n#d#)quotInteger(Jp#n)(S#d#)|isTrue#(d#>=#0#)=bigNatToInteger(quotBigNatWordn(int2Word#d#))|True=bigNatToNegInteger(quotBigNatWordn(int2Word#(negateInt#d#)))quotInteger(Jn#n)(S#d#)|isTrue#(d#>=#0#)=bigNatToNegInteger(quotBigNatWordn(int2Word#d#))|True=bigNatToInteger(quotBigNatWordn(int2Word#(negateInt#d#)))quotInteger(Jp#n)(Jp#d)=bigNatToInteger(quotBigNatnd)quotInteger(Jp#n)(Jn#d)=bigNatToNegInteger(quotBigNatnd)quotInteger(Jn#n)(Jp#d)=bigNatToNegInteger(quotBigNatnd)quotInteger(Jn#n)(Jn#d)=bigNatToInteger(quotBigNatnd)-- handle remaining non-allocating casesquotIntegernd=caseinlinequotRemIntegerndof(#q,_#)->q{-# CONSTANT_FOLDED quotInteger #-}remInteger::Integer->Integer->IntegerremInteger!_(S#1#)=S#0#remInteger_(S#-1#)=S#0#remInteger_(S#0#)=S#(remInt#0#0#)remInteger(S#0#)_=S#0#remInteger(S#n#)(S#d#)=S#(remInt#n#d#)remInteger(Jp#n)(S#d#)=wordToInteger(remBigNatWordn(int2Word#(absI#d#)))remInteger(Jn#n)(S#d#)=wordToNegInteger(remBigNatWordn(int2Word#(absI#d#)))remInteger(Jp#n)(Jp#d)=bigNatToInteger(remBigNatnd)remInteger(Jp#n)(Jn#d)=bigNatToInteger(remBigNatnd)remInteger(Jn#n)(Jp#d)=bigNatToNegInteger(remBigNatnd)remInteger(Jn#n)(Jn#d)=bigNatToNegInteger(remBigNatnd)-- handle remaining non-allocating casesremIntegernd=caseinlinequotRemIntegerndof(#_,r#)->r{-# CONSTANT_FOLDED remInteger #-}-- | Simultaneous 'divInteger' and 'modInteger'.---- Divisor must be non-zero otherwise the GHC runtime will terminate-- with a division-by-zero fault.divModInteger::Integer->Integer->(#Integer,Integer#)divModIntegernd|isTrue#(signumInteger#r==#negateInt#(signumInteger#d))=let!q'=plusIntegerq(S#-1#)-- TODO: optimize!r'=plusIntegerrdin(#q',r'#)|True=qrwhere!qr@(#q,r#)=quotRemIntegernd{-# CONSTANT_FOLDED divModInteger #-}divInteger::Integer->Integer->Integer-- same-sign ops can be handled by more efficient 'quotInteger'divIntegernd|isTrue#(isNegInteger#n==#isNegInteger#d)=quotIntegernddivIntegernd=caseinlinedivModIntegerndof(#q,_#)->q{-# CONSTANT_FOLDED divInteger #-}modInteger::Integer->Integer->Integer-- same-sign ops can be handled by more efficient 'remInteger'modIntegernd|isTrue#(isNegInteger#n==#isNegInteger#d)=remIntegerndmodIntegernd=caseinlinedivModIntegerndof(#_,r#)->r{-# CONSTANT_FOLDED modInteger #-}-- | Compute greatest common divisor.gcdInteger::Integer->Integer->IntegergcdInteger(S#0#)b=absIntegerbgcdIntegera(S#0#)=absIntegeragcdInteger(S#1#)_=S#1#gcdInteger(S#-1#)_=S#1#gcdInteger_(S#1#)=S#1#gcdInteger_(S#-1#)=S#1#gcdInteger(S#a#)(S#b#)=wordToInteger(gcdWord#(int2Word#(absI#a#))(int2Word#(absI#b#)))gcdIntegera@(S#_)b=gcdIntegerbagcdInteger(Jn#a)b=gcdInteger(Jp#a)bgcdInteger(Jp#a)(Jp#b)=bigNatToInteger(gcdBigNatab)gcdInteger(Jp#a)(Jn#b)=bigNatToInteger(gcdBigNatab)gcdInteger(Jp#a)(S#b#)=wordToInteger(gcdBigNatWorda(int2Word#(absI#b#))){-# CONSTANT_FOLDED gcdInteger #-}-- | Compute least common multiple.lcmInteger::Integer->Integer->IntegerlcmInteger(S#0#)!_=S#0#lcmInteger(S#1#)b=absIntegerblcmInteger(S#-1#)b=absIntegerblcmInteger_(S#0#)=S#0#lcmIntegera(S#1#)=absIntegeralcmIntegera(S#-1#)=absIntegeralcmIntegerab=(aa`quotInteger`(aa`gcdInteger`ab))`timesInteger`abwhereaa=absIntegeraab=absIntegerb{-# CONSTANT_FOLDED lcmInteger #-}-- | Compute greatest common divisor.---- __Warning__: result may become negative if (at least) one argument-- is 'minBound'gcdInt::Int#->Int#->Int#gcdIntx#y#=word2Int#(gcdWord#(int2Word#(absI#x#))(int2Word#(absI#y#)))-- | Compute greatest common divisor.---- @since 1.0.0.0gcdWord::Word#->Word#->Word#gcdWord=gcdWord#------------------------------------------------------------------------------ BigNat operationscompareBigNat::BigNat->BigNat->OrderingcompareBigNatx@(BN#x#)y@(BN#y#)|isTrue#(nx#==#ny#)=compareInt#(narrowCInt#(c_mpn_cmpx#y#nx#))0#|isTrue#(nx#<#ny#)=LT|True=GTwherenx#=sizeofBigNat#xny#=sizeofBigNat#ycompareBigNatWord::BigNat->GmpLimb#->OrderingcompareBigNatWordbnw#|isTrue#(sizeofBigNat#bn==#1#)=cmpW#(bigNatToWordbn)w#|True=GTgtBigNatWord#::BigNat->GmpLimb#->Int#gtBigNatWord#bnw#=(sizeofBigNat#bn>#1#)`orI#`(bigNatToWordbn`gtWord#`w#)eqBigNat::BigNat->BigNat->BooleqBigNatxy=isTrue#(eqBigNat#xy)eqBigNat#::BigNat->BigNat->Int#eqBigNat#x@(BN#x#)y@(BN#y#)|isTrue#(nx#==#ny#)=c_mpn_cmpx#y#nx#==#0#|True=0#wherenx#=sizeofBigNat#xny#=sizeofBigNat#yneqBigNat#::BigNat->BigNat->Int#neqBigNat#x@(BN#x#)y@(BN#y#)|isTrue#(nx#==#ny#)=c_mpn_cmpx#y#nx#/=#0#|True=1#wherenx#=sizeofBigNat#xny#=sizeofBigNat#yeqBigNatWord::BigNat->GmpLimb#->BooleqBigNatWordbnw#=isTrue#(eqBigNatWord#bnw#)eqBigNatWord#::BigNat->GmpLimb#->Int#eqBigNatWord#bnw#=(sizeofBigNat#bn==#1#)`andI#`(bigNatToWordbn`eqWord#`w#)-- | Same as @'indexBigNat#' bn 0\#@bigNatToWord::BigNat->Word#bigNatToWordbn=indexBigNat#bn0#-- | Equivalent to @'word2Int#' . 'bigNatToWord'@bigNatToInt::BigNat->Int#bigNatToInt(BN#ba#)=indexIntArray#ba#0#-- | CAF representing the value @0 :: BigNat@zeroBigNat::BigNatzeroBigNat=runS$dombn<-newBigNat#1#_<-svoid(writeBigNat#mbn0#0##)unsafeFreezeBigNat#mbn{-# NOINLINEzeroBigNat#-}-- | Test if 'BigNat' value is equal to zero.isZeroBigNat::BigNat->BoolisZeroBigNatbn=eqBigNatWordbn0##-- | CAF representing the value @1 :: BigNat@oneBigNat::BigNatoneBigNat=runS$dombn<-newBigNat#1#_<-svoid(writeBigNat#mbn0#1##)unsafeFreezeBigNat#mbn{-# NOINLINEoneBigNat#-}czeroBigNat::BigNatczeroBigNat=runS$dombn<-newBigNat#1#_<-svoid(writeBigNat#mbn0#(not#0##))unsafeFreezeBigNat#mbn{-# NOINLINEczeroBigNat#-}-- | Special 0-sized bigNat returned in case of arithmetic underflow---- This is currently only returned by the following operations:----  - 'minusBigNat'--  - 'minusBigNatWord'---- Other operations such as 'quotBigNat' may return 'nullBigNat' as-- well as a dummy/place-holder value instead of 'undefined' since we-- can't throw exceptions. But that behaviour should not be relied-- upon.---- NB: @isValidBigNat# nullBigNat@ is falsenullBigNat::BigNatnullBigNat=runS(newBigNat#0#>>=unsafeFreezeBigNat#){-# NOINLINEnullBigNat#-}-- | Test for special 0-sized 'BigNat' representing underflows.isNullBigNat#::BigNat->Int#isNullBigNat#(BN#ba#)=sizeofByteArray#ba#==#0#-- | Construct 1-limb 'BigNat' from 'Word#'wordToBigNat::Word#->BigNatwordToBigNat0##=zeroBigNatwordToBigNat1##=oneBigNatwordToBigNatw#|isTrue#(not#w#`eqWord#`0##)=czeroBigNat|True=runS$dombn<-newBigNat#1#_<-svoid(writeBigNat#mbn0#w#)unsafeFreezeBigNat#mbn-- | Construct BigNat from 2 limbs.-- The first argument is the most-significant limb.wordToBigNat2::Word#->Word#->BigNatwordToBigNat20##lw#=wordToBigNatlw#wordToBigNat2hw#lw#=runS$dombn<-newBigNat#2#_<-svoid(writeBigNat#mbn0#lw#)_<-svoid(writeBigNat#mbn1#hw#)unsafeFreezeBigNat#mbnplusBigNat::BigNat->BigNat->BigNatplusBigNatxy|isTrue#(eqBigNatWord#x0##)=y|isTrue#(eqBigNatWord#y0##)=x|isTrue#(nx#>=#ny#)=goxnx#yny#|True=goyny#xnx#wherego(BN#a#)na#(BN#b#)nb#=runS$dombn@(MBN#mba#)<-newBigNat#na#(W#c#)<-liftIO(c_mpn_addmba#a#na#b#nb#)casec#of0##->unsafeFreezeBigNat#mbn_->unsafeSnocFreezeBigNat#mbnc#nx#=sizeofBigNat#xny#=sizeofBigNat#yplusBigNatWord::BigNat->GmpLimb#->BigNatplusBigNatWordx0##=xplusBigNatWordx@(BN#x#)y#=runS$dombn@(MBN#mba#)<-newBigNat#nx#(W#c#)<-liftIO(c_mpn_add_1mba#x#nx#y#)casec#of0##->unsafeFreezeBigNat#mbn_->unsafeSnocFreezeBigNat#mbnc#wherenx#=sizeofBigNat#x-- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflowminusBigNat::BigNat->BigNat->BigNatminusBigNatx@(BN#x#)y@(BN#y#)|isZeroBigNaty=x|isTrue#(nx#>=#ny#)=runS$dombn@(MBN#mba#)<-newBigNat#nx#(W#b#)<-liftIO(c_mpn_submba#x#nx#y#ny#)caseb#of0##->unsafeRenormFreezeBigNat#mbn_->returnnullBigNat|True=nullBigNatwherenx#=sizeofBigNat#xny#=sizeofBigNat#y-- | Returns 'nullBigNat' (see 'isNullBigNat#') in case of underflowminusBigNatWord::BigNat->GmpLimb#->BigNatminusBigNatWordx0##=xminusBigNatWordx@(BN#x#)y#=runS$dombn@(MBN#mba#)<-newBigNat#nx#(W#b#)<-liftIO$c_mpn_sub_1mba#x#nx#y#caseb#of0##->unsafeRenormFreezeBigNat#mbn_->returnnullBigNatwherenx#=sizeofBigNat#xtimesBigNat::BigNat->BigNat->BigNattimesBigNatxy|isZeroBigNatx=zeroBigNat|isZeroBigNaty=zeroBigNat|isTrue#(nx#>=#ny#)=goxnx#yny#|True=goyny#xnx#wherego(BN#a#)na#(BN#b#)nb#=runS$doletn#=nx#+#ny#mbn@(MBN#mba#)<-newBigNat#n#(W#msl#)<-liftIO(c_mpn_mulmba#a#na#b#nb#)casemsl#of0##->unsafeShrinkFreezeBigNat#mbn(n#-#1#)_->unsafeFreezeBigNat#mbnnx#=sizeofBigNat#xny#=sizeofBigNat#y-- | Square 'BigNat'sqrBigNat::BigNat->BigNatsqrBigNatx|isZeroBigNatx=zeroBigNat-- TODO: 1-limb BigNats below sqrt(maxBound::GmpLimb)sqrBigNatx=timesBigNatxx-- TODO: mpn_sqrtimesBigNatWord::BigNat->GmpLimb#->BigNattimesBigNatWord!_0##=zeroBigNattimesBigNatWordx1##=xtimesBigNatWordx@(BN#x#)y#|isTrue#(nx#==#1#)=let!(#!h#,!l##)=timesWord2#(bigNatToWordx)y#inwordToBigNat2h#l#|True=runS$dombn@(MBN#mba#)<-newBigNat#nx#(W#msl#)<-liftIO(c_mpn_mul_1mba#x#nx#y#)casemsl#of0##->unsafeFreezeBigNat#mbn_->unsafeSnocFreezeBigNat#mbnmsl#wherenx#=sizeofBigNat#x-- | Specialised version of---- > bitBigNat = shiftLBigNat (wordToBigNat 1##)---- avoiding a few redundant allocationsbitBigNat::Int#->BigNatbitBigNati#|isTrue#(i#<#0#)=zeroBigNat-- or maybe 'nullBigNat'?|isTrue#(i#==#0#)=oneBigNat|True=runS$dombn@(MBN#mba#)<-newBigNat#(li#+#1#)-- FIXME: do we really need to zero-init MBAs returned by 'newByteArray#'?-- clear all limbs (except for the most-significant limb)_<-svoid(clearWordArray#mba#0#li#)-- set single bit in most-significant limb_<-svoid(writeBigNat#mbnli#(uncheckedShiftL#1##bi#))unsafeFreezeBigNat#mbnwhere!(#li#,bi##)=quotRemInt#i#GMP_LIMB_BITS#testBitBigNat::BigNat->Int#->BooltestBitBigNatbni#|isTrue#(i#<#0#)=False|isTrue#(li#<#nx#)=isTrue#(testBitWord#(indexBigNat#bnli#)bi#)|True=Falsewhere!(#li#,bi##)=quotRemInt#i#GMP_LIMB_BITS#nx#=sizeofBigNat#bntestBitNegBigNat::BigNat->Int#->BooltestBitNegBigNatbni#|isTrue#(i#<#0#)=False|isTrue#(li#>=#nx#)=True|allZli#=isTrue#((testBitWord#(indexBigNat#bnli#`minusWord#`1##)bi#)==#0#)|True=isTrue#((testBitWord#(indexBigNat#bnli#)bi#)==#0#)where!(#li#,bi##)=quotRemInt#i#GMP_LIMB_BITS#nx#=sizeofBigNat#bnallZ0#=TrueallZj|isTrue#(indexBigNat#bn(j-#1#)`eqWord#`0##)=allZ(j-#1#)|True=FalseclearBitBigNat::BigNat->Int#->BigNatclearBitBigNatbni#|not(inlinetestBitBigNatbni#)=bn|isTrue#(nx#==#1#)=wordToBigNat(bigNatToWordbn`xor#`bitWord#bi#)|isTrue#(li#+#1#==#nx#)=-- special case, operating on most-sig limbcaseindexBigNat#bnli#`xor#`bitWord#bi#of0##->do-- most-sig limb became zero -> result has less limbscasefmsslbn(li#-#1#)of0#->zeroBigNatn#->runS$dombn<-newBigNat#n#_<-copyWordArraybn0#mbn0#n#unsafeFreezeBigNat#mbnnewlimb#->runS$do-- no shrinkingmbn<-newBigNat#nx#_<-copyWordArraybn0#mbn0#li#_<-svoid(writeBigNat#mbnli#newlimb#)unsafeFreezeBigNat#mbn|True=runS$dombn<-newBigNat#nx#_<-copyWordArraybn0#mbn0#nx#letnewlimb#=indexBigNat#bnli#`xor#`bitWord#bi#_<-svoid(writeBigNat#mbnli#newlimb#)unsafeFreezeBigNat#mbnwhere!(#li#,bi##)=quotRemInt#i#GMP_LIMB_BITS#nx#=sizeofBigNat#bnsetBitBigNat::BigNat->Int#->BigNatsetBitBigNatbni#|inlinetestBitBigNatbni#=bn|isTrue#(d#>#0#)=runS$do-- result BigNat will have more limbsmbn@(MBN#mba#)<-newBigNat#(li#+#1#)_<-copyWordArraybn0#mbn0#nx#_<-svoid(clearWordArray#mba#nx#(d#-#1#))_<-svoid(writeBigNat#mbnli#(bitWord#bi#))unsafeFreezeBigNat#mbn|True=runS$dombn<-newBigNat#nx#_<-copyWordArraybn0#mbn0#nx#_<-svoid(writeBigNat#mbnli#(indexBigNat#bnli#`or#`bitWord#bi#))unsafeFreezeBigNat#mbnwhere!(#li#,bi##)=quotRemInt#i#GMP_LIMB_BITS#nx#=sizeofBigNat#bnd#=li#+#1#-#nx#complementBitBigNat::BigNat->Int#->BigNatcomplementBitBigNatbni#|testBitBigNatbni#=clearBitBigNatbni#|True=setBitBigNatbni#popCountBigNat::BigNat->Int#popCountBigNatbn@(BN#ba#)=word2Int#(c_mpn_popcountba#(sizeofBigNat#bn))shiftLBigNat::BigNat->Int#->BigNatshiftLBigNatx0#=xshiftLBigNatx_|isZeroBigNatx=zeroBigNatshiftLBigNatx@(BN#xba#)n#=runS$doymbn@(MBN#ymba#)<-newBigNat#yn#W#ymsl<-liftIO(c_mpn_lshiftymba#xba#xn#(int2Word#n#))caseymslof0##->unsafeShrinkFreezeBigNat#ymbn(yn#-#1#)_->unsafeFreezeBigNat#ymbnwherexn#=sizeofBigNat#xyn#=xn#+#nlimbs#+#(nbits#/=#0#)!(#nlimbs#,nbits##)=quotRemInt#n#GMP_LIMB_BITS#shiftRBigNat::BigNat->Int#->BigNatshiftRBigNatx0#=xshiftRBigNatx_|isZeroBigNatx=zeroBigNatshiftRBigNatx@(BN#xba#)n#|isTrue#(nlimbs#>=#xn#)=zeroBigNat|True=runS$doymbn@(MBN#ymba#)<-newBigNat#yn#W#ymsl<-liftIO(c_mpn_rshiftymba#xba#xn#(int2Word#n#))caseymslof0##->unsafeRenormFreezeBigNat#ymbn-- may shrink more than one_->unsafeFreezeBigNat#ymbnwherexn#=sizeofBigNat#xyn#=xn#-#nlimbs#nlimbs#=quotInt#n#GMP_LIMB_BITS#shiftRNegBigNat::BigNat->Int#->BigNatshiftRNegBigNatx0#=xshiftRNegBigNatx_|isZeroBigNatx=zeroBigNatshiftRNegBigNatx@(BN#xba#)n#|isTrue#(nlimbs#>=#xn#)=zeroBigNat|True=runS$doymbn@(MBN#ymba#)<-newBigNat#yn#W#ymsl<-liftIO(c_mpn_rshift_2cymba#xba#xn#(int2Word#n#))caseymslof0##->unsafeRenormFreezeBigNat#ymbn-- may shrink more than one_->unsafeFreezeBigNat#ymbnwherexn#=sizeofBigNat#xyn#=xn#-#nlimbs#nlimbs#=quotInt#(n#-#1#)GMP_LIMB_BITS#orBigNat::BigNat->BigNat->BigNatorBigNatx@(BN#x#)y@(BN#y#)|isZeroBigNatx=y|isZeroBigNaty=x|isTrue#(nx#>=#ny#)=runS(ior'x#nx#y#ny#)|True=runS(ior'y#ny#x#nx#)whereior'a#na#b#nb#=do-- na >= nbmbn@(MBN#mba#)<-newBigNat#na#_<-liftIO(c_mpn_ior_nmba#a#b#nb#)_<-caseisTrue#(na#==#nb#)ofFalse->svoid(copyWordArray#a#nb#mba#nb#(na#-#nb#))True->return()unsafeFreezeBigNat#mbnnx#=sizeofBigNat#xny#=sizeofBigNat#yxorBigNat::BigNat->BigNat->BigNatxorBigNatx@(BN#x#)y@(BN#y#)|isZeroBigNatx=y|isZeroBigNaty=x|isTrue#(nx#>=#ny#)=runS(xor'x#nx#y#ny#)|True=runS(xor'y#ny#x#nx#)wherexor'a#na#b#nb#=do-- na >= nbmbn@(MBN#mba#)<-newBigNat#na#_<-liftIO(c_mpn_xor_nmba#a#b#nb#)caseisTrue#(na#==#nb#)ofFalse->do_<-svoid(copyWordArray#a#nb#mba#nb#(na#-#nb#))unsafeFreezeBigNat#mbnTrue->unsafeRenormFreezeBigNat#mbnnx#=sizeofBigNat#xny#=sizeofBigNat#y-- | aka @\x y -> x .&. (complement y)@andnBigNat::BigNat->BigNat->BigNatandnBigNatx@(BN#x#)y@(BN#y#)|isZeroBigNatx=zeroBigNat|isZeroBigNaty=x|True=runS$dombn@(MBN#mba#)<-newBigNat#nx#_<-liftIO(c_mpn_andn_nmba#x#y#n#)_<-caseisTrue#(nx#==#n#)ofFalse->svoid(copyWordArray#x#n#mba#n#(nx#-#n#))True->return()unsafeRenormFreezeBigNat#mbnwheren#|isTrue#(nx#<#ny#)=nx#|True=ny#nx#=sizeofBigNat#xny#=sizeofBigNat#yandBigNat::BigNat->BigNat->BigNatandBigNatx@(BN#x#)y@(BN#y#)|isZeroBigNatx=zeroBigNat|isZeroBigNaty=zeroBigNat|True=runS$dombn@(MBN#mba#)<-newBigNat#n#_<-liftIO(c_mpn_and_nmba#x#y#n#)unsafeRenormFreezeBigNat#mbnwheren#|isTrue#(nx#<#ny#)=nx#|True=ny#nx#=sizeofBigNat#xny#=sizeofBigNat#y-- | If divisor is zero, @(\# 'nullBigNat', 'nullBigNat' \#)@ is returnedquotRemBigNat::BigNat->BigNat->(#BigNat,BigNat#)quotRemBigNatn@(BN#nba#)d@(BN#dba#)|isZeroBigNatd=(#nullBigNat,nullBigNat#)|eqBigNatWordd1##=(#n,zeroBigNat#)|n<d=(#zeroBigNat,n#)|True=caserunSgoof(!q,!r)->(#q,r#)wherenn#=sizeofBigNat#ndn#=sizeofBigNat#dqn#=1#+#nn#-#dn#rn#=dn#go=doqmbn@(MBN#qmba#)<-newBigNat#qn#rmbn@(MBN#rmba#)<-newBigNat#rn#_<-liftIO(c_mpn_tdiv_qrqmba#rmba#0#nba#nn#dba#dn#)q<-unsafeRenormFreezeBigNat#qmbnr<-unsafeRenormFreezeBigNat#rmbnreturn(q,r)quotBigNat::BigNat->BigNat->BigNatquotBigNatn@(BN#nba#)d@(BN#dba#)|isZeroBigNatd=nullBigNat|eqBigNatWordd1##=n|n<d=zeroBigNat|True=runS$doletnn#=sizeofBigNat#nletdn#=sizeofBigNat#dletqn#=1#+#nn#-#dn#qmbn@(MBN#qmba#)<-newBigNat#qn#_<-liftIO(c_mpn_tdiv_qqmba#nba#nn#dba#dn#)unsafeRenormFreezeBigNat#qmbnremBigNat::BigNat->BigNat->BigNatremBigNatn@(BN#nba#)d@(BN#dba#)|isZeroBigNatd=nullBigNat|eqBigNatWordd1##=zeroBigNat|n<d=n|True=runS$doletnn#=sizeofBigNat#nletdn#=sizeofBigNat#drmbn@(MBN#rmba#)<-newBigNat#dn#_<-liftIO(c_mpn_tdiv_rrmba#nba#nn#dba#dn#)unsafeRenormFreezeBigNat#rmbn-- | Note: Result of div/0 undefinedquotRemBigNatWord::BigNat->GmpLimb#->(#BigNat,GmpLimb##)quotRemBigNatWord!_0##=(#nullBigNat,0###)quotRemBigNatWordn1##=(#n,0###)quotRemBigNatWordn@(BN#nba#)d#=casecompareBigNatWordnd#ofLT->(#zeroBigNat,bigNatToWordn#)EQ->(#oneBigNat,0###)GT->caserunSgoof(!q,!(W#r#))->(#q,r##)-- TODO: handle word/wordwherego=doletnn#=sizeofBigNat#nqmbn@(MBN#qmba#)<-newBigNat#nn#r<-liftIO(c_mpn_divrem_1qmba#0#nba#nn#d#)q<-unsafeRenormFreezeBigNat#qmbnreturn(q,r)quotBigNatWord::BigNat->GmpLimb#->BigNatquotBigNatWordnd#=caseinlinequotRemBigNatWordnd#of(#q,_#)->q-- | div/0 not checkedremBigNatWord::BigNat->GmpLimb#->Word#remBigNatWordn@(BN#nba#)d#=c_mpn_mod_1nba#(sizeofBigNat#n)d#gcdBigNatWord::BigNat->Word#->Word#gcdBigNatWordbn@(BN#ba#)=c_mpn_gcd_1#ba#(sizeofBigNat#bn)gcdBigNat::BigNat->BigNat->BigNatgcdBigNatx@(BN#x#)y@(BN#y#)|isZeroBigNatx=y|isZeroBigNaty=x|isTrue#(nx#>=#ny#)=runS(gcd'x#nx#y#ny#)|True=runS(gcd'y#ny#x#nx#)wheregcd'a#na#b#nb#=do-- na >= nbmbn@(MBN#mba#)<-newBigNat#nb#I#rn'#<-liftIO(c_mpn_gcd#mba#a#na#b#nb#)letrn#=narrowGmpSize#rn'#caseisTrue#(rn#==#nb#)ofFalse->unsafeShrinkFreezeBigNat#mbnrn#True->unsafeFreezeBigNat#mbnnx#=sizeofBigNat#xny#=sizeofBigNat#y-- | Extended euclidean algorithm.---- For @/a/@ and @/b/@, compute their greatest common divisor @/g/@-- and the coefficient @/s/@ satisfying @/a//s/ + /b//t/ = /g/@.---- @since 0.5.1.0{-# NOINLINEgcdExtInteger#-}gcdExtInteger::Integer->Integer->(#Integer,Integer#)gcdExtIntegerab=casegcdExtSBigNata'b'of(#g,s#)->let!g'=bigNatToIntegerg!s'=sBigNatToIntegersin(#g',s'#)wherea'=integerToSBigNatab'=integerToSBigNatb-- internal helpergcdExtSBigNat::SBigNat->SBigNat->(#BigNat,SBigNat#)gcdExtSBigNatxy=caserunSgoof(g,s)->(#g,s#)wherego=dog@(MBN#g#)<-newBigNat#gn0#s@(MBN#s#)<-newBigNat#(absI#xn#)I#ssn_#<-liftIO(integer_gmp_gcdext#s#g#x#xn#y#yn#)letssn#=narrowGmpSize#ssn_#sn#=absI#ssn#s'<-unsafeShrinkFreezeBigNat#ssn#g'<-unsafeRenormFreezeBigNat#gcaseisTrue#(ssn#>=#0#)ofFalse->return(g',NegBNs')True->return(g',PosBNs')!(BN#x#)=absSBigNatx!(BN#y#)=absSBigNatyxn#=ssizeofSBigNat#xyn#=ssizeofSBigNat#ygn0#=minI#(absI#xn#)(absI#yn#)------------------------------------------------------------------------------ modular exponentiation-- | \"@'powModInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to-- exponent @/e/@ modulo @abs(/m/)@.---- Negative exponents are supported if an inverse modulo @/m/@-- exists.---- __Warning__: It's advised to avoid calling this primitive with-- negative exponents unless it is guaranteed the inverse exists, as-- failure to do so will likely cause program abortion due to a-- divide-by-zero fault. See also 'recipModInteger'.---- Future versions of @integer_gmp@ may not support negative @/e/@-- values anymore.---- @since 0.5.1.0{-# NOINLINEpowModInteger#-}powModInteger::Integer->Integer->Integer->IntegerpowModInteger(S#b#)(S#e#)(S#m#)|isTrue#(b#>=#0#),isTrue#(e#>=#0#)=wordToInteger(powModWord(int2Word#b#)(int2Word#e#)(int2Word#(absI#m#)))powModIntegerbem=casemof(S#m#)->wordToInteger(powModSBigNatWordb'e'(int2Word#(absI#m#)))(Jp#m')->bigNatToInteger(powModSBigNatb'e'm')(Jn#m')->bigNatToInteger(powModSBigNatb'e'm')whereb'=integerToSBigNatbe'=integerToSBigNate-- | \"@'powModSecInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to-- exponent @/e/@ modulo @/m/@. It is required that @/e/ >= 0@ and-- @/m/@ is odd.---- This is a \"secure\" variant of 'powModInteger' using the-- @mpz_powm_sec()@ function which is designed to be resilient to side-- channel attacks and is therefore intended for cryptographic-- applications.---- This primitive is only available when the underlying GMP library-- supports it (GMP >= 5). Otherwise, it internally falls back to-- @'powModInteger'@, and a warning will be emitted when used.---- @since 1.0.2.0{-# NOINLINEpowModSecInteger#-}powModSecInteger::Integer->Integer->Integer->IntegerpowModSecIntegerbem=bigNatToInteger(powModSecSBigNatb'e'm')whereb'=integerToSBigNatbe'=integerToSBigNatem'=absSBigNat(integerToSBigNatm)#if HAVE_SECURE_POWM == 0{-# WARNINGpowModSecInteger"The underlying GMP library does not support a secure version of powModInteger which is side-channel resistant - you need at least GMP version 5 to support this"#-}#endif-- | Version of 'powModInteger' operating on 'BigNat's---- @since 1.0.0.0powModBigNat::BigNat->BigNat->BigNat->BigNatpowModBigNatbem=inlinepowModSBigNat(PosBNb)(PosBNe)m-- | Version of 'powModInteger' for 'Word#'-sized moduli---- @since 1.0.0.0powModBigNatWord::BigNat->BigNat->GmpLimb#->GmpLimb#powModBigNatWordbem#=inlinepowModSBigNatWord(PosBNb)(PosBNe)m#-- | Version of 'powModInteger' operating on 'Word#'s---- @since 1.0.0.0foreignimportccallunsafe"integer_gmp_powm_word"powModWord::GmpLimb#->GmpLimb#->GmpLimb#->GmpLimb#-- internal non-exported helperpowModSBigNat::SBigNat->SBigNat->BigNat->BigNatpowModSBigNatbem@(BN#m#)=runS$dor@(MBN#r#)<-newBigNat#mn#I#rn_#<-liftIO(integer_gmp_powm#r#b#bn#e#en#m#mn#)letrn#=narrowGmpSize#rn_#caseisTrue#(rn#==#mn#)ofFalse->unsafeShrinkFreezeBigNat#rrn#True->unsafeFreezeBigNat#rwhere!(BN#b#)=absSBigNatb!(BN#e#)=absSBigNatebn#=ssizeofSBigNat#ben#=ssizeofSBigNat#emn#=sizeofBigNat#mforeignimportccallunsafe"integer_gmp_powm"integer_gmp_powm#::MutableByteArray#RealWorld->ByteArray#->GmpSize#->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IOGmpSize-- internal non-exported helperpowModSBigNatWord::SBigNat->SBigNat->GmpLimb#->GmpLimb#powModSBigNatWordbem#=integer_gmp_powm1#b#bn#e#en#m#where!(BN#b#)=absSBigNatb!(BN#e#)=absSBigNatebn#=ssizeofSBigNat#ben#=ssizeofSBigNat#eforeignimportccallunsafe"integer_gmp_powm1"integer_gmp_powm1#::ByteArray#->GmpSize#->ByteArray#->GmpSize#->GmpLimb#->GmpLimb#-- internal non-exported helperpowModSecSBigNat::SBigNat->SBigNat->BigNat->BigNatpowModSecSBigNatbem@(BN#m#)=runS$dor@(MBN#r#)<-newBigNat#mn#I#rn_#<-liftIO(integer_gmp_powm_sec#r#b#bn#e#en#m#mn#)letrn#=narrowGmpSize#rn_#caseisTrue#(rn#==#mn#)ofFalse->unsafeShrinkFreezeBigNat#rrn#True->unsafeFreezeBigNat#rwhere!(BN#b#)=absSBigNatb!(BN#e#)=absSBigNatebn#=ssizeofSBigNat#ben#=ssizeofSBigNat#emn#=sizeofBigNat#mforeignimportccallunsafe"integer_gmp_powm_sec"integer_gmp_powm_sec#::MutableByteArray#RealWorld->ByteArray#->GmpSize#->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IOGmpSize-- | \"@'recipModInteger' /x/ /m/@\" computes the inverse of @/x/@ modulo @/m/@. If-- the inverse exists, the return value @/y/@ will satisfy @0 < /y/ <-- abs(/m/)@, otherwise the result is @0@.---- @since 0.5.1.0{-# NOINLINErecipModInteger#-}recipModInteger::Integer->Integer->IntegerrecipModInteger(S#x#)(S#m#)|isTrue#(x#>=#0#)=wordToInteger(recipModWord(int2Word#x#)(int2Word#(absI#m#)))recipModIntegerxm=bigNatToInteger(recipModSBigNatx'm')wherex'=integerToSBigNatxm'=absSBigNat(integerToSBigNatm)-- | Version of 'recipModInteger' operating on 'BigNat's---- @since 1.0.0.0recipModBigNat::BigNat->BigNat->BigNatrecipModBigNatxm=inlinerecipModSBigNat(PosBNx)m-- | Version of 'recipModInteger' operating on 'Word#'s---- @since 1.0.0.0foreignimportccallunsafe"integer_gmp_invert_word"recipModWord::GmpLimb#->GmpLimb#->GmpLimb#-- internal non-exported helperrecipModSBigNat::SBigNat->BigNat->BigNatrecipModSBigNatxm@(BN#m#)=runS$dor@(MBN#r#)<-newBigNat#mn#I#rn_#<-liftIO(integer_gmp_invert#r#x#xn#m#mn#)letrn#=narrowGmpSize#rn_#caseisTrue#(rn#==#mn#)ofFalse->unsafeShrinkFreezeBigNat#rrn#True->unsafeFreezeBigNat#rwhere!(BN#x#)=absSBigNatxxn#=ssizeofSBigNat#xmn#=sizeofBigNat#mforeignimportccallunsafe"integer_gmp_invert"integer_gmp_invert#::MutableByteArray#RealWorld->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IOGmpSize------------------------------------------------------------------------------ Conversions to/from floating pointdecodeDoubleInteger::Double#->(#Integer,Int##)-- decodeDoubleInteger 0.0## = (# S# 0#, 0# #)#if WORD_SIZE_IN_BITS == 64decodeDoubleIntegerx=casedecodeDouble_Int64#xof(#m#,e##)->(#S#m#,e##)#elif WORD_SIZE_IN_BITS == 32decodeDoubleIntegerx=casedecodeDouble_Int64#xof(#m#,e##)->(#int64ToIntegerm#,e##)#endif{-# CONSTANT_FOLDED decodeDoubleInteger #-}-- provided by GHC's RTSforeignimportccallunsafe"__int_encodeDouble"int_encodeDouble#::Int#->Int#->Double#encodeDoubleInteger::Integer->Int#->Double#encodeDoubleInteger(S#m#)0#=int2Double#m#encodeDoubleInteger(S#m#)e#=int_encodeDouble#m#e#encodeDoubleInteger(Jp#bn@(BN#bn#))e#=c_mpn_get_dbn#(sizeofBigNat#bn)e#encodeDoubleInteger(Jn#bn@(BN#bn#))e#=c_mpn_get_dbn#(negateInt#(sizeofBigNat#bn))e#{-# CONSTANT_FOLDED encodeDoubleInteger #-}-- double integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn)foreignimportccallunsafe"integer_gmp_mpn_get_d"c_mpn_get_d::ByteArray#->GmpSize#->Int#->Double#doubleFromInteger::Integer->Double#doubleFromInteger(S#m#)=int2Double#m#doubleFromInteger(Jp#bn@(BN#bn#))=c_mpn_get_dbn#(sizeofBigNat#bn)0#doubleFromInteger(Jn#bn@(BN#bn#))=c_mpn_get_dbn#(negateInt#(sizeofBigNat#bn))0#{-# CONSTANT_FOLDED doubleFromInteger #-}-- TODO: Not sure if it's worth to write 'Float' optimized versions herefloatFromInteger::Integer->Float#floatFromIntegeri=double2Float#(doubleFromIntegeri)encodeFloatInteger::Integer->Int#->Float#encodeFloatIntegerme=double2Float#(encodeDoubleIntegerme)------------------------------------------------------------------------------ FFI ccall importsforeignimportccallunsafe"integer_gmp_gcd_word"gcdWord#::GmpLimb#->GmpLimb#->GmpLimb#foreignimportccallunsafe"integer_gmp_mpn_gcd_1"c_mpn_gcd_1#::ByteArray#->GmpSize#->GmpLimb#->GmpLimb#foreignimportccallunsafe"integer_gmp_mpn_gcd"c_mpn_gcd#::MutableByteArray#s->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IOGmpSizeforeignimportccallunsafe"integer_gmp_gcdext"integer_gmp_gcdext#::MutableByteArray#s->MutableByteArray#s->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IOGmpSize-- mp_limb_t mpn_add_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,--                      mp_limb_t s2limb)foreignimportccallunsafe"gmp.h __gmpn_add_1"c_mpn_add_1::MutableByteArray#s->ByteArray#->GmpSize#->GmpLimb#->IOGmpLimb-- mp_limb_t mpn_sub_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,--                      mp_limb_t s2limb)foreignimportccallunsafe"gmp.h __gmpn_sub_1"c_mpn_sub_1::MutableByteArray#s->ByteArray#->GmpSize#->GmpLimb#->IOGmpLimb-- mp_limb_t mpn_mul_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n,--                      mp_limb_t s2limb)foreignimportccallunsafe"gmp.h __gmpn_mul_1"c_mpn_mul_1::MutableByteArray#s->ByteArray#->GmpSize#->GmpLimb#->IOGmpLimb-- mp_limb_t mpn_add (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,--                    const mp_limb_t *s2p, mp_size_t s2n)foreignimportccallunsafe"gmp.h __gmpn_add"c_mpn_add::MutableByteArray#s->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IOGmpLimb-- mp_limb_t mpn_sub (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,--                    const mp_limb_t *s2p, mp_size_t s2n)foreignimportccallunsafe"gmp.h __gmpn_sub"c_mpn_sub::MutableByteArray#s->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IOGmpLimb-- mp_limb_t mpn_mul (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n,--                    const mp_limb_t *s2p, mp_size_t s2n)foreignimportccallunsafe"gmp.h __gmpn_mul"c_mpn_mul::MutableByteArray#s->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IOGmpLimb-- int mpn_cmp (const mp_limb_t *s1p, const mp_limb_t *s2p, mp_size_t n)foreignimportccallunsafe"gmp.h __gmpn_cmp"c_mpn_cmp::ByteArray#->ByteArray#->GmpSize#->CInt#-- void mpn_tdiv_qr (mp_limb_t *qp, mp_limb_t *rp, mp_size_t qxn,--                   const mp_limb_t *np, mp_size_t nn,--                   const mp_limb_t *dp, mp_size_t dn)foreignimportccallunsafe"gmp.h __gmpn_tdiv_qr"c_mpn_tdiv_qr::MutableByteArray#s->MutableByteArray#s->GmpSize#->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IO()foreignimportccallunsafe"integer_gmp_mpn_tdiv_q"c_mpn_tdiv_q::MutableByteArray#s->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IO()foreignimportccallunsafe"integer_gmp_mpn_tdiv_r"c_mpn_tdiv_r::MutableByteArray#s->ByteArray#->GmpSize#->ByteArray#->GmpSize#->IO()-- mp_limb_t mpn_divrem_1 (mp_limb_t *r1p, mp_size_t qxn, mp_limb_t *s2p,--                         mp_size_t s2n, mp_limb_t s3limb)foreignimportccallunsafe"gmp.h __gmpn_divrem_1"c_mpn_divrem_1::MutableByteArray#s->GmpSize#->ByteArray#->GmpSize#->GmpLimb#->IOGmpLimb-- mp_limb_t mpn_mod_1 (const mp_limb_t *s1p, mp_size_t s1n, mp_limb_t s2limb)foreignimportccallunsafe"gmp.h __gmpn_mod_1"c_mpn_mod_1::ByteArray#->GmpSize#->GmpLimb#->GmpLimb#-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],--                                   mp_size_t sn, mp_bitcnt_t count)foreignimportccallunsafe"integer_gmp_mpn_rshift"c_mpn_rshift::MutableByteArray#s->ByteArray#->GmpSize#->GmpBitCnt#->IOGmpLimb-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[],--                                   mp_size_t sn, mp_bitcnt_t count)foreignimportccallunsafe"integer_gmp_mpn_rshift_2c"c_mpn_rshift_2c::MutableByteArray#s->ByteArray#->GmpSize#->GmpBitCnt#->IOGmpLimb-- mp_limb_t integer_gmp_mpn_lshift (mp_limb_t rp[], const mp_limb_t sp[],--                                   mp_size_t sn, mp_bitcnt_t count)foreignimportccallunsafe"integer_gmp_mpn_lshift"c_mpn_lshift::MutableByteArray#s->ByteArray#->GmpSize#->GmpBitCnt#->IOGmpLimb-- void mpn_and_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,--                 mp_size_t n)foreignimportccallunsafe"integer_gmp_mpn_and_n"c_mpn_and_n::MutableByteArray#s->ByteArray#->ByteArray#->GmpSize#->IO()-- void mpn_andn_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,--                  mp_size_t n)foreignimportccallunsafe"integer_gmp_mpn_andn_n"c_mpn_andn_n::MutableByteArray#s->ByteArray#->ByteArray#->GmpSize#->IO()-- void mpn_ior_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,--                 mp_size_t n)foreignimportccallunsafe"integer_gmp_mpn_ior_n"c_mpn_ior_n::MutableByteArray#s->ByteArray#->ByteArray#->GmpSize#->IO()-- void mpn_xor_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p,--                 mp_size_t n)foreignimportccallunsafe"integer_gmp_mpn_xor_n"c_mpn_xor_n::MutableByteArray#s->ByteArray#->ByteArray#->GmpSize#->IO()-- mp_bitcnt_t mpn_popcount (const mp_limb_t *s1p, mp_size_t n)foreignimportccallunsafe"gmp.h __gmpn_popcount"c_mpn_popcount::ByteArray#->GmpSize#->GmpBitCnt#------------------------------------------------------------------------------ BigNat-wrapped ByteArray#-primops-- | Return number of limbs contained in 'BigNat'.sizeofBigNat#::BigNat->GmpSize#sizeofBigNat#(BN#x#)=sizeofByteArray#x#`uncheckedIShiftRL#`GMP_LIMB_SHIFT#dataMutBigNats=MBN#!(MutableByteArray#s)getSizeofMutBigNat#::MutBigNats->State#s->(#State#s,GmpSize##)--getSizeofMutBigNat# :: MutBigNat s -> S s GmpSize#getSizeofMutBigNat#(MBN#x#)s=casegetSizeofMutableByteArray#x#sof(#s',n##)->(#s',n#`uncheckedIShiftRL#`GMP_LIMB_SHIFT##)newBigNat#::GmpSize#->Ss(MutBigNats)newBigNat#limbs#s=casenewByteArray#(limbs#`uncheckedIShiftL#`GMP_LIMB_SHIFT#)sof(#s',mba##)->(#s',MBN#mba##)writeBigNat#::MutBigNats->GmpSize#->GmpLimb#->State#s->State#swriteBigNat#(MBN#mba#)=writeWordArray#mba#-- | Extract /n/-th (0-based) limb in 'BigNat'.-- /n/ must be less than size as reported by 'sizeofBigNat#'.indexBigNat#::BigNat->GmpSize#->GmpLimb#indexBigNat#(BN#ba#)=indexWordArray#ba#unsafeFreezeBigNat#::MutBigNats->SsBigNatunsafeFreezeBigNat#(MBN#mba#)s=caseunsafeFreezeByteArray#mba#sof(#s',ba##)->(#s',BN#ba##)resizeMutBigNat#::MutBigNats->GmpSize#->Ss(MutBigNats)resizeMutBigNat#(MBN#mba0#)nsz#s|isTrue#(bsz#==#n#)=(#s',MBN#mba0##)|True=caseresizeMutableByteArray#mba0#bsz#s'of(#s'',mba##)->(#s'',MBN#mba##)wherebsz#=nsz#`uncheckedIShiftL#`GMP_LIMB_SHIFT#!(#s',n##)=getSizeofMutableByteArray#mba0#sshrinkMutBigNat#::MutBigNats->GmpSize#->State#s->State#sshrinkMutBigNat#(MBN#mba0#)nsz#s|isTrue#(bsz#==#n#)=s'-- no-op|True=shrinkMutableByteArray#mba0#bsz#s'wherebsz#=nsz#`uncheckedIShiftL#`GMP_LIMB_SHIFT#!(#s',n##)=getSizeofMutableByteArray#mba0#sunsafeSnocFreezeBigNat#::MutBigNats->GmpLimb#->SsBigNatunsafeSnocFreezeBigNat#mbn0@(MBN#mba0#)limb#s=gos'wheren#=nb0#`uncheckedIShiftRL#`GMP_LIMB_SHIFT#!(#s',nb0##)=getSizeofMutableByteArray#mba0#sgo=do(MBN#mba#)<-resizeMutBigNat#mbn0(n#+#1#)_<-svoid(writeWordArray#mba#n#limb#)unsafeFreezeBigNat#(MBN#mba#)-- | May shrink underlyng 'ByteArray#' if needed to satisfy BigNat invariantunsafeRenormFreezeBigNat#::MutBigNats->SsBigNatunsafeRenormFreezeBigNat#mbns|isTrue#(n0#==#0#)=(#s'',nullBigNat#)|isTrue#(n#==#0#)=(#s'',zeroBigNat#)|isTrue#(n#==#n0#)=(unsafeFreezeBigNat#mbn)s''|True=(unsafeShrinkFreezeBigNat#mbnn#)s''where!(#s',n0##)=getSizeofMutBigNat#mbns!(#s'',n##)=normSizeofMutBigNat'#mbnn0#s'-- | Shrink MBNunsafeShrinkFreezeBigNat#::MutBigNats->GmpSize#->SsBigNatunsafeShrinkFreezeBigNat#x@(MBN#xmba)1#=\s->casereadWordArray#xmba0#sof(#s',w##)->freezeOneLimbw#s'wherefreezeOneLimb0##=returnzeroBigNatfreezeOneLimb1##=returnoneBigNatfreezeOneLimbw#|isTrue#(not#w#`eqWord#`0##)=returnczeroBigNatfreezeOneLimb_=do_<-svoid(shrinkMutBigNat#x1#)unsafeFreezeBigNat#xunsafeShrinkFreezeBigNat#xy#=do_<-svoid(shrinkMutBigNat#xy#)unsafeFreezeBigNat#xcopyWordArray#::ByteArray#->Int#->MutableByteArray#s->Int#->Int#->State#s->State#scopyWordArray#srcsrc_ofsdstdst_ofslen=copyByteArray#src(src_ofs`uncheckedIShiftL#`GMP_LIMB_SHIFT#)dst(dst_ofs`uncheckedIShiftL#`GMP_LIMB_SHIFT#)(len`uncheckedIShiftL#`GMP_LIMB_SHIFT#)copyWordArray::BigNat->Int#->MutBigNats->Int#->Int#->Ss()copyWordArray(BN#ba#)ofs_ba#(MBN#mba#)ofs_mba#len#=svoid(copyWordArray#ba#ofs_ba#mba#ofs_mba#len#)clearWordArray#::MutableByteArray#s->Int#->Int#->State#s->State#sclearWordArray#mbaofslen=setByteArray#mba(ofs`uncheckedIShiftL#`GMP_LIMB_SHIFT#)(len`uncheckedIShiftL#`GMP_LIMB_SHIFT#)0#-- | Version of 'normSizeofMutBigNat'#' which scans all allocated 'MutBigNat#'normSizeofMutBigNat#::MutBigNats->State#s->(#State#s,Int##)normSizeofMutBigNat#mbn@(MBN#mba)s=normSizeofMutBigNat'#mbnsz#s'where!(#s',n##)=getSizeofMutableByteArray#mbassz#=n#`uncheckedIShiftRA#`GMP_LIMB_SHIFT#-- | Find most-significant non-zero limb and return its index-position-- plus one. Start scanning downward from the initial limb-size-- (i.e. start-index plus one) given as second argument.---- NB: The 'normSizeofMutBigNat' of 'zeroBigNat' would be @0#@normSizeofMutBigNat'#::MutBigNats->GmpSize#->State#s->(#State#s,GmpSize##)normSizeofMutBigNat'#(MBN#mba)=gowherego0#s=(#s,0##)goi0#s=casereadWordArray#mba(i0#-#1#)sof(#s',0###)->go(i0#-#1#)s'(#s',_#)->(#s',i0##)-- | Construct 'BigNat' from existing 'ByteArray#' containing /n/-- 'GmpLimb's in least-significant-first order.---- If possible 'ByteArray#', will be used directly (i.e. shared-- /without/ cloning the 'ByteArray#' into a newly allocated one)---- Note: size parameter (times @sizeof(GmpLimb)@) must be less or-- equal to its 'sizeofByteArray#'.byteArrayToBigNat#::ByteArray#->GmpSize#->BigNatbyteArrayToBigNat#ba#n0#|isTrue#(n#==#0#)=zeroBigNat|isTrue#(baszr#==#0#)-- i.e. ba# is multiple of limb-size,isTrue#(baszq#==#n#)=(BN#ba#)|True=runS$\s->let!(#s',mbn@(MBN#mba#)#)=newBigNat#n#s!(#s'',ba_sz##)=getSizeofMutableByteArray#mba#s'go=do_<-svoid(copyByteArray#ba#0#mba#0#ba_sz#)unsafeFreezeBigNat#mbningos''where!(#baszq#,baszr##)=quotRemInt#(sizeofByteArray#ba#)GMP_LIMB_BYTES#n#=fmssl(BN#ba#)(n0#-#1#)-- | Read 'Integer' (without sign) from memory location at @/addr/@ in-- base-256 representation.---- @'importIntegerFromAddr' /addr/ /size/ /msbf/@---- See description of 'importIntegerFromByteArray' for more details.---- @since 1.0.0.0importIntegerFromAddr::Addr#->Word#->Int#->IOIntegerimportIntegerFromAddraddrlenmsbf=IO$dobn<-liftIO(importBigNatFromAddraddrlenmsbf)return(bigNatToIntegerbn)-- | Version of 'importIntegerFromAddr' constructing a 'BigNat'importBigNatFromAddr::Addr#->Word#->Int#->IOBigNatimportBigNatFromAddr_0##_=IO(\s->(#s,zeroBigNat#))importBigNatFromAddraddrlen01#=IO$do-- MSBFW#ofs<-liftIO(c_scan_nzbyte_addraddr0##len0)letlen=len0`minusWord#`ofsaddr'=addr`plusAddr#`(word2Int#ofs)importBigNatFromAddr#addr'len1#importBigNatFromAddraddrlen0_=IO$do-- LSBFW#len<-liftIO(c_rscan_nzbyte_addraddr0##len0)importBigNatFromAddr#addrlen0#foreignimportccallunsafe"integer_gmp_scan_nzbyte"c_scan_nzbyte_addr::Addr#->Word#->Word#->IOWordforeignimportccallunsafe"integer_gmp_rscan_nzbyte"c_rscan_nzbyte_addr::Addr#->Word#->Word#->IOWord-- | Helper for 'importBigNatFromAddr'importBigNatFromAddr#::Addr#->Word#->Int#->SRealWorldBigNatimportBigNatFromAddr#_0##_=returnzeroBigNatimportBigNatFromAddr#addrlenmsbf=dombn@(MBN#mba#)<-newBigNat#n#()<-liftIO(c_mpn_import_addrmba#addr0##lenmsbf)unsafeFreezeBigNat#mbnwhere-- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs requiredn#=(word2Int#len+#(SIZEOF_HSWORD#-#1#))`quotInt#`SIZEOF_HSWORD#foreignimportccallunsafe"integer_gmp_mpn_import"c_mpn_import_addr::MutableByteArray#RealWorld->Addr#->Word#->Word#->Int#->IO()-- | Read 'Integer' (without sign) from byte-array in base-256 representation.---- The call---- @'importIntegerFromByteArray' /ba/ /offset/ /size/ /msbf/@---- reads---- * @/size/@ bytes from the 'ByteArray#' @/ba/@ starting at @/offset/@---- * with most significant byte first if @/msbf/@ is @1#@ or least--   significant byte first if @/msbf/@ is @0#@, and---- * returns a new 'Integer'---- @since 1.0.0.0importIntegerFromByteArray::ByteArray#->Word#->Word#->Int#->IntegerimportIntegerFromByteArraybaofslenmsbf=bigNatToInteger(importBigNatFromByteArraybaofslenmsbf)-- | Version of 'importIntegerFromByteArray' constructing a 'BigNat'importBigNatFromByteArray::ByteArray#->Word#->Word#->Int#->BigNatimportBigNatFromByteArray__0##_=zeroBigNatimportBigNatFromByteArraybaofs0len01#=runS$do-- MSBFW#ofs<-liftIO(c_scan_nzbyte_bytearraybaofs0len0)letlen=(len0`plusWord#`ofs0)`minusWord#`ofsimportBigNatFromByteArray#baofslen1#importBigNatFromByteArraybaofslen0_=runS$do-- LSBFW#len<-liftIO(c_rscan_nzbyte_bytearraybaofslen0)importBigNatFromByteArray#baofslen0#foreignimportccallunsafe"integer_gmp_scan_nzbyte"c_scan_nzbyte_bytearray::ByteArray#->Word#->Word#->IOWordforeignimportccallunsafe"integer_gmp_rscan_nzbyte"c_rscan_nzbyte_bytearray::ByteArray#->Word#->Word#->IOWord-- | Helper for 'importBigNatFromByteArray'importBigNatFromByteArray#::ByteArray#->Word#->Word#->Int#->SRealWorldBigNatimportBigNatFromByteArray#__0##_=returnzeroBigNatimportBigNatFromByteArray#baofslenmsbf=dombn@(MBN#mba#)<-newBigNat#n#()<-liftIO(c_mpn_import_bytearraymba#baofslenmsbf)unsafeFreezeBigNat#mbnwhere-- n = ceiling(len / SIZEOF_HSWORD), i.e. number of limbs requiredn#=(word2Int#len+#(SIZEOF_HSWORD#-#1#))`quotInt#`SIZEOF_HSWORD#foreignimportccallunsafe"integer_gmp_mpn_import"c_mpn_import_bytearray::MutableByteArray#RealWorld->ByteArray#->Word#->Word#->Int#->IO()-- | Test whether all internal invariants are satisfied by 'BigNat' value---- Returns @1#@ if valid, @0#@ otherwise.---- This operation is mostly useful for test-suites and/or code which-- constructs 'Integer' values directly.isValidBigNat#::BigNat->Int#isValidBigNat#(BN#ba#)=(szq#>#0#)`andI#`(szr#==#0#)`andI#`isNorm#whereisNorm#|isTrue#(szq#>#1#)=(indexWordArray#ba#(szq#-#1#))`neWord#`0##|True=1#sz#=sizeofByteArray#ba#!(#szq#,szr##)=quotRemInt#sz#GMP_LIMB_BYTES#-- | Version of 'nextPrimeInteger' operating on 'BigNat's---- @since 1.0.0.0nextPrimeBigNat::BigNat->BigNatnextPrimeBigNatbn@(BN#ba#)=runS$dombn@(MBN#mba#)<-newBigNat#n#(W#c#)<-liftIO(nextPrime#mba#ba#n#)casec#of0##->unsafeFreezeBigNat#mbn_->unsafeSnocFreezeBigNat#mbnc#wheren#=sizeofBigNat#bnforeignimportccallunsafe"integer_gmp_next_prime"nextPrime#::MutableByteArray#RealWorld->ByteArray#->GmpSize#->IOGmpLimb------------------------------------------------------------------------------ monadic combinators for low-level state threadingtypeSsa=State#s->(#State#s,a#)infixl1>>=infixl1>>infixr0${-# INLINE($)#-}($)::(a->b)->a->bf$x=fx{-# INLINE(>>=)#-}(>>=)::Ssa->(a->Ssb)->Ssb(>>=)mk=\s->casemsof(#s',a#)->kas'{-# INLINE(>>)#-}(>>)::Ssa->Ssb->Ssb(>>)mk=\s->casemsof(#s',_#)->ks'{-# INLINEsvoid#-}svoid::(State#s->State#s)->Ss()svoidm0=\s->casem0sofs'->(#s',()#){-# INLINEreturn#-}return::a->Ssareturna=\s->(#s,a#){-# INLINEliftIO#-}liftIO::IOa->SRealWorldaliftIO(IOm)=m-- NB: equivalent of GHC.IO.unsafeDupablePerformIO, see notes thererunS::SRealWorlda->arunSm=caserunRW#mof(#_,a#)->a-- stupid hackfail::[Char]->Ssafails=return(raise#s)------------------------------------------------------------------------------ | Internal helper type for "signed" 'BigNat's---- This is a useful abstraction for operations which support negative-- mp_size_t arguments.dataSBigNat=NegBN!BigNat|PosBN!BigNat-- | Absolute value of 'SBigNat'absSBigNat::SBigNat->BigNatabsSBigNat(NegBNbn)=bnabsSBigNat(PosBNbn)=bn-- | /Signed/ limb count. Negative sizes denote negative integersssizeofSBigNat#::SBigNat->GmpSize#ssizeofSBigNat#(NegBNbn)=negateInt#(sizeofBigNat#bn)ssizeofSBigNat#(PosBNbn)=sizeofBigNat#bn-- | Construct 'SBigNat' from 'Int#' valueintToSBigNat#::Int#->SBigNatintToSBigNat#0#=PosBNzeroBigNatintToSBigNat#1#=PosBNoneBigNatintToSBigNat#(-1#)=NegBNoneBigNatintToSBigNat#i#|isTrue#(i#>#0#)=PosBN(wordToBigNat(int2Word#i#))|True=NegBN(wordToBigNat(int2Word#(negateInt#i#)))-- | Convert 'Integer' into 'SBigNat'integerToSBigNat::Integer->SBigNatintegerToSBigNat(S#i#)=intToSBigNat#i#integerToSBigNat(Jp#bn)=PosBNbnintegerToSBigNat(Jn#bn)=NegBNbn-- | Convert 'SBigNat' into 'Integer'sBigNatToInteger::SBigNat->IntegersBigNatToInteger(NegBNbn)=bigNatToNegIntegerbnsBigNatToInteger(PosBNbn)=bigNatToIntegerbn------------------------------------------------------------------------------ misc helpers, some of these should rather be primitives exported by ghc-primcmpW#::Word#->Word#->OrderingcmpW#x#y#|isTrue#(x#`ltWord#`y#)=LT|isTrue#(x#`eqWord#`y#)=EQ|True=GT{-# INLINEcmpW##-}bitWord#::Int#->Word#bitWord#=uncheckedShiftL#1##{-# INLINEbitWord##-}testBitWord#::Word#->Int#->Int#testBitWord#w#i#=(bitWord#i#`and#`w#)`neWord#`0##{-# INLINEtestBitWord##-}popCntI#::Int#->Int#popCntI#i#=word2Int#(popCnt#(int2Word#i#)){-# INLINEpopCntI##-}-- branchless versionabsI#::Int#->Int#absI#i#=(i#`xorI#`nsign)-#nsignwhere-- nsign = negateInt# (i# <# 0#)nsign=uncheckedIShiftRA#i#(WORD_SIZE_IN_BITS#-#1#)-- branchless versionsgnI#::Int#->Int#sgnI#x#=(x#>#0#)-#(x#<#0#)cmpI#::Int#->Int#->Int#cmpI#x#y#=(x#>#y#)-#(x#<#y#)minI#::Int#->Int#->Int#minI#x#y#|isTrue#(x#<=#y#)=x#|True=y#-- find most-sig set limb, starting at given indexfmssl::BigNat->Int#->Int#fmssl!bni0#=goi0#wheregoi#|isTrue#(i#<#0#)=0#|isTrue#(neWord#(indexBigNat#bni#)0##)=i#+#1#|True=go(i#-#1#)