{-# 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
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# :: 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# #)
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#
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
roundingMode# (Jp# BigNat
bn) Int#
t =
case Word# -> Int#
word2Int# (Int# -> Word#
int2Word# Int#
t Word# -> Word# -> Word#
`and#` MMASK##) of
Int#
j ->
case Int# -> Int# -> Int#
uncheckedIShiftRA# Int#
t WSHIFT# of
Int#
k ->
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#