#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
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 ()
integerLog2IsPowerOf2# :: Integer -> (# Int#, Int# #)
integerLog2IsPowerOf2# (S# i#) = case int2Word# i# of
w -> (# wordLog2# w, word2Int# (w `and#` (w `minusWord#` 1##)) #)
integerLog2IsPowerOf2# (Jn# _) = (# 1#, 1# #)
integerLog2IsPowerOf2# (Jp# bn) = check (s -# 1#)
where
s = sizeofBigNat# bn
check :: Int# -> (# Int#, Int# #)
check i = case indexBigNat# bn i of
0## -> check (i -# 1#)
w -> (# wordLog2# w +# (uncheckedIShiftL# i WSHIFT#)
, case w `and#` (w `minusWord#` 1##) of
0## -> test (i -# 1#)
_ -> 1# #)
test :: Int# -> Int#
test i = if isTrue# (i <# 0#)
then 0#
else case indexBigNat# bn i of
0## -> test (i -# 1#)
_ -> 1#
roundingMode# :: Integer -> Int# -> Int#
roundingMode# (S# i#) t =
case int2Word# i# `and#` ((uncheckedShiftL# 2## t) `minusWord#` 1##) of
k -> case uncheckedShiftL# 1## t of
c -> if isTrue# (c `gtWord#` k)
then 0#
else if isTrue# (c `ltWord#` k)
then 2#
else 1#
roundingMode# (Jn# bn) t = roundingMode# (Jp# bn) t
roundingMode# (Jp# bn) t =
case word2Int# (int2Word# t `and#` MMASK##) of
j ->
case uncheckedIShiftRA# t WSHIFT# of
k ->
case indexBigNat# bn k `and#`
((uncheckedShiftL# 2## j) `minusWord#` 1##) of
r ->
case uncheckedShiftL# 1## j of
c -> if isTrue# (c `gtWord#` r)
then 0#
else if isTrue# (c `ltWord#` r)
then 2#
else test (k -# 1#)
where
test i = if isTrue# (i <# 0#)
then 1#
else case indexBigNat# bn i of
0## -> test (i -# 1#)
_ -> 2#