{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
-- This corresponds to src/comp/Log2.hs in bsc.
module Language.Bluespec.Log2
  ( log2
  ) where

import Data.Bits
import GHC.Exts

-- GHC 9.0 has an entirely new ghc-bignum package.
-- See https://iohk.io/en/blog/posts/2020/07/28/improving-haskells-big-numbers-support/
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 900)
import GHC.Num.Integer (Integer(IS, IP, IN))
import GHC.Num.BigNat
#else
import GHC.Integer.GMP.Internals
#endif

import Language.Bluespec.Prelude

-- In GHC 7.8, internal primops return Int# instead of Bool
eqInt, neqInt :: Int# -> Int# -> Bool
{-# INLINE eqInt #-}
{-# INLINE neqInt #-}
eqInt :: Int# -> Int# -> Bool
eqInt Int#
a Int#
b = Int# -> Bool
isTrue# (Int#
a Int# -> Int# -> Int#
==# Int#
b)
neqInt :: Int# -> Int# -> Bool
neqInt Int#
a Int#
b = Int# -> Bool
isTrue# (Int#
a Int# -> Int# -> Int#
/=# Int#
b)

-- |Number of bits in an Int (or Int#) on this machine
wordSize :: Int
wordSize :: Int
wordSize = Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0 :: Int)

-- |Compute the logarithm base 2, rounded up, for Integral types.
-- One interpretation of this log2 function is that it tells you
-- the minimum number of bits required to represent a given number
-- of distinct values.
log2 :: (Integral a, Integral b) => a -> b
log2 :: forall a b. (Integral a, Integral b) => a -> b
log2 a
0 = b
0
log2 a
x = case (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x) of
           -- for values which fit in a single word, we
           -- find the index of the most significant non-zero
           -- bit.  if all other bits are zero, then this is
           -- the value of the base 2 log, otherwise we must
           -- add one to the value to get the base 2 log.
           -- 'small' integer that fits in a single word
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 900)
           IS Int#
n  -> let !(Int
top_one,Bool
any_other_ones) = Int -> (Int, Bool)
analyze (Int# -> Int
I# Int#
n)
                    in Int -> b
forall a. Enum a => Int -> a
toEnum (Int
top_one Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
any_other_ones then Int
1 else Int
0))
#else
           S# n  -> let !(top_one,any_other_ones) = analyze (I# n)
                    in toEnum (top_one + (if any_other_ones then 1 else 0))
#endif
           -- for values which exceed the word size, we use the
           -- log2large function to examine the values in the array.
           -- positive and negative multiword integers respectively
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 900)
           IP ByteArray#
bn -> let sz :: Int#
sz = ByteArray# -> Int#
bigNatSize# ByteArray#
bn
                    in  Int# -> ByteArray# -> b
forall b. Integral b => Int# -> ByteArray# -> b
log2large (Int#
sz Int# -> Int# -> Int#
-# Int#
1#) ByteArray#
bn
           IN ByteArray#
bn -> let sz :: Int#
sz = ByteArray# -> Int#
bigNatSize# ByteArray#
bn
                    in  Int# -> ByteArray# -> b
forall b. Integral b => Int# -> ByteArray# -> b
log2large (Int#
sz Int# -> Int# -> Int#
-# Int#
1#) ByteArray#
bn
#else
           Jp# bn@(BN# arr) -> let sz = sizeofBigNat# bn
                               in  log2large (sz -# 1#) arr
           Jn# bn@(BN# arr) -> let sz = sizeofBigNat# bn
                               in  log2large (sz -# 1#) arr
#endif

-- |Utility function to find the index of the most significant
-- non-zero bit in a single-word Int and also report if any
-- other bits are non-zero.  Note: this assumes n /= 0.
analyze :: Int -> (Int,Bool)
analyze :: Int -> (Int, Bool)
analyze Int
n = Int -> Int -> (Int, Bool)
helper Int
n (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    where helper :: Int -> Int -> (Int, Bool)
helper Int
v Int
idx = if (Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
v Int
idx)
                         then (Int
idx, (Int -> Int -> Int
forall a. Bits a => a -> Int -> a
clearBit Int
v Int
idx) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
                         else Int -> Int -> (Int, Bool)
helper Int
n (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- |Utility function to determine if any words in a ByteArray#
-- up to a given index are non-zero.
anyNonZero :: ByteArray# -> Int# -> Bool
anyNonZero :: ByteArray# -> Int# -> Bool
anyNonZero ByteArray#
arr Int#
idx = if (ByteArray# -> Int# -> Int#
indexIntArray# ByteArray#
arr Int#
idx) Int# -> Int# -> Bool
`neqInt` Int#
0#
                     then Bool
True
                     else (Int#
idx Int# -> Int# -> Bool
`neqInt` Int#
0#) Bool -> Bool -> Bool
&& (ByteArray# -> Int# -> Bool
anyNonZero ByteArray#
arr (Int#
idx Int# -> Int# -> Int#
-# Int#
1#))

-- |Compute the log2 for Integers which span multiple words.  This
-- first scans the memory for the most significant word that is not 0.
-- Then it analyzes that word to determine, along with the word's
-- index, the provisional logarithm value, If that word had any
-- additional non-zero bits, or if any other words in the ByteArray#
-- are non-zero, then the actual logarithm will be one more than the
-- provisional value.
log2large :: (Integral b) => Int# -> ByteArray# -> b
log2large :: forall b. Integral b => Int# -> ByteArray# -> b
log2large Int#
i ByteArray#
arr =
    let !w :: Int#
w = ByteArray# -> Int# -> Int#
indexIntArray# ByteArray#
arr Int#
i
    in if Int#
w Int# -> Int# -> Bool
`eqInt` Int#
0#
       then if Int#
i Int# -> Int# -> Bool
`eqInt` Int#
0# then b
0 else Int# -> ByteArray# -> b
forall b. Integral b => Int# -> ByteArray# -> b
log2large (Int#
i Int# -> Int# -> Int#
-# Int#
1#) ByteArray#
arr
       else let !(Int
top_one,Bool
any_other_ones) = Int -> (Int, Bool)
analyze (Int# -> Int
I# Int#
w)
                base :: Int
base = (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int# -> Int
I# Int#
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
top_one)
            in if Bool
any_other_ones Bool -> Bool -> Bool
|| ((Int#
i Int# -> Int# -> Bool
`neqInt` Int#
0#) Bool -> Bool -> Bool
&& (ByteArray# -> Int# -> Bool
anyNonZero ByteArray#
arr (Int#
i Int# -> Int# -> Int#
-# Int#
1#)))
               then Int -> b
forall a. Enum a => Int -> a
toEnum (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
               else Int -> b
forall a. Enum a => Int -> a
toEnum Int
base