{-# LANGUAGE CPP, MagicHash, UnboxedTuples, NoImplicitPrelude #-}
{-# OPTIONS_HADDOCK hide #-}

#include "MachDeps.h"

-- (Hopefully) Fast integer logarithms to base 2.
-- integerLog2# and wordLog2# are of general usefulness,
-- the others are only needed for a fast implementation of
-- fromRational.
-- Since they are needed in GHC.Float, we must expose this
-- module, but it should not show up in the docs.

module GHC.Integer.Logarithms.Internals
    ( integerLog2#
    , integerLog2IsPowerOf2#
    , wordLog2#
    , roundingMode#
    ) where

import GHC.Prim
import GHC.Integer.Type
import GHC.Types

default ()

-- When larger word sizes become common, add support for those,
-- it's not hard, just tedious.
#if (WORD_SIZE_IN_BITS != 32) && (WORD_SIZE_IN_BITS != 64)

-- We don't know whether the word has 30 bits or 128 or even more,
-- so we can't start from the top, although that would be much more
-- efficient.
wordLog2# :: Word# -> Int#
wordLog2# w = go 8# w
  where
    go acc u = case u `uncheckedShiftRL#` 8# of
                0## -> case leadingZeros of
                        BA ba -> acc -# indexInt8Array# ba (word2Int# u)
                v   -> go (acc +# 8#) v

#else

-- This one at least can also be done efficiently.
-- wordLog2# 0## = -1#
{-# INLINE wordLog2# #-}
wordLog2# :: Word# -> Int#
wordLog2# :: Word# -> Int#
wordLog2# Word#
w =
  case BA
leadingZeros of
   BA ByteArray#
lz ->
    let zeros :: Word# -> Int#
zeros Word#
u = ByteArray# -> Int# -> Int#
indexInt8Array# ByteArray#
lz (Word# -> Int#
word2Int# Word#
u) in
#if WORD_SIZE_IN_BITS == 64
    case Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
56# of
     Word#
a ->
      if Int# -> Bool
isTrue# (Word#
a Word# -> Word# -> Int#
`neWord#` Word#
0##)
       then Int#
64# Int# -> Int# -> Int#
-# Word# -> Int#
zeros Word#
a
       else
        case Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
48# of
         Word#
b ->
          if Int# -> Bool
isTrue# (Word#
b Word# -> Word# -> Int#
`neWord#` Word#
0##)
           then Int#
56# Int# -> Int# -> Int#
-# Word# -> Int#
zeros Word#
b
           else
            case Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
40# of
             Word#
c ->
              if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`neWord#` Word#
0##)
               then Int#
48# Int# -> Int# -> Int#
-# Word# -> Int#
zeros Word#
c
               else
                case Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
32# of
                 Word#
d ->
                  if Int# -> Bool
isTrue# (Word#
d Word# -> Word# -> Int#
`neWord#` Word#
0##)
                   then Int#
40# Int# -> Int# -> Int#
-# Word# -> Int#
zeros Word#
d
                   else
#endif
                    case Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
24# of
                     Word#
e ->
                      if Int# -> Bool
isTrue# (Word#
e Word# -> Word# -> Int#
`neWord#` Word#
0##)
                       then Int#
32# Int# -> Int# -> Int#
-# Word# -> Int#
zeros Word#
e
                       else
                        case Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
16# of
                         Word#
f ->
                          if Int# -> Bool
isTrue# (Word#
f Word# -> Word# -> Int#
`neWord#` Word#
0##)
                           then Int#
24# Int# -> Int# -> Int#
-# Word# -> Int#
zeros Word#
f
                           else
                            case Word# -> Int# -> Word#
uncheckedShiftRL# Word#
w Int#
8# of
                             Word#
g ->
                              if Int# -> Bool
isTrue# (Word#
g Word# -> Word# -> Int#
`neWord#` Word#
0##)
                               then Int#
16# Int# -> Int# -> Int#
-# Word# -> Int#
zeros Word#
g
                               else  Int#
8# Int# -> Int# -> Int#
-# Word# -> Int#
zeros Word#
w

#endif

-- Assumption: Integer is strictly positive,
-- otherwise return -1# arbitrarily
-- Going up in word-sized steps should not be too bad.
integerLog2# :: Integer -> Int#
integerLog2# :: Integer -> Int#
integerLog2# (Positive Positive
digits) = Int# -> Positive -> Int#
step Int#
0# Positive
digits
  where
    step :: Int# -> Positive -> Int#
step Int#
acc (Some Word#
dig Positive
None) = Int#
acc Int# -> Int# -> Int#
+# Word# -> Int#
wordLog2# Word#
dig
    step Int#
acc (Some Word#
_ Positive
digs)   =
        Int# -> Positive -> Int#
step (Int#
acc Int# -> Int# -> Int#
+# WORD_SIZE_IN_BITS#) digs
    step Int#
acc Positive
None = Int#
acc     -- should be impossible, throw error?
integerLog2# Integer
_ = Int# -> Int#
negateInt# Int#
1#

-- Again, integer should be strictly positive
integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
integerLog2IsPowerOf2# (Positive Positive
digits) = Int# -> Positive -> (# Int#, Int# #)
couldBe Int#
0# Positive
digits
  where
    couldBe :: Int# -> Positive -> (# Int#, Int# #)
couldBe Int#
acc (Some Word#
dig Positive
None) =
        (# Int#
acc Int# -> Int# -> Int#
+# Word# -> Int#
wordLog2# Word#
dig, Word# -> Int#
word2Int# (Word# -> Word# -> Word#
and# Word#
dig (Word# -> Word# -> Word#
minusWord# Word#
dig Word#
1##)) #)
    couldBe Int#
acc (Some Word#
dig Positive
digs) =
        if Int# -> Bool
isTrue# (Word# -> Word# -> Int#
eqWord# Word#
dig Word#
0##)
           then Int# -> Positive -> (# Int#, Int# #)
couldBe (Int#
acc Int# -> Int# -> Int#
+# WORD_SIZE_IN_BITS#) digs
           else Int# -> Positive -> (# Int#, Int# #)
noPower (Int#
acc Int# -> Int# -> Int#
+# WORD_SIZE_IN_BITS#) digs
    couldBe Int#
acc Positive
None = (# Int#
acc, Int#
1# #) -- should be impossible, error?
    noPower :: Int# -> Positive -> (# Int#, Int# #)
noPower Int#
acc (Some Word#
dig Positive
None) =
        (# Int#
acc Int# -> Int# -> Int#
+# Word# -> Int#
wordLog2# Word#
dig, Int#
1# #)
    noPower Int#
acc (Some Word#
_ Positive
digs)   =
        Int# -> Positive -> (# Int#, Int# #)
noPower (Int#
acc Int# -> Int# -> Int#
+# WORD_SIZE_IN_BITS#) digs
    noPower Int#
acc Positive
None = (# Int#
acc, Int#
1# #) -- should be impossible, error?
integerLog2IsPowerOf2# Integer
_ = (# Int# -> Int#
negateInt# Int#
1#, Int#
1# #)

-- Assumption: Integer and Int# are strictly positive, Int# is less
-- than logBase 2 of Integer, otherwise havoc ensues.
-- Used only for the numerator in fromRational when the denominator
-- is a power of 2.
-- The Int# argument is log2 n minus the number of bits in the mantissa
-- of the target type, i.e. the index of the first non-integral bit in
-- the quotient.
--
-- 0# means round down (towards zero)
-- 1# means we have a half-integer, round to even
-- 2# means round up (away from zero)
-- This function should probably be improved.
roundingMode# :: Integer -> Int# -> Int#
roundingMode# :: Integer -> Int# -> Int#
roundingMode# Integer
m Int#
h =
    case Integer
oneInteger Integer -> Int# -> Integer
`shiftLInteger` Int#
h of
      Integer
c -> case Integer
m Integer -> Integer -> Integer
`andInteger`
                ((Integer
c Integer -> Integer -> Integer
`plusInteger` Integer
c) Integer -> Integer -> Integer
`minusInteger` Integer
oneInteger) of
             Integer
r ->
               if Integer
c Integer -> Integer -> Bool
`ltInteger` Integer
r
                 then Int#
2#
                 else if Integer
c Integer -> Integer -> Bool
`gtInteger` Integer
r
                        then Int#
0#
                        else Int#
1#

-- Lookup table
data BA = BA ByteArray#

leadingZeros :: BA
leadingZeros :: BA
leadingZeros =
    let mkArr :: State# d -> ByteArray#
mkArr State# d
s =
          case Int# -> State# d -> (# State# d, MutableByteArray# d #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Int#
256# State# d
s of
            (# State# d
s1, MutableByteArray# d
mba #) ->
              case MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt8Array# MutableByteArray# d
mba Int#
0# Int#
9# State# d
s1 of
                State# d
s2 ->
                  let fillA :: Int# -> Int# -> Int# -> State# d -> State# d
fillA Int#
lim Int#
val Int#
idx State# d
st =
                        if Int# -> Bool
isTrue# (Int#
idx Int# -> Int# -> Int#
==# Int#
256#)
                          then State# d
st
                          else if Int# -> Bool
isTrue# (Int#
idx Int# -> Int# -> Int#
<# Int#
lim)
                                then case MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
forall d.
MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
writeInt8Array# MutableByteArray# d
mba Int#
idx Int#
val State# d
st of
                                        State# d
nx -> Int# -> Int# -> Int# -> State# d -> State# d
fillA Int#
lim Int#
val (Int#
idx Int# -> Int# -> Int#
+# Int#
1#) State# d
nx
                                else Int# -> Int# -> Int# -> State# d -> State# d
fillA (Int#
2# Int# -> Int# -> Int#
*# Int#
lim) (Int#
val Int# -> Int# -> Int#
-# Int#
1#) Int#
idx State# d
st
                  in case Int# -> Int# -> Int# -> State# d -> State# d
fillA Int#
2# Int#
8# Int#
1# State# d
s2 of
                      State# d
s3 -> case MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# d
mba State# d
s3 of
                              (# State# d
_, ByteArray#
ba #) -> ByteArray#
ba
    in case State# RealWorld -> ByteArray#
forall d. State# d -> ByteArray#
mkArr State# RealWorld
realWorld# of
        ByteArray#
b -> ByteArray# -> BA
BA ByteArray#
b