Movatterモバイル変換

{-# LANGUAGE NoImplicitPrelude #-}{-# LANGUAGE BangPatterns #-}{-# LANGUAGE CPP #-}{-# LANGUAGE MagicHash #-}{-# LANGUAGE UnboxedTuples #-}------------------------------------------------------------------------------- |-- Module      :  GHC.Natural-- Copyright   :  (C) 2014 Herbert Valerio Riedel,--                (C) 2011 Edward Kmett-- License     :  see libraries/base/LICENSE---- Maintainer  :  libraries@haskell.org-- Stability   :  internal-- Portability :  non-portable (GHC Extensions)---- The arbitrary-precision 'Natural' number type.---- __Note__: This is an internal GHC module with an API subject to-- change.  It's recommended use the "Numeric.Natural" module to import-- the 'Natural' type.---- @since 4.8.0.0-----------------------------------------------------------------------------moduleGHC.Natural(-- * The 'Natural' number type---- | __Warning__: The internal implementation of 'Natural'-- (i.e. which constructors are available) depends on the-- 'Integer' backend used!Natural(..),mkNatural,isValidNatural-- * Arithmetic,plusNatural,minusNatural,minusNaturalMaybe,timesNatural,negateNatural,signumNatural,quotRemNatural,quotNatural,remNatural#if defined(MIN_VERSION_integer_gmp),gcdNatural,lcmNatural#endif-- * Bits,andNatural,orNatural,xorNatural,bitNatural,testBitNatural#if defined(MIN_VERSION_integer_gmp),popCountNatural#endif,shiftLNatural,shiftRNatural-- * Conversions,naturalToInteger,naturalToWord,naturalToInt,naturalFromInteger,wordToNatural,intToNatural,naturalToWordMaybe,wordToNatural#,wordToNaturalBase-- * Modular arithmetic,powModNatural)where#include "MachDeps.h"importGHC.ClassesimportGHC.MaybeimportGHC.TypesimportGHC.Primimport{-# SOURCE#-}GHC.Exception.Type(underflowException,divZeroException)#if defined(MIN_VERSION_integer_gmp)importGHC.Integer.GMP.Internals#elseimportGHC.Integer#endifdefault()-- Most high-level operations need to be marked `NOINLINE` as-- otherwise GHC doesn't recognize them and fails to apply constant-- folding to `Natural`-typed expression.---- To this end, the CPP hack below allows to write the pseudo-pragma----   {-# CONSTANT_FOLDED plusNatural #-}---- which is simply expanded into a----   {-# NOINLINE plusNatural #-}--#define CONSTANT_FOLDED NOINLINE--------------------------------------------------------------------------------- Arithmetic underflow--------------------------------------------------------------------------------- We put them here because they are needed relatively early-- in the libraries before the Exception type has been defined yet.{-# NOINLINEunderflowError#-}underflowError::aunderflowError=raise#underflowException{-# NOINLINEdivZeroError#-}divZeroError::adivZeroError=raise#divZeroException--------------------------------------------------------------------------------- Natural type-------------------------------------------------------------------------------#if defined(MIN_VERSION_integer_gmp)-- TODO: if saturated arithmetic is to used, replace 'underflowError' by '0'-- | Type representing arbitrary-precision non-negative integers.---- >>> 2^100 :: Natural-- 1267650600228229401496703205376---- Operations whose result would be negative @'throw' ('Underflow' :: 'ArithException')@,---- >>> -1 :: Natural-- *** Exception: arithmetic underflow---- @since 4.8.0.0dataNatural=NatS#GmpLimb#-- ^ in @[0, maxBound::Word]@|NatJ#{-# UNPACK#-}!BigNat-- ^ in @]maxBound::Word, +inf[@---- __Invariant__: 'NatJ#' is used-- /iff/ value doesn't fit in-- 'NatS#' constructor.-- NB: Order of constructors *must*-- coincide with 'Ord' relationderiving(Eq-- ^ @since 4.8.0.0,Ord-- ^ @since 4.8.0.0)-- | Test whether all internal invariants are satisfied by 'Natural' value---- This operation is mostly useful for test-suites and/or code which-- constructs 'Integer' values directly.---- @since 4.8.0.0isValidNatural::Natural->BoolisValidNatural(NatS#_)=TrueisValidNatural(NatJ#bn)=isTrue#(isValidBigNat#bn)&&isTrue#(sizeofBigNat#bn>#0#)signumNatural::Natural->NaturalsignumNatural(NatS#0##)=NatS#0##signumNatural_=NatS#1##{-# CONSTANT_FOLDED signumNatural #-}negateNatural::Natural->NaturalnegateNatural(NatS#0##)=NatS#0##negateNatural_=underflowError{-# CONSTANT_FOLDED negateNatural #-}-- | @since 4.10.0.0naturalFromInteger::Integer->NaturalnaturalFromInteger(S#i#)|isTrue#(i#>=#0#)=NatS#(int2Word#i#)naturalFromInteger(Jp#bn)=bigNatToNaturalbnnaturalFromInteger_=underflowError{-# CONSTANT_FOLDED naturalFromInteger #-}-- | Compute greatest common divisor.gcdNatural::Natural->Natural->NaturalgcdNatural(NatS#0##)y=ygcdNaturalx(NatS#0##)=xgcdNatural(NatS#1##)_=NatS#1##gcdNatural_(NatS#1##)=NatS#1##gcdNatural(NatJ#x)(NatJ#y)=bigNatToNatural(gcdBigNatxy)gcdNatural(NatJ#x)(NatS#y)=NatS#(gcdBigNatWordxy)gcdNatural(NatS#x)(NatJ#y)=NatS#(gcdBigNatWordyx)gcdNatural(NatS#x)(NatS#y)=NatS#(gcdWordxy)-- | compute least common multiplier.lcmNatural::Natural->Natural->NaturallcmNatural(NatS#0##)_=NatS#0##lcmNatural_(NatS#0##)=NatS#0##lcmNatural(NatS#1##)y=ylcmNaturalx(NatS#1##)=xlcmNaturalxy=(x`quotNatural`(gcdNaturalxy))`timesNatural`y----------------------------------------------------------------------------quotRemNatural::Natural->Natural->(Natural,Natural)quotRemNatural_(NatS#0##)=divZeroErrorquotRemNaturaln(NatS#1##)=(n,NatS#0##)quotRemNaturaln@(NatS#_)(NatJ#_)=(NatS#0##,n)quotRemNatural(NatS#n)(NatS#d)=casequotRemWord#ndof(#q,r#)->(NatS#q,NatS#r)quotRemNatural(NatJ#n)(NatS#d)=casequotRemBigNatWordndof(#q,r#)->(bigNatToNaturalq,NatS#r)quotRemNatural(NatJ#n)(NatJ#d)=casequotRemBigNatndof(#q,r#)->(bigNatToNaturalq,bigNatToNaturalr){-# CONSTANT_FOLDED quotRemNatural #-}quotNatural::Natural->Natural->NaturalquotNatural_(NatS#0##)=divZeroErrorquotNaturaln(NatS#1##)=nquotNatural(NatS#_)(NatJ#_)=NatS#0##quotNatural(NatS#n)(NatS#d)=NatS#(quotWord#nd)quotNatural(NatJ#n)(NatS#d)=bigNatToNatural(quotBigNatWordnd)quotNatural(NatJ#n)(NatJ#d)=bigNatToNatural(quotBigNatnd){-# CONSTANT_FOLDED quotNatural #-}remNatural::Natural->Natural->NaturalremNatural_(NatS#0##)=divZeroErrorremNatural_(NatS#1##)=NatS#0##remNaturaln@(NatS#_)(NatJ#_)=nremNatural(NatS#n)(NatS#d)=NatS#(remWord#nd)remNatural(NatJ#n)(NatS#d)=NatS#(remBigNatWordnd)remNatural(NatJ#n)(NatJ#d)=bigNatToNatural(remBigNatnd){-# CONSTANT_FOLDED remNatural #-}-- | @since 4.X.0.0naturalToInteger::Natural->IntegernaturalToInteger(NatS#w)=wordToIntegerwnaturalToInteger(NatJ#bn)=Jp#bn{-# CONSTANT_FOLDED naturalToInteger #-}andNatural::Natural->Natural->NaturalandNatural(NatS#n)(NatS#m)=NatS#(n`and#`m)andNatural(NatS#n)(NatJ#m)=NatS#(n`and#`bigNatToWordm)andNatural(NatJ#n)(NatS#m)=NatS#(bigNatToWordn`and#`m)andNatural(NatJ#n)(NatJ#m)=bigNatToNatural(andBigNatnm){-# CONSTANT_FOLDED andNatural #-}orNatural::Natural->Natural->NaturalorNatural(NatS#n)(NatS#m)=NatS#(n`or#`m)orNatural(NatS#n)(NatJ#m)=NatJ#(orBigNat(wordToBigNatn)m)orNatural(NatJ#n)(NatS#m)=NatJ#(orBigNatn(wordToBigNatm))orNatural(NatJ#n)(NatJ#m)=NatJ#(orBigNatnm){-# CONSTANT_FOLDED orNatural #-}xorNatural::Natural->Natural->NaturalxorNatural(NatS#n)(NatS#m)=NatS#(n`xor#`m)xorNatural(NatS#n)(NatJ#m)=NatJ#(xorBigNat(wordToBigNatn)m)xorNatural(NatJ#n)(NatS#m)=NatJ#(xorBigNatn(wordToBigNatm))xorNatural(NatJ#n)(NatJ#m)=bigNatToNatural(xorBigNatnm){-# CONSTANT_FOLDED xorNatural #-}bitNatural::Int#->NaturalbitNaturali#|isTrue#(i#<#WORD_SIZE_IN_BITS#)=NatS#(1##`uncheckedShiftL#`i#)|True=NatJ#(bitBigNati#){-# CONSTANT_FOLDED bitNatural #-}testBitNatural::Natural->Int->BooltestBitNatural(NatS#w)(I#i#)|isTrue#(i#<#WORD_SIZE_IN_BITS#)=isTrue#((w`and#`(1##`uncheckedShiftL#`i#))`neWord#`0##)|True=FalsetestBitNatural(NatJ#bn)(I#i#)=testBitBigNatbni#{-# CONSTANT_FOLDED testBitNatural #-}popCountNatural::Natural->IntpopCountNatural(NatS#w)=I#(word2Int#(popCnt#w))popCountNatural(NatJ#bn)=I#(popCountBigNatbn){-# CONSTANT_FOLDED popCountNatural #-}shiftLNatural::Natural->Int->NaturalshiftLNaturaln(I#0#)=nshiftLNatural(NatS#0##)_=NatS#0##shiftLNatural(NatS#1##)(I#i#)=bitNaturali#shiftLNatural(NatS#w)(I#i#)=bigNatToNatural(shiftLBigNat(wordToBigNatw)i#)shiftLNatural(NatJ#bn)(I#i#)=bigNatToNatural(shiftLBigNatbni#){-# CONSTANT_FOLDED shiftLNatural #-}shiftRNatural::Natural->Int->NaturalshiftRNaturaln(I#0#)=nshiftRNatural(NatS#w)(I#i#)|isTrue#(i#>=#WORD_SIZE_IN_BITS#)=NatS#0##|True=NatS#(w`uncheckedShiftRL#`i#)shiftRNatural(NatJ#bn)(I#i#)=bigNatToNatural(shiftRBigNatbni#){-# CONSTANT_FOLDED shiftRNatural #-}------------------------------------------------------------------------------ | 'Natural' AdditionplusNatural::Natural->Natural->NaturalplusNatural(NatS#0##)y=yplusNaturalx(NatS#0##)=xplusNatural(NatS#x)(NatS#y)=caseplusWord2#xyof(#0##,l#)->NatS#l(#h,l#)->NatJ#(wordToBigNat2hl)plusNatural(NatS#x)(NatJ#y)=NatJ#(plusBigNatWordyx)plusNatural(NatJ#x)(NatS#y)=NatJ#(plusBigNatWordxy)plusNatural(NatJ#x)(NatJ#y)=NatJ#(plusBigNatxy){-# CONSTANT_FOLDED plusNatural #-}-- | 'Natural' multiplicationtimesNatural::Natural->Natural->NaturaltimesNatural_(NatS#0##)=NatS#0##timesNatural(NatS#0##)_=NatS#0##timesNaturalx(NatS#1##)=xtimesNatural(NatS#1##)y=ytimesNatural(NatS#x)(NatS#y)=casetimesWord2#xyof(#0##,0###)->NatS#0##(#0##,xy#)->NatS#xy(#h,l#)->NatJ#(wordToBigNat2hl)timesNatural(NatS#x)(NatJ#y)=NatJ#(timesBigNatWordyx)timesNatural(NatJ#x)(NatS#y)=NatJ#(timesBigNatWordxy)timesNatural(NatJ#x)(NatJ#y)=NatJ#(timesBigNatxy){-# CONSTANT_FOLDED timesNatural #-}-- | 'Natural' subtraction. May @'throw' 'Underflow'@.minusNatural::Natural->Natural->NaturalminusNaturalx(NatS#0##)=xminusNatural(NatS#x)(NatS#y)=casesubWordC#xyof(#l,0##)->NatS#l_->underflowErrorminusNatural(NatS#_)(NatJ#_)=underflowErrorminusNatural(NatJ#x)(NatS#y)=bigNatToNatural(minusBigNatWordxy)minusNatural(NatJ#x)(NatJ#y)=bigNatToNatural(minusBigNatxy){-# CONSTANT_FOLDED minusNatural #-}-- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.---- @since 4.8.0.0minusNaturalMaybe::Natural->Natural->MaybeNaturalminusNaturalMaybex(NatS#0##)=JustxminusNaturalMaybe(NatS#x)(NatS#y)=casesubWordC#xyof(#l,0##)->Just(NatS#l)_->NothingminusNaturalMaybe(NatS#_)(NatJ#_)=NothingminusNaturalMaybe(NatJ#x)(NatS#y)=Just(bigNatToNatural(minusBigNatWordxy))minusNaturalMaybe(NatJ#x)(NatJ#y)|isTrue#(isNullBigNat#res)=Nothing|True=Just(bigNatToNaturalres)whereres=minusBigNatxy-- | Convert 'BigNat' to 'Natural'.-- Throws 'Underflow' if passed a 'nullBigNat'.bigNatToNatural::BigNat->NaturalbigNatToNaturalbn|isTrue#(sizeofBigNat#bn==#1#)=NatS#(bigNatToWordbn)|isTrue#(isNullBigNat#bn)=underflowError|True=NatJ#bnnaturalToBigNat::Natural->BigNatnaturalToBigNat(NatS#w#)=wordToBigNatw#naturalToBigNat(NatJ#bn)=bnnaturalToWord::Natural->WordnaturalToWord(NatS#w#)=W#w#naturalToWord(NatJ#bn)=W#(bigNatToWordbn)naturalToInt::Natural->IntnaturalToInt(NatS#w#)=I#(word2Int#w#)naturalToInt(NatJ#bn)=I#(bigNatToIntbn)------------------------------------------------------------------------------ | Convert a Word# into a Natural---- Built-in rule ensures that applications of this function to literal Word# are-- lifted into Natural literals.wordToNatural#::Word#->NaturalwordToNatural#w#=NatS#w#{-# CONSTANT_FOLDED wordToNatural# #-}-- | Convert a Word# into a Natural---- In base we can't use wordToNatural# as built-in rules transform some of them-- into Natural literals. Use this function instead.wordToNaturalBase::Word#->NaturalwordToNaturalBasew#=NatS#w##else /* !defined(MIN_VERSION_integer_gmp) */------------------------------------------------------------------------------ Use wrapped 'Integer' as fallback; taken from Edward Kmett's nats package-- | Type representing arbitrary-precision non-negative integers.---- Operations whose result would be negative-- @'throw' ('Underflow' :: 'ArithException')@.---- @since 4.8.0.0newtypeNatural=NaturalInteger-- ^ __Invariant__: non-negative 'Integer'deriving(Eq,Ord)-- | Test whether all internal invariants are satisfied by 'Natural' value---- This operation is mostly useful for test-suites and/or code which-- constructs 'Natural' values directly.---- @since 4.8.0.0isValidNatural::Natural->BoolisValidNatural(Naturali)=i>=wordToInteger0##-- | Convert a Word# into a Natural---- Built-in rule ensures that applications of this function to literal Word# are-- lifted into Natural literals.wordToNatural#::Word#->NaturalwordToNatural#w##=Natural(wordToIntegerw##){-# CONSTANT_FOLDED wordToNatural# #-}-- | Convert a Word# into a Natural---- In base we can't use wordToNatural# as built-in rules transform some of them-- into Natural literals. Use this function instead.wordToNaturalBase::Word#->NaturalwordToNaturalBasew##=Natural(wordToIntegerw##)-- | @since 4.10.0.0naturalFromInteger::Integer->NaturalnaturalFromIntegern|n>=wordToInteger0##=Naturaln|True=underflowError{-# INLINEnaturalFromInteger#-}-- | 'Natural' subtraction. Returns 'Nothing's for non-positive results.---- @since 4.8.0.0minusNaturalMaybe::Natural->Natural->MaybeNaturalminusNaturalMaybe(Naturalx)(Naturaly)|x>=y=Just(Natural(x`minusInteger`y))|True=NothingshiftLNatural::Natural->Int->NaturalshiftLNatural(Naturaln)(I#i)=Natural(n`shiftLInteger`i){-# CONSTANT_FOLDED shiftLNatural #-}shiftRNatural::Natural->Int->NaturalshiftRNatural(Naturaln)(I#i)=Natural(n`shiftRInteger`i){-# CONSTANT_FOLDED shiftRNatural #-}plusNatural::Natural->Natural->NaturalplusNatural(Naturalx)(Naturaly)=Natural(x`plusInteger`y){-# CONSTANT_FOLDED plusNatural #-}minusNatural::Natural->Natural->NaturalminusNatural(Naturalx)(Naturaly)=Natural(x`minusInteger`y){-# CONSTANT_FOLDED minusNatural #-}timesNatural::Natural->Natural->NaturaltimesNatural(Naturalx)(Naturaly)=Natural(x`timesInteger`y){-# CONSTANT_FOLDED timesNatural #-}orNatural::Natural->Natural->NaturalorNatural(Naturalx)(Naturaly)=Natural(x`orInteger`y){-# CONSTANT_FOLDED orNatural #-}xorNatural::Natural->Natural->NaturalxorNatural(Naturalx)(Naturaly)=Natural(x`xorInteger`y){-# CONSTANT_FOLDED xorNatural #-}andNatural::Natural->Natural->NaturalandNatural(Naturalx)(Naturaly)=Natural(x`andInteger`y){-# CONSTANT_FOLDED andNatural #-}naturalToInt::Natural->IntnaturalToInt(Naturali)=I#(integerToInti)naturalToWord::Natural->WordnaturalToWord(Naturali)=W#(integerToWordi)naturalToInteger::Natural->IntegernaturalToInteger(Naturali)=i{-# CONSTANT_FOLDED naturalToInteger #-}testBitNatural::Natural->Int->BooltestBitNatural(Naturaln)(I#i)=testBitIntegerni{-# CONSTANT_FOLDED testBitNatural #-}bitNatural::Int#->NaturalbitNaturali#|isTrue#(i#<#WORD_SIZE_IN_BITS#)=wordToNaturalBase(1##`uncheckedShiftL#`i#)|True=Natural(1`shiftLInteger`i#){-# CONSTANT_FOLDED bitNatural #-}quotNatural::Natural->Natural->NaturalquotNaturaln@(Naturalx)(Naturaly)|y==wordToInteger0##=divZeroError|y==wordToInteger1##=n|True=Natural(x`quotInteger`y){-# CONSTANT_FOLDED quotNatural #-}remNatural::Natural->Natural->NaturalremNatural(Naturalx)(Naturaly)|y==wordToInteger0##=divZeroError|y==wordToInteger1##=wordToNaturalBase0##|True=Natural(x`remInteger`y){-# CONSTANT_FOLDED remNatural #-}quotRemNatural::Natural->Natural->(Natural,Natural)quotRemNaturaln@(Naturalx)(Naturaly)|y==wordToInteger0##=divZeroError|y==wordToInteger1##=(n,wordToNaturalBase0##)|True=casequotRemIntegerxyof(#k,r#)->(Naturalk,Naturalr){-# CONSTANT_FOLDED quotRemNatural #-}signumNatural::Natural->NaturalsignumNatural(Naturalx)|x==wordToInteger0##=wordToNaturalBase0##|True=wordToNaturalBase1##{-# CONSTANT_FOLDED signumNatural #-}negateNatural::Natural->NaturalnegateNatural(Naturalx)|x==wordToInteger0##=wordToNaturalBase0##|True=underflowError{-# CONSTANT_FOLDED negateNatural #-}#endif-- | Construct 'Natural' from 'Word' value.---- @since 4.8.0.0wordToNatural::Word->NaturalwordToNatural(W#w#)=wordToNatural#w#-- | Try downcasting 'Natural' to 'Word' value.-- Returns 'Nothing' if value doesn't fit in 'Word'.---- @since 4.8.0.0naturalToWordMaybe::Natural->MaybeWord#if defined(MIN_VERSION_integer_gmp)naturalToWordMaybe(NatS#w#)=Just(W#w#)naturalToWordMaybe(NatJ#_)=Nothing#elsenaturalToWordMaybe(Naturali)|i<maxw=Just(W#(integerToWordi))|True=Nothingwheremaxw=1`shiftLInteger`WORD_SIZE_IN_BITS##endif-- | \"@'powModNatural' /b/ /e/ /m/@\" computes base @/b/@ raised to-- exponent @/e/@ modulo @/m/@.---- @since 4.8.0.0powModNatural::Natural->Natural->Natural->Natural#if defined(MIN_VERSION_integer_gmp)powModNatural__(NatS#0##)=divZeroErrorpowModNatural__(NatS#1##)=NatS#0##powModNatural_(NatS#0##)_=NatS#1##powModNatural(NatS#0##)__=NatS#0##powModNatural(NatS#1##)__=NatS#1##powModNatural(NatS#b)(NatS#e)(NatS#m)=NatS#(powModWordbem)powModNaturalbe(NatS#m)=NatS#(powModBigNatWord(naturalToBigNatb)(naturalToBigNate)m)powModNaturalbe(NatJ#m)=bigNatToNatural(powModBigNat(naturalToBigNatb)(naturalToBigNate)m)#else-- Portable reference fallback implementationpowModNatural(Naturalb0)(Naturale0)(Naturalm)|m==wordToInteger0##=divZeroError|m==wordToInteger1##=wordToNaturalBase0##|e0==wordToInteger0##=wordToNaturalBase1##|b0==wordToInteger0##=wordToNaturalBase0##|b0==wordToInteger1##=wordToNaturalBase1##|True=gob0e0(wordToInteger1##)wherego!be!r|e`testBitInteger`0#=gob'e'((r`timesInteger`b)`modInteger`m)|e==wordToInteger0##=naturalFromIntegerr|True=gob'e'rwhereb'=(b`timesInteger`b)`modInteger`me'=e`shiftRInteger`1#-- slightly faster than "e `div` 2"#endif-- | Construct 'Natural' value from list of 'Word's.---- This function is used by GHC for constructing 'Natural' literals.mkNatural::[Word]-- ^ value expressed in 32 bit chunks, least--   significant first->NaturalmkNatural[]=wordToNaturalBase0##mkNatural(W#i:is')=wordToNaturalBase(i`and#`0xffffffff##)`orNatural`shiftLNatural(mkNaturalis')32{-# CONSTANT_FOLDED mkNatural #-}-- | Convert 'Int' to 'Natural'.-- Throws 'Underflow' when passed a negative 'Int'.intToNatural::Int->NaturalintToNatural(I#i#)|isTrue#(i#<#0#)=underflowError|True=wordToNaturalBase(int2Word#i#)