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

{-# OPTIONS_HADDOCK not-home #-}

#include "MachDeps.h"

#if WORD_SIZE_IN_BITS == 32
# define WSHIFT 5
# define MMASK 31
#elif WORD_SIZE_IN_BITS == 64
# define WSHIFT 6
# define MMASK 63
#else
# error unsupported WORD_SIZE_IN_BITS
#endif

-- | 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.
--
-- See https://gitlab.haskell.org/ghc/ghc/issues/5122
-- for the origin of the code in this module
module GHC.Integer.Logarithms.Internals
    ( wordLog2#
    , integerLog2IsPowerOf2#
    , integerLog2#
    , roundingMode#
    ) where

import GHC.Integer.Type
import GHC.Integer.Logarithms

import GHC.Types
import GHC.Prim

default ()

-- | Extended version of 'integerLog2#'
--
-- Assumption: Integer is strictly positive
--
-- First component of result is @log2 n@, second is @0#@ iff /n/ is a
-- power of two.
integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
-- The power of 2 test is n&(n-1) == 0, thus powers of 2
-- are indicated bythe second component being zero.
integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
integerLog2IsPowerOf2# (S# Int#
i#) = case Int# -> Word#
int2Word# Int#
i# of
      Word#
w -> (# Word# -> Int#
wordLog2# Word#
w, Word# -> Int#
word2Int# (Word#
w Word# -> Word# -> Word#
`and#` (Word#
w Word# -> Word# -> Word#
`minusWord#` Word#
1##)) #)
integerLog2IsPowerOf2# (Jn# BigNat
_) = (# Int#
-1#, Int#
-1# #)
-- Find the log2 as above, test whether that word is a power
-- of 2, if so, check whether only zero bits follow.
integerLog2IsPowerOf2# (Jp# BigNat
bn) = Int# -> (# Int#, Int# #)
check (Int#
s Int# -> Int# -> Int#
-# Int#
1#)
  where
    s :: Int#
s = BigNat -> Int#
sizeofBigNat# BigNat
bn
    check :: Int# -> (# Int#, Int# #)
    check :: Int# -> (# Int#, Int# #)
check Int#
i = case BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
i of
                Word#
0## -> Int# -> (# Int#, Int# #)
check (Int#
i Int# -> Int# -> Int#
-# Int#
1#)
                Word#
w   -> (# Word# -> Int#
wordLog2# Word#
w Int# -> Int# -> Int#
+# (Int# -> Int# -> Int#
uncheckedIShiftL# Int#
i WSHIFT#)
                        , case Word#
w Word# -> Word# -> Word#
`and#` (Word#
w Word# -> Word# -> Word#
`minusWord#` Word#
1##) of
                            Word#
0## -> Int# -> Int#
test (Int#
i Int# -> Int# -> Int#
-# Int#
1#)
                            Word#
_   -> Int#
1# #)
    test :: Int# -> Int#
    test :: Int# -> Int#
test Int#
i = if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
0#)
                then Int#
0#
                else case BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
i of
                        Word#
0## -> Int# -> Int#
test (Int#
i Int# -> Int# -> Int#
-# Int#
1#)
                        Word#
_   -> 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)
roundingMode# :: Integer -> Int# -> Int#
roundingMode# :: Integer -> Int# -> Int#
roundingMode# (S# Int#
i#) Int#
t =
    case Int# -> Word#
int2Word# Int#
i# Word# -> Word# -> Word#
`and#` ((Word# -> Int# -> Word#
uncheckedShiftL# Word#
2## Int#
t) Word# -> Word# -> Word#
`minusWord#` Word#
1##) of
      Word#
k -> case Word# -> Int# -> Word#
uncheckedShiftL# Word#
1## Int#
t of
            Word#
c -> if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`gtWord#` Word#
k)
                    then Int#
0#
                    else if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`ltWord#` Word#
k)
                            then Int#
2#
                            else Int#
1#

roundingMode# (Jn# BigNat
bn) Int#
t = Integer -> Int# -> Int#
roundingMode# (BigNat -> Integer
Jp# BigNat
bn) Int#
t -- dummy
roundingMode# (Jp# BigNat
bn) Int#
t =
    case Word# -> Int#
word2Int# (Int# -> Word#
int2Word# Int#
t Word# -> Word# -> Word#
`and#` MMASK##) of
      Int#
j ->      -- index of relevant bit in word
        case Int# -> Int# -> Int#
uncheckedIShiftRA# Int#
t WSHIFT# of
          Int#
k ->  -- index of relevant word
            case BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
k Word# -> Word# -> Word#
`and#`
                    ((Word# -> Int# -> Word#
uncheckedShiftL# Word#
2## Int#
j) Word# -> Word# -> Word#
`minusWord#` Word#
1##) of
              Word#
r ->
                case Word# -> Int# -> Word#
uncheckedShiftL# Word#
1## Int#
j of
                  Word#
c -> if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`gtWord#` Word#
r)
                        then Int#
0#
                        else if Int# -> Bool
isTrue# (Word#
c Word# -> Word# -> Int#
`ltWord#` Word#
r)


                                then Int#
2#
                                else Int# -> Int#
test (Int#
k Int# -> Int# -> Int#
-# Int#
1#)
  where
    test :: Int# -> Int#
test Int#
i = if Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<# Int#
0#)
                then Int#
1#
                else case BigNat -> Int# -> Word#
indexBigNat# BigNat
bn Int#
i of
                        Word#
0## -> Int# -> Int#
test (Int#
i Int# -> Int# -> Int#
-# Int#
1#)
                        Word#
_   -> Int#
2#