{-# LANGUAGE BangPatterns #-}
module What4.Domains.BV.Bitwise.Tnum
( Tnum
, tnumValue
, tnumMask
, mk
, add
, mul
, mulPrecise
, udiv
, urem
) where
import qualified Control.Exception as X
import Data.Bits
import What4.Domains.Arithmetic (bitsBelow, isPow2Integer)
data Tnum = Tnum
{ Tnum -> Integer
tnumValue :: !Integer
, Tnum -> Integer
tnumMask :: !Integer
}
mk :: Integer -> Integer -> Tnum
mk :: Integer -> Integer -> Tnum
mk Integer
v Integer
m = Bool -> Tnum -> Tnum
forall a. (?callStack::CallStack) => Bool -> a -> a
X.assert (Integer
v Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
m Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0) (Integer -> Integer -> Tnum
Tnum Integer
v Integer
m)
{-# INLINE mk #-}
add ::
Integer ->
Tnum ->
Tnum ->
Tnum
add :: Integer -> Tnum -> Tnum -> Tnum
add Integer
bvmask (Tnum Integer
av Integer
am) (Tnum Integer
bv Integer
bm) = Integer -> Integer -> Tnum
mk Integer
resv Integer
resm
where
sm :: Integer
sm = Integer
am Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
bm
sv :: Integer
sv = Integer
av Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
bv
sigma :: Integer
sigma = Integer
sm Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
sv
chi :: Integer
chi = Integer
sigma Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
sv
resm :: Integer
resm = (Integer
chi Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
am Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
bm) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask
resv :: Integer
resv = (Integer
sv Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer -> Integer
forall a. Bits a => a -> a
complement Integer
resm) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask
{-# INLINE add #-}
mul ::
Integer ->
Tnum ->
Tnum ->
Tnum
mul :: Integer -> Tnum -> Tnum -> Tnum
mul Integer
bvmask (Tnum Integer
av Integer
am) (Tnum Integer
bv Integer
bm)
| Integer
am Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0, Integer
bm Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Integer -> Integer -> Tnum
mk ((Integer
av Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bv) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask) Integer
0
| Bool
otherwise = Integer -> Integer -> Tnum
mk (Integer
resValue Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask) (Integer
resUnknown Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask)
where
ctzA :: Int
ctzA = Integer -> Int
countTrailingZerosOr0 (Integer
av Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
am)
ctzB :: Int
ctzB = Integer -> Int
countTrailingZerosOr0 (Integer
bv Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
bm)
trailZ :: Int
trailZ = Int
ctzA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ctzB
prodMin :: Integer
prodMin = Integer
av Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bv
prodMax :: Integer
prodMax = (Integer
av Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
am) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
bv Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
bm)
(Integer
highValue, Integer
highUnknown) = Integer -> Integer -> Integer -> (Integer, Integer)
wrappedKnownBitsOfInterval Integer
bvmask Integer
prodMin Integer
prodMax
w :: Int
w = Integer -> Int
forall a. Bits a => a -> Int
popCount Integer
bvmask
trailBitsKnownA :: Int
trailBitsKnownA = if Integer
am Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Int
w else Integer -> Int
countTrailingZerosOr0 Integer
am
trailBitsKnownB :: Int
trailBitsKnownB = if Integer
bm Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then Int
w else Integer -> Int
countTrailingZerosOr0 Integer
bm
smallestOperand :: Int
smallestOperand =
Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
X.assert (Int
trailBitsKnownA Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ctzA Bool -> Bool -> Bool
&& Int
trailBitsKnownB Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ctzB) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
trailBitsKnownA Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ctzA) (Int
trailBitsKnownB Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ctzB)
resultBitsKnown :: Int
resultBitsKnown = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
smallestOperand Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
trailZ) Int
w
bottomKnown :: Integer
bottomKnown = Integer
prodMin
lowKnownMask :: Integer
lowKnownMask = (Int -> Integer
forall a. Bits a => Int -> a
bit Int
resultBitsKnown Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask
resUnknown :: Integer
resUnknown = Integer
highUnknown Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer -> Integer
forall a. Bits a => a -> a
complement Integer
lowKnownMask
resValue :: Integer
resValue = (Integer
highValue Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. (Integer
bottomKnown Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
lowKnownMask)) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer -> Integer
forall a. Bits a => a -> a
complement Integer
resUnknown
{-# INLINE mul #-}
knownBitsOfInterval :: Integer -> Integer -> (Integer, Integer)
knownBitsOfInterval :: Integer -> Integer -> (Integer, Integer)
knownBitsOfInterval Integer
lo Integer
hi = (Integer
lo Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer -> Integer
forall a. Bits a => a -> a
complement Integer
varying, Integer
varying)
where
varying :: Integer
varying = Integer -> Integer
bitsBelow (Integer
lo Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
hi)
{-# INLINE knownBitsOfInterval #-}
wrappedKnownBitsOfInterval :: Integer -> Integer -> Integer -> (Integer, Integer)
wrappedKnownBitsOfInterval :: Integer -> Integer -> Integer -> (Integer, Integer)
wrappedKnownBitsOfInterval Integer
bvmask Integer
lo Integer
hi
| Integer
hi Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
modulus = (Integer
0, Integer
bvmask)
| Integer
wLo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
wHi = Integer -> Integer -> (Integer, Integer)
knownBitsOfInterval Integer
wLo Integer
wHi
| Bool
otherwise =
let (Integer
vA, Integer
mA) = Integer -> Integer -> (Integer, Integer)
knownBitsOfInterval Integer
wLo Integer
bvmask
(Integer
vB, Integer
mB) = Integer -> Integer -> (Integer, Integer)
knownBitsOfInterval Integer
0 Integer
wHi
mAB :: Integer
mAB = Integer
mA Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
mB Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. (Integer
vA Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
vB)
in (Integer
vA Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer -> Integer
forall a. Bits a => a -> a
complement Integer
mAB, Integer
mAB)
where
modulus :: Integer
modulus = Integer
bvmask Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
wLo :: Integer
wLo = Integer
lo Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
modulus
wHi :: Integer
wHi = Integer
hi Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
modulus
{-# INLINE wrappedKnownBitsOfInterval #-}
countTrailingZerosOr0 :: Integer -> Int
countTrailingZerosOr0 :: Integer -> Int
countTrailingZerosOr0 Integer
0 = Int
0
countTrailingZerosOr0 Integer
n = Integer -> Int
forall a. Bits a => a -> Int
popCount ((Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer -> Integer
forall a. Num a => a -> a
negate Integer
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
{-# INLINE countTrailingZerosOr0 #-}
log2OfPowerOfTwo :: Integer -> Int
log2OfPowerOfTwo :: Integer -> Int
log2OfPowerOfTwo Integer
n =
Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
X.assert (Integer -> Bool
isPow2Integer Integer
n) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
X.assert (Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Int
countTrailingZerosOr0 Integer
n) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
Int
k
where
k :: Int
k = Integer -> Int
forall a. Bits a => a -> Int
popCount (Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
mulPrecise ::
Integer ->
Tnum ->
Tnum ->
Tnum
mulPrecise :: Integer -> Tnum -> Tnum -> Tnum
mulPrecise Integer
bvmask (Tnum Integer
av0 Integer
am0) (Tnum Integer
bv0 Integer
bm0) = Integer -> Integer -> Integer -> Integer -> Tnum -> Tnum
forall {t} {t}.
(Num t, Num t, Bits t, Bits t) =>
t -> t -> Integer -> Integer -> Tnum -> Tnum
go Integer
av0 Integer
am0 Integer
bv0 Integer
bm0 Tnum
acc0
where
acc0 :: Tnum
acc0 = Integer -> Integer -> Tnum
mk ((Integer
av0 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
bv0) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask) Integer
0
go :: t -> t -> Integer -> Integer -> Tnum -> Tnum
go !t
av !t
am !Integer
bv !Integer
bm !Tnum
acc
| t
av t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 Bool -> Bool -> Bool
&& t
am t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = Tnum
acc
| Bool
otherwise =
let acc' :: Tnum
acc'
| t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit t
av Int
0 = Integer -> Tnum -> Tnum -> Tnum
add Integer
bvmask Tnum
acc (Integer -> Integer -> Tnum
Tnum Integer
0 Integer
bm)
| t -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit t
am Int
0 = Integer -> Tnum -> Tnum -> Tnum
add Integer
bvmask Tnum
acc (Integer -> Integer -> Tnum
Tnum Integer
0 (Integer
bv Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
bm))
| Bool
otherwise = Tnum
acc
in t -> t -> Integer -> Integer -> Tnum -> Tnum
go (t
av t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
1) (t
am t -> Int -> t
forall a. Bits a => a -> Int -> a
`shiftR` Int
1)
(Integer
bv Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
1) (Integer
bm Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
1)
Tnum
acc'
{-# INLINE mulPrecise #-}
udiv ::
Integer ->
Tnum ->
Tnum ->
Tnum
udiv :: Integer -> Tnum -> Tnum -> Tnum
udiv Integer
bvmask (Tnum Integer
av Integer
am) (Tnum Integer
bv Integer
bm)
| Integer
bm Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0, Integer -> Bool
isPow2Integer Integer
bv =
let k :: Int
k = Integer -> Int
log2OfPowerOfTwo Integer
bv
in Integer -> Integer -> Tnum
mk ((Integer
av Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
k) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask) ((Integer
am Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
k) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask)
| Bool
otherwise = Integer -> Integer -> Tnum
mk (Integer
highValue Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask) (Integer
highUnknown Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask)
where
aMin :: Integer
aMin = Integer
av Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask
aMax :: Integer
aMax = (Integer
av Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
am) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask
bMin :: Integer
bMin = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
1 Integer
bv
bMax :: Integer
bMax = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
1 ((Integer
bv Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
bm) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask)
qMin :: Integer
qMin = Integer
aMin Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
bMax
qMax :: Integer
qMax = Integer
aMax Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
bMin
(Integer
highValue, Integer
highUnknown) = Integer -> Integer -> (Integer, Integer)
knownBitsOfInterval Integer
qMin Integer
qMax
{-# INLINE udiv #-}
urem ::
Integer ->
Tnum ->
Tnum ->
Tnum
urem :: Integer -> Tnum -> Tnum -> Tnum
urem Integer
bvmask (Tnum Integer
av Integer
am) (Tnum Integer
bv Integer
bm)
| Integer
bm Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0, Integer -> Bool
isPow2Integer Integer
bv =
let m :: Integer
m = Integer
bv Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
in Integer -> Integer -> Tnum
mk (Integer
av Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
m) (Integer
am Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
m)
| Bool
otherwise =
let highUnknown :: Integer
highUnknown = Integer -> Integer
bitsBelow Integer
rMax Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask
rhsTrailingZeros :: Int
rhsTrailingZeros = Integer -> Int
countTrailingZerosOr0 (Integer
bv Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
bm)
lowMask :: Integer
lowMask = (Int -> Integer
forall a. Bits a => Int -> a
bit Int
rhsTrailingZeros Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask
lowValue :: Integer
lowValue = Integer
av Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
lowMask
lowUnknown :: Integer
lowUnknown = Integer
am Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
lowMask
resUnknown :: Integer
resUnknown = (Integer
highUnknown Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer -> Integer
forall a. Bits a => a -> a
complement Integer
lowMask) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
lowUnknown
resValue :: Integer
resValue = Integer
lowValue Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer -> Integer
forall a. Bits a => a -> a
complement Integer
resUnknown
in Integer -> Integer -> Tnum
mk (Integer
resValue Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask) (Integer
resUnknown Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask)
where
aMax :: Integer
aMax = (Integer
av Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
am) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask
bMax :: Integer
bMax = (Integer
bv Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
bm) Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
bvmask
rMax :: Integer
rMax = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
aMax (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
0 (Integer
bMax Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
{-# INLINE urem #-}