{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}

module GHC.Integer.Logarithms
    ( wordLog2#
    , integerLog2#
    , integerLogBase#
    ) where

#include "MachDeps.h"

#if WORD_SIZE_IN_BITS == 32
# define LD_WORD_SIZE_IN_BITS 5
#elif WORD_SIZE_IN_BITS == 64
# define LD_WORD_SIZE_IN_BITS 6
#else
# error unsupported WORD_SIZE_IN_BITS
#endif

import GHC.Integer.Type

import GHC.Prim

default ()

-- | Calculate the integer logarithm for an arbitrary base.
--
-- The base must be greater than @1@, the second argument, the number
-- whose logarithm is sought, shall be positive, otherwise the
-- result is meaningless.
--
-- The following property holds
--
-- @base ^ 'integerLogBase#' base m <= m < base ^('integerLogBase#' base m + 1)@
--
-- for @base > 1@ and @m > 0@.
--
-- Note: Internally uses 'integerLog2#' for base 2
integerLogBase# :: Integer -> Integer -> Int#
integerLogBase# :: Integer -> Integer -> Int#
integerLogBase# (S# Int#
2#) Integer
m = Integer -> Int#
integerLog2# Integer
m
integerLogBase# Integer
b Integer
m = Int#
e'
  where
    !(# Integer
_, Int#
e' #) = Integer -> (# Integer, Int# #)
go Integer
b

    go :: Integer -> (# Integer, Int# #)
go Integer
pw | Integer
m Integer -> Integer -> Bool
`ltInteger` Integer
pw = (# Integer
m, Int#
0# #)
    go Integer
pw = case Integer -> (# Integer, Int# #)
go (Integer -> Integer
sqrInteger Integer
pw) of
              (# Integer
q, Int#
e #) | Integer
q Integer -> Integer -> Bool
`ltInteger` Integer
pw -> (# Integer
q, Int#
2# Int# -> Int# -> Int#
*# Int#
e #)
              (# Integer
q, Int#
e #) -> (# Integer
q Integer -> Integer -> Integer
`quotInteger` Integer
pw, Int#
2# Int# -> Int# -> Int#
*# Int#
e Int# -> Int# -> Int#
+# Int#
1# #)


-- | Calculate the integer base 2 logarithm of an 'Integer'.  The
-- calculation is more efficient than for the general case, on
-- platforms with 32- or 64-bit words much more efficient.
--
-- The argument must be strictly positive, that condition is /not/ checked.
integerLog2# :: Integer -> Int#
integerLog2# :: Integer -> Int#
integerLog2# (S# Int#
i#) = Word# -> Int#
wordLog2# (Int# -> Word#
int2Word# Int#
i#)
integerLog2# (Jn#  BigNat
_) = Int#
-1#
integerLog2# (Jp# BigNat
bn) = Int# -> Int#
go (Int#
s Int# -> Int# -> Int#
-# Int#
1#)
  where
    s :: Int#
s = BigNat -> Int#
sizeofBigNat# BigNat
bn
    go :: Int# -> Int#
go Int#
i = case BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
i of
               Word#
0## -> Int# -> Int#
go (Int#
i Int# -> Int# -> Int#
-# Int#
1#)
               Word#
w   -> Word# -> Int#
wordLog2# Word#
w Int# -> Int# -> Int#
+# (Int# -> Int# -> Int#
uncheckedIShiftL# Int#
i LD_WORD_SIZE_IN_BITS#)

-- | Compute base-2 log of 'Word#'
--
-- This is internally implemented as count-leading-zeros machine instruction.
wordLog2# :: Word# -> Int#
wordLog2# :: Word# -> Int#
wordLog2# Word#
w# = (WORD_SIZE_IN_BITS# -# 1#) -# (word2Int# (clz# w#))