{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
-- | Integer logarithm, copied from Daniel Fischer's @arithmoi@
module Math.NumberTheory.Logarithms ( integerLog10' ) where
import GHC.Base
#if __GLASGOW_HASKELL__ >= 702
import GHC.Integer.Logarithms
#else
#include "MachDeps.h"
import GHC.Integer.GMP.Internals
#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)
#error Only word sizes 32 and 64 are supported.
#endif
#if WORD_SIZE_IN_BITS == 32
#define WSHIFT 5
#define MMASK 31
#else
#define WSHIFT 6
#define MMASK 63
#endif
-- | Calculate the integer base 2 logarithm of an 'Integer'.-- The calculation is much more efficient than for the general case.---- The argument must be strictly positive, that condition is /not/ checked.integerLog2# :: Integer -> Int#integerLog2# (S#i) = wordLog2# (int2Word#i)
integerLog2# (J#sba) = check (s-# 1#)
where
checki = case indexWordArray#bai of
0## -> check (i-# 1#)
w -> wordLog2#w+# (uncheckedIShiftL#iWSHIFT#)
-- | This function calculates the integer base 2 logarithm of a 'Word#'.-- @'wordLog2#' 0## = -1#@.{-# INLINE wordLog2# #-}wordLog2# :: Word# -> Int#wordLog2#w =
case leadingZeros of
BAlz ->
let zerosu = indexInt8Array#lz (word2Int#u) in
#if WORD_SIZE_IN_BITS == 64
case uncheckedShiftRL#w 56# of
a ->
if a`neWord#` 0##
then 64# -#zerosa
else
case uncheckedShiftRL#w 48# of
b ->
if b`neWord#` 0##
then 56# -#zerosb
else
case uncheckedShiftRL#w 40# of
c ->
if c`neWord#` 0##
then 48# -#zerosc
else
case uncheckedShiftRL#w 32# of
d ->
if d`neWord#` 0##
then 40# -#zerosd
else
#endif
case uncheckedShiftRL#w 24# of
e ->
if e`neWord#` 0##
then 32# -#zerose
else
case uncheckedShiftRL#w 16# of
f ->
if f`neWord#` 0##
then 24# -#zerosf
else
case uncheckedShiftRL#w 8# of
g ->
if g`neWord#` 0##
then 16# -#zerosg
else 8# -#zerosw-- Lookup table
data BA = BAByteArray#leadingZeros :: BAleadingZeros =
let mkArrs =
case newByteArray# 256# s of
(# s1, mba #) ->
case writeInt8Array#mba 0# 9# s1 of
s2 ->
let fillAlimvalidxst =
if idx==# 256#
then st
else if idx<#lim
then case writeInt8Array#mbaidxvalst of
nx -> fillAlimval (idx+# 1#) nx
else fillA (2# *#lim) (val-# 1#) idxst
in case fillA 2# 8# 1# s2 of
s3 -> case unsafeFreezeByteArray#mbas3 of
(# _, ba #) -> ba
in case mkArrrealWorld# of
b -> BAb
#endif
-- | Only defined for positive inputs!integerLog10' :: Integer -> IntintegerLog10'n
| n<10 = 0
| n<100 = 1
| otherwise = ex+integerLog10' (n`quot`integerPower10ex)
where
ln = I# (integerLog2#n)
-- u/v is a good approximation of log 2/log 10u = 1936274v = 6432163-- so ex is a good approximation to integerLogBase 10 nex = fromInteger ((u*fromIntegralln) `quot`v)
-- | Power of an 'Integer' by the left-to-right repeated squaring algorithm.-- This needs two multiplications in each step while the right-to-left-- algorithm needs only one multiplication for 0-bits, but here the-- two factors always have approximately the same size, which on average-- gains a bit when the result is large.---- For small results, it is unlikely to be any faster than '(^)', quite-- possibly slower (though the difference shouldn't be large), and for-- exponents with few bits set, the same holds. But for exponents with-- many bits set, the speedup can be significant.---- /Warning:/ No check for the negativity of the exponent is performed,-- a negative exponent is interpreted as a large positive exponent.integerPower :: Integer -> Int -> IntegerintegerPowerb (I#e#) = powerb (int2Word#e#)
power :: Integer -> Word# -> Integerpowerbw#
| isTrue# (w#`eqWord#` 0##) = 1
| isTrue# (w#`eqWord#` 1##) = b
| otherwise = go (wordLog2#w#-# 1#) b (b*b)
where
go 0# lh = if isTrue# ((w#`and#` 1##) `eqWord#` 0##) then l*l else (l*h)
goi#lh
| w#`hasBit#`i# = go (i#-# 1#) (l*h) (h*h)
| otherwise = go (i#-# 1#) (l*l) (l*h)
-- | A raw version of testBit for 'Word#'.hasBit# :: Word# -> Int# -> BoolhasBit#w#i# = isTrue# (((w#`uncheckedShiftRL#`i#) `and#` 1##) `neWord#` 0##)
#if __GLASGOW_HASKELL__ < 707
isTrue# :: Bool -> BoolisTrue# = id
#endif