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