-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
--
-- SPDX-License-Identifier: GPL-3.0-only
{-# LANGUAGE TemplateHaskell #-}
-- The code generated by template-haskell does not have type signatures.
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

-- | This module provides an implementation of the expression abstract from
-- 'Language.QBE.Simulator.Expression' which uses concrete fixed-width integer
-- values from "Data.Word" internally.
module Language.QBE.Simulator.Default.Expression
  ( RegVal (..),
    bitSize,
    fromBits,
  )
where

import Control.Exception (assert)
import Data.Bits
  ( FiniteBits,
    finiteBitSize,
    shift,
    shiftR,
    unsafeShiftL,
    unsafeShiftR,
    xor,
    (.&.),
    (.|.),
  )
import Data.Int (Int16, Int32, Int64, Int8)
import Data.Word (Word16, Word32, Word64, Word8)
import GHC.Float
  ( castDoubleToWord64,
    castFloatToWord32,
    castWord32ToFloat,
    castWord64ToDouble,
    double2Float,
    float2Double,
  )
import Language.QBE.Simulator.Default.Generator (generateOperators)
import Language.QBE.Simulator.Expression qualified as E
import Language.QBE.Simulator.Memory qualified as MEM
import Language.QBE.Types qualified as QBE

-- TODO: Can we just wrap base type here?
-- TODO: Do not export the constructors
data RegVal
  = VByte Word8
  | VHalf Word16
  | VWord Word32
  | VLong Word64
  | VSingle Float
  | VDouble Double
  deriving (Int -> RegVal -> ShowS
[RegVal] -> ShowS
RegVal -> String
(Int -> RegVal -> ShowS)
-> (RegVal -> String) -> ([RegVal] -> ShowS) -> Show RegVal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegVal -> ShowS
showsPrec :: Int -> RegVal -> ShowS
$cshow :: RegVal -> String
show :: RegVal -> String
$cshowList :: [RegVal] -> ShowS
showList :: [RegVal] -> ShowS
Show, RegVal -> RegVal -> Bool
(RegVal -> RegVal -> Bool)
-> (RegVal -> RegVal -> Bool) -> Eq RegVal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegVal -> RegVal -> Bool
== :: RegVal -> RegVal -> Bool
$c/= :: RegVal -> RegVal -> Bool
/= :: RegVal -> RegVal -> Bool
Eq)

-- | Size of the value in bits.
bitSize :: RegVal -> Int
bitSize :: RegVal -> Int
bitSize (VByte Word8
_) = Int
8
bitSize (VHalf Word16
_) = Int
16
bitSize (VWord Word32
_) = Int
32
bitSize (VLong Word64
_) = Int
64
bitSize (VSingle Float
_) = Int
32
bitSize (VDouble Double
_) = Int
64

-- | Create a a 'RegVal' from an 'Integer' inferring the type from a given
-- amount of bits instead of requiring the user to provide a 'QBE.ExtType',
-- as required by 'Language.QBE.Simulator.Expression.fromLit'.
fromBits :: Int -> Integer -> Maybe RegVal
fromBits :: Int -> Integer -> Maybe RegVal
fromBits Int
08 = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Integer -> RegVal) -> Integer -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> RegVal
VHalf (Word16 -> RegVal) -> (Integer -> Word16) -> Integer -> RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
fromBits Int
16 = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Integer -> RegVal) -> Integer -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> RegVal
VHalf (Word16 -> RegVal) -> (Integer -> Word16) -> Integer -> RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
fromBits Int
32 = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Integer -> RegVal) -> Integer -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> RegVal
VWord (Word32 -> RegVal) -> (Integer -> Word32) -> Integer -> RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
fromBits Int
64 = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Integer -> RegVal) -> Integer -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RegVal
VLong (Word64 -> RegVal) -> (Integer -> Word64) -> Integer -> RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
fromBits Int
_ = Maybe RegVal -> Integer -> Maybe RegVal
forall a b. a -> b -> a
const Maybe RegVal
forall a. Maybe a
Nothing

fromBool :: Bool -> RegVal
fromBool :: Bool -> RegVal
fromBool Bool
True = Word64 -> RegVal
VLong Word64
1
fromBool Bool
False = Word64 -> RegVal
VLong Word64
0

------------------------------------------------------------------------

shiftInstr ::
  (RegVal -> Word32 -> Maybe RegVal) ->
  RegVal ->
  RegVal ->
  Maybe RegVal
shiftInstr :: (RegVal -> Word32 -> Maybe RegVal)
-> RegVal -> RegVal -> Maybe RegVal
shiftInstr RegVal -> Word32 -> Maybe RegVal
shiftOp RegVal
val (VWord Word32
amount) = RegVal
val RegVal -> Word32 -> Maybe RegVal
`shiftOp` Word32
amount
shiftInstr RegVal -> Word32 -> Maybe RegVal
_ RegVal
_ RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing

toShiftAmount :: Word32 -> Word32 -> Int
toShiftAmount :: Word32 -> Word32 -> Int
toShiftAmount Word32
valBitSize Word32
amount =
  -- From the QBE specification: "The shifting amount
  -- is taken modulo the size of the result type."
  let s :: Int
s = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Word32
amount Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`mod` Word32
valBitSize
   in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Int
s

shiftSar :: RegVal -> Word32 -> Maybe RegVal
shiftSar :: RegVal -> Word32 -> Maybe RegVal
shiftSar (VWord Word32
val) Word32
amount =
  (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Int32 -> RegVal) -> Int32 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> RegVal
VWord (Word32 -> RegVal) -> (Int32 -> Word32) -> Int32 -> RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Int32 -> Maybe RegVal) -> Int32 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$
    (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
val :: Int32) Int32 -> Int -> Int32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Word32 -> Word32 -> Int
toShiftAmount Word32
32 Word32
amount
shiftSar (VLong Word64
val) Word32
amount =
  (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Int64 -> RegVal) -> Int64 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RegVal
VLong (Word64 -> RegVal) -> (Int64 -> Word64) -> Int64 -> RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Int64 -> Maybe RegVal) -> Int64 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
val :: Int64) Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Word32 -> Word32 -> Int
toShiftAmount Word32
64 Word32
amount
shiftSar RegVal
_ Word32
_ = Maybe RegVal
forall a. Maybe a
Nothing

shiftShr :: RegVal -> Word32 -> Maybe RegVal
shiftShr :: RegVal -> Word32 -> Maybe RegVal
shiftShr (VWord Word32
val) Word32
amount =
  (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Word32 -> RegVal) -> Word32 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> RegVal
VWord) (Word32 -> Maybe RegVal) -> Word32 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Word32
val Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Word32 -> Word32 -> Int
toShiftAmount Word32
32 Word32
amount
shiftShr (VLong Word64
val) Word32
amount =
  (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Word64 -> RegVal) -> Word64 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RegVal
VLong) (Word64 -> Maybe RegVal) -> Word64 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Word64
val Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Word32 -> Word32 -> Int
toShiftAmount Word32
64 Word32
amount
shiftShr RegVal
_ Word32
_ = Maybe RegVal
forall a. Maybe a
Nothing

shiftShl :: RegVal -> Word32 -> Maybe RegVal
shiftShl :: RegVal -> Word32 -> Maybe RegVal
shiftShl (VWord Word32
val) Word32
amount =
  (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Word32 -> RegVal) -> Word32 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> RegVal
VWord) (Word32 -> Maybe RegVal) -> Word32 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Word32
val Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Word32 -> Word32 -> Int
toShiftAmount Word32
32 Word32
amount
shiftShl (VLong Word64
val) Word32
amount =
  (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Word64 -> RegVal) -> Word64 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RegVal
VLong) (Word64 -> Maybe RegVal) -> Word64 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Word64
val Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Word32 -> Word32 -> Int
toShiftAmount Word32
64 Word32
amount
shiftShl RegVal
_ Word32
_ = Maybe RegVal
forall a. Maybe a
Nothing

------------------------------------------------------------------------

regToBytes :: RegVal -> [Word8]
regToBytes :: RegVal -> [Word8]
regToBytes RegVal
val =
  let f :: a -> [b]
f a
w =
        (Int -> b) -> [Int] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map
          (\Int
off -> a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
w Int
off a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xff)
          (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (a -> Int
forall a. FiniteBits a => a -> Int
bytesize a
w) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Int
0)
   in case RegVal
val of
        (VByte Word8
v) -> [Word8
v]
        (VWord Word32
v) -> Word32 -> [Word8]
forall {a} {b}. (Integral a, Num b, FiniteBits a) => a -> [b]
f Word32
v
        (VHalf Word16
v) -> Word16 -> [Word8]
forall {a} {b}. (Integral a, Num b, FiniteBits a) => a -> [b]
f Word16
v
        (VLong Word64
v) -> Word64 -> [Word8]
forall {a} {b}. (Integral a, Num b, FiniteBits a) => a -> [b]
f Word64
v
        (VSingle Float
v) -> RegVal -> [Word8]
forall valTy byteTy. Storable valTy byteTy => valTy -> [byteTy]
MEM.toBytes (Word32 -> RegVal
VWord (Word32 -> RegVal) -> Word32 -> RegVal
forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 Float
v)
        (VDouble Double
v) -> RegVal -> [Word8]
forall valTy byteTy. Storable valTy byteTy => valTy -> [byteTy]
MEM.toBytes (Word64 -> RegVal
VLong (Word64 -> RegVal) -> Word64 -> RegVal
forall a b. (a -> b) -> a -> b
$ Double -> Word64
castDoubleToWord64 Double
v)
  where
    bytesize :: (FiniteBits a) => a -> Int
    bytesize :: forall a. FiniteBits a => a -> Int
bytesize a
v = a -> Int
forall a. FiniteBits a => a -> Int
finiteBitSize a
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8

regFromBytes :: QBE.LoadType -> [Word8] -> Maybe RegVal
regFromBytes :: LoadType -> [Word8] -> Maybe RegVal
regFromBytes LoadType
ty [Word8]
lst =
  let f :: [a] -> b
f [a]
a =
        (b -> (a, Int) -> b) -> b -> [(a, Int)] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
          (\b
acc (a
byte, Int
idx) -> (a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
byte b -> Int -> b
forall a. Bits a => a -> Int -> a
`shift` (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8)) b -> b -> b
forall a. Bits a => a -> a -> a
.|. b
acc)
          b
0
          ([(a, Int)] -> b) -> [(a, Int)] -> b
forall a b. (a -> b) -> a -> b
$ [a] -> [Int] -> [(a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
a [Int
0 ..]
   in case (LoadType
ty, [Word8]
lst) of
        (QBE.LSubWord SubWordType
QBE.UnsignedByte, [Word8
byte]) -> RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (Word32 -> RegVal
VWord (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte))
        (QBE.LSubWord SubWordType
QBE.SignedByte, [Word8
byte]) -> RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (Word32 -> RegVal
VWord (Word32 -> RegVal) -> Word32 -> RegVal
forall a b. (a -> b) -> a -> b
$ Int8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte :: Int8))
        (QBE.LSubWord SubWordType
QBE.SignedHalf, bytes :: [Word8]
bytes@[Word8
_, Word8
_]) -> RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (Word32 -> RegVal
VWord (Word32 -> RegVal) -> Word32 -> RegVal
forall a b. (a -> b) -> a -> b
$ Int16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> Int16
forall {b} {a}. (Bits b, Integral a, Num b) => [a] -> b
f [Word8]
bytes :: Int16))
        (QBE.LSubWord SubWordType
QBE.UnsignedHalf, bytes :: [Word8]
bytes@[Word8
_, Word8
_]) -> RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (Word32 -> RegVal
VWord (Word32 -> RegVal) -> Word32 -> RegVal
forall a b. (a -> b) -> a -> b
$ Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word8] -> Word16
forall {b} {a}. (Bits b, Integral a, Num b) => [a] -> b
f [Word8]
bytes :: Word16))
        (QBE.LBase BaseType
QBE.Word, bytes :: [Word8]
bytes@[Word8
_, Word8
_, Word8
_, Word8
_]) -> RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (Word32 -> RegVal
VWord (Word32 -> RegVal) -> Word32 -> RegVal
forall a b. (a -> b) -> a -> b
$ [Word8] -> Word32
forall {b} {a}. (Bits b, Integral a, Num b) => [a] -> b
f [Word8]
bytes)
        (QBE.LBase BaseType
QBE.Long, bytes :: [Word8]
bytes@[Word8
_, Word8
_, Word8
_, Word8
_, Word8
_, Word8
_, Word8
_, Word8
_]) -> RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (Word64 -> RegVal
VLong (Word64 -> RegVal) -> Word64 -> RegVal
forall a b. (a -> b) -> a -> b
$ [Word8] -> Word64
forall {b} {a}. (Bits b, Integral a, Num b) => [a] -> b
f [Word8]
bytes)
        (QBE.LBase BaseType
QBE.Single, bytes :: [Word8]
bytes@[Word8
_, Word8
_, Word8
_, Word8
_]) ->
          RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (Float -> RegVal
VSingle (Float -> RegVal) -> Float -> RegVal
forall a b. (a -> b) -> a -> b
$ Word32 -> Float
castWord32ToFloat ([Word8] -> Word32
forall {b} {a}. (Bits b, Integral a, Num b) => [a] -> b
f [Word8]
bytes))
        (QBE.LBase BaseType
QBE.Double, bytes :: [Word8]
bytes@[Word8
_, Word8
_, Word8
_, Word8
_, Word8
_, Word8
_, Word8
_, Word8
_]) ->
          RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (Double -> RegVal
VDouble (Double -> RegVal) -> Double -> RegVal
forall a b. (a -> b) -> a -> b
$ Word64 -> Double
castWord64ToDouble ([Word8] -> Word64
forall {b} {a}. (Bits b, Integral a, Num b) => [a] -> b
f [Word8]
bytes))
        (LoadType, [Word8])
_ -> Maybe RegVal
forall a. Maybe a
Nothing

instance MEM.Storable RegVal Word8 where
  toBytes :: RegVal -> [Word8]
toBytes = RegVal -> [Word8]
regToBytes
  fromBytes :: LoadType -> [Word8] -> Maybe RegVal
fromBytes = LoadType -> [Word8] -> Maybe RegVal
regFromBytes

------------------------------------------------------------------------

-- TODO: Insert the generated code directly into the instance declaration.
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe a
RegVal -> RegVal -> Maybe RegVal
add' :: RegVal -> RegVal -> Maybe RegVal
sub' :: RegVal -> RegVal -> Maybe RegVal
mul' :: RegVal -> RegVal -> Maybe RegVal
eq' :: RegVal -> RegVal -> Maybe a
ne' :: RegVal -> RegVal -> Maybe a
sle' :: RegVal -> RegVal -> Maybe a
slt' :: RegVal -> RegVal -> Maybe a
sge' :: RegVal -> RegVal -> Maybe a
sgt' :: RegVal -> RegVal -> Maybe a
ule' :: RegVal -> RegVal -> Maybe a
ult' :: RegVal -> RegVal -> Maybe a
uge' :: RegVal -> RegVal -> Maybe a
ugt' :: RegVal -> RegVal -> Maybe a
srem' :: RegVal -> RegVal -> Maybe RegVal
urem' :: RegVal -> RegVal -> Maybe RegVal
udiv' :: RegVal -> RegVal -> Maybe RegVal
or' :: RegVal -> RegVal -> Maybe RegVal
xor' :: RegVal -> RegVal -> Maybe RegVal
and' :: RegVal -> RegVal -> Maybe RegVal
generateOperators

maxValue :: RegVal -> Maybe RegVal
maxValue :: RegVal -> Maybe RegVal
maxValue RegVal
val =
  let bitSiz :: Int
bitSiz = RegVal -> Int
bitSize RegVal
val
      maxVal :: Integer
maxVal = (Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
bitSiz) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
   in Int -> Integer -> Maybe RegVal
fromBits Int
bitSiz Integer
maxVal

withZeroDiv ::
  Maybe RegVal ->
  (RegVal -> RegVal -> Maybe RegVal) ->
  RegVal ->
  RegVal ->
  Maybe RegVal
withZeroDiv :: Maybe RegVal
-> (RegVal -> RegVal -> Maybe RegVal)
-> RegVal
-> RegVal
-> Maybe RegVal
withZeroDiv Maybe RegVal
defVal RegVal -> RegVal -> Maybe RegVal
op RegVal
lhs RegVal
rhs
  | RegVal -> Word64
forall v. ValueRepr v => v -> Word64
E.toWord64 RegVal
rhs Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = Maybe RegVal
defVal
  | Bool
otherwise = RegVal -> RegVal -> Maybe RegVal
op RegVal
lhs RegVal
rhs

-- Signed division overflow occurs when the most-negative integer is divided by -1.
withSDivOverflow ::
  Maybe RegVal ->
  (RegVal -> RegVal -> Maybe RegVal) ->
  RegVal ->
  RegVal ->
  Maybe RegVal
withSDivOverflow :: Maybe RegVal
-> (RegVal -> RegVal -> Maybe RegVal)
-> RegVal
-> RegVal
-> Maybe RegVal
withSDivOverflow Maybe RegVal
defVal RegVal -> RegVal -> Maybe RegVal
op RegVal
lhs RegVal
rhs
  | RegVal -> Word64
forall v. ValueRepr v => v -> Word64
E.toWord64 RegVal
lhs Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
mostNeg Bool -> Bool -> Bool
&& RegVal -> Word64
forall v. ValueRepr v => v -> Word64
E.toWord64 RegVal
rhs Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
minusOne = Maybe RegVal
defVal
  | Bool
otherwise = RegVal -> RegVal -> Maybe RegVal
op RegVal
lhs RegVal
rhs
  where
    numBits :: Int
    numBits :: Int
numBits =
      Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (RegVal -> Int
bitSize RegVal
lhs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== RegVal -> Int
bitSize RegVal
rhs) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
        RegVal -> Int
bitSize RegVal
lhs

    minusOne :: Word64
    minusOne :: Word64
minusOne = (Word64
2 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
numBits) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1

    mostNeg :: Word64
    mostNeg :: Word64
mostNeg = Word64
2 Word64 -> Int -> Word64
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
numBits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- We could also add support for unary operators to the generator. However,
-- presently there is only one unary operator so it isn't worth it.
neg' :: RegVal -> Maybe RegVal
neg' :: RegVal -> Maybe RegVal
neg' (VWord Word32
v) = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Word32 -> RegVal) -> Word32 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> RegVal
VWord (Word32 -> Maybe RegVal) -> Word32 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32
forall a. Num a => a -> a
negate Word32
v
neg' (VLong Word64
v) = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Word64 -> RegVal) -> Word64 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RegVal
VLong (Word64 -> Maybe RegVal) -> Word64 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a. Num a => a -> a
negate Word64
v
neg' (VSingle Float
v) = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Float -> RegVal) -> Float -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> RegVal
VSingle (Float -> Maybe RegVal) -> Float -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Float -> Float
forall a. Num a => a -> a
negate Float
v
neg' (VDouble Double
v) = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Double -> RegVal) -> Double -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> RegVal
VDouble (Double -> Maybe RegVal) -> Double -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
negate Double
v
neg' RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing

-- This can't be easily auto generated because the operation differs
-- based on the type.
div' :: RegVal -> RegVal -> Maybe RegVal
div' :: RegVal -> RegVal -> Maybe RegVal
div' (VWord Word32
lhs) (VWord Word32
rhs) =
  (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Int32 -> RegVal) -> Int32 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> RegVal
VWord (Word32 -> RegVal) -> (Int32 -> Word32) -> Int32 -> RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Int32 -> Maybe RegVal) -> Int32 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$
    (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
lhs :: Int32) Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`quot` (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
rhs :: Int32)
div' (VLong Word64
lhs) (VLong Word64
rhs) =
  (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Int64 -> RegVal) -> Int64 -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> RegVal
VLong (Word64 -> RegVal) -> (Int64 -> Word64) -> Int64 -> RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Int64 -> Maybe RegVal) -> Int64 -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$
    (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
lhs :: Int64) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
rhs :: Int64)
div' (VSingle Float
lhs) (VSingle Float
rhs) = (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Float -> RegVal) -> Float -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> RegVal
VSingle) (Float -> Maybe RegVal) -> Float -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Float
lhs Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
rhs
div' (VDouble Double
lhs) (VDouble Double
rhs) = (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Double -> RegVal) -> Double -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> RegVal
VDouble) (Double -> Maybe RegVal) -> Double -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Double
lhs Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
rhs
div' RegVal
_ RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing

instance E.ValueRepr RegVal where
  fromLit :: ExtType -> Word64 -> RegVal
fromLit ExtType
QBE.Byte Word64
n = Word8 -> RegVal
VByte (Word8 -> RegVal) -> Word8 -> RegVal
forall a b. (a -> b) -> a -> b
$ Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
  fromLit ExtType
QBE.HalfWord Word64
n = Word16 -> RegVal
VHalf (Word16 -> RegVal) -> Word16 -> RegVal
forall a b. (a -> b) -> a -> b
$ Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
  fromLit (QBE.Base BaseType
QBE.Long) Word64
n = Word64 -> RegVal
VLong Word64
n
  fromLit (QBE.Base BaseType
QBE.Word) Word64
n = Word32 -> RegVal
VWord (Word32 -> RegVal) -> Word32 -> RegVal
forall a b. (a -> b) -> a -> b
$ Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n
  fromLit (QBE.Base BaseType
QBE.Single) Word64
n = Float -> RegVal
VSingle (Float -> RegVal) -> Float -> RegVal
forall a b. (a -> b) -> a -> b
$ Word32 -> Float
castWord32ToFloat (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
  fromLit (QBE.Base BaseType
QBE.Double) Word64
n = Double -> RegVal
VDouble (Double -> RegVal) -> Double -> RegVal
forall a b. (a -> b) -> a -> b
$ Word64 -> Double
castWord64ToDouble Word64
n

  toWord64 :: RegVal -> Word64
toWord64 (VByte Word8
v) = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v
  toWord64 (VHalf Word16
v) = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v
  toWord64 (VWord Word32
v) = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v
  toWord64 (VLong Word64
v) = Word64
v
  toWord64 (VSingle Float
v) = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Word32 -> Word64
forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 Float
v
  toWord64 (VDouble Double
v) = Double -> Word64
castDoubleToWord64 Double
v

  fromFloat :: Float -> RegVal
fromFloat = Float -> RegVal
VSingle
  fromDouble :: Double -> RegVal
fromDouble = Double -> RegVal
VDouble

  -- stosi
  floatToInt :: ExtType -> Bool -> RegVal -> Maybe RegVal
floatToInt ty :: ExtType
ty@(QBE.Base BaseType
QBE.Word) Bool
True (VSingle Float
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int32
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v :: Int32))
  floatToInt ty :: ExtType
ty@(QBE.Base BaseType
QBE.Long) Bool
True (VSingle Float
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int64
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v :: Int64))
  -- stoui
  floatToInt ty :: ExtType
ty@(QBE.Base BaseType
QBE.Word) Bool
False (VSingle Float
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Word32
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v :: Word32))
  floatToInt ty :: ExtType
ty@(QBE.Base BaseType
QBE.Long) Bool
False (VSingle Float
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Float -> Word64
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Float
v :: Word64)
  -- dtosi
  floatToInt ty :: ExtType
ty@(QBE.Base BaseType
QBE.Word) Bool
True (VDouble Double
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int32
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v :: Int32))
  floatToInt ty :: ExtType
ty@(QBE.Base BaseType
QBE.Long) Bool
True (VDouble Double
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Int64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v :: Int64))
  -- dtoui
  floatToInt ty :: ExtType
ty@(QBE.Base BaseType
QBE.Word) Bool
False (VDouble Double
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Double -> Word32
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v :: Word32))
  floatToInt ty :: ExtType
ty@(QBE.Base BaseType
QBE.Long) Bool
False (VDouble Double
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Double -> Word64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
v :: Word64)
  -- rest
  floatToInt ExtType
_ Bool
_ RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing

  -- swtof
  intToFloat :: ExtType -> Bool -> RegVal -> Maybe RegVal
intToFloat ty :: ExtType
ty@(QBE.Base BaseType
QBE.Single) Bool
True (VWord Word32
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v :: Int32))
  intToFloat ty :: ExtType
ty@(QBE.Base BaseType
QBE.Double) Bool
True (VWord Word32
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v :: Int32))
  -- uwtof
  intToFloat ty :: ExtType
ty@(QBE.Base BaseType
QBE.Single) Bool
False (VWord Word32
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v :: Word32))
  intToFloat ty :: ExtType
ty@(QBE.Base BaseType
QBE.Double) Bool
False (VWord Word32
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v :: Word32))
  -- sltof
  intToFloat ty :: ExtType
ty@(QBE.Base BaseType
QBE.Single) Bool
True (VLong Word64
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Int64))
  intToFloat ty :: ExtType
ty@(QBE.Base BaseType
QBE.Double) Bool
True (VLong Word64
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Int64))
  -- ultof
  intToFloat ty :: ExtType
ty@(QBE.Base BaseType
QBE.Single) Bool
False (VLong Word64
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Word64))
  intToFloat ty :: ExtType
ty@(QBE.Base BaseType
QBE.Double) Bool
False (VLong Word64
v) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
ty (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Word64))
  -- rest
  intToFloat ExtType
_ Bool
_ RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing

  extendFloat :: RegVal -> Maybe RegVal
extendFloat (VSingle Float
v) = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Double -> RegVal
VDouble (Float -> Double
float2Double Float
v)
  extendFloat RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing

  truncFloat :: RegVal -> Maybe RegVal
truncFloat (VDouble Double
v) = RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Float -> RegVal
VSingle (Double -> Float
double2Float Double
v)
  truncFloat RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing

  getType :: RegVal -> ExtType
getType (VByte Word8
_) = ExtType
QBE.Byte
  getType (VHalf Word16
_) = ExtType
QBE.HalfWord
  getType (VWord Word32
_) = BaseType -> ExtType
QBE.Base BaseType
QBE.Word
  getType (VLong Word64
_) = BaseType -> ExtType
QBE.Base BaseType
QBE.Long
  getType (VSingle Float
_) = BaseType -> ExtType
QBE.Base BaseType
QBE.Single
  getType (VDouble Double
_) = BaseType -> ExtType
QBE.Base BaseType
QBE.Double

  -- TODO: Consider replacing Nothing cases with assert as this on the hot path.
  extend :: ExtType -> Bool -> RegVal -> Maybe RegVal
extend ExtType
extTy Bool
isSigned RegVal
val
    | ExtType -> Int
QBE.extTypeBitSize ExtType
extTy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= RegVal -> Int
bitSize RegVal
val = Maybe RegVal
forall a. Maybe a
Nothing
    | Bool
otherwise =
        ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
extTy
          (Word64 -> RegVal) -> Maybe Word64 -> Maybe RegVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Bool
isSigned, RegVal
val) of
            (Bool
True, VByte Word8
v) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Int8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v :: Int8)
            (Bool
True, VHalf Word16
v) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Int16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v :: Int16)
            (Bool
True, VWord Word32
v) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Int32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v :: Int32)
            (Bool
True, VLong Word64
v) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Int64)
            (Bool
False, VByte Word8
v) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
v :: Word8)
            (Bool
False, VHalf Word16
v) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
v :: Word16)
            (Bool
False, VWord Word32
v) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
v :: Word32)
            (Bool
False, VLong Word64
v) -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Word64 -> Maybe Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
v :: Word64)
            (Bool, RegVal)
_ -> Maybe Word64
forall a. Maybe a
Nothing

  -- TODO: Consider replacing Nothing cases with assert as this on the hot path.
  extract :: ExtType -> RegVal -> Maybe RegVal
extract (QBE.Base BaseType
QBE.Single) RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing
  extract (QBE.Base BaseType
QBE.Double) RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing
  extract ExtType
_ (VSingle Float
_) = Maybe RegVal
forall a. Maybe a
Nothing
  extract ExtType
_ (VDouble Double
_) = Maybe RegVal
forall a. Maybe a
Nothing
  extract ExtType
extTy RegVal
v
    | ExtType -> Int
QBE.extTypeBitSize ExtType
extTy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RegVal -> Int
bitSize RegVal
v = Maybe RegVal
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let word :: Word64
word = RegVal -> Word64
forall v. ValueRepr v => v -> Word64
E.toWord64 RegVal
v
            mask :: Word64
mask = (Word64
2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`unsafeShiftL` (ExtType -> Int
QBE.extTypeBitSize ExtType
extTy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
         in RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal) -> RegVal -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ ExtType -> Word64 -> RegVal
forall v. ValueRepr v => ExtType -> Word64 -> v
E.fromLit ExtType
extTy (Word64
word Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
mask)

  -- This is needed to align the behavior of qute/ and qute-symex/ on
  -- division-by-zero. QBE does not explicitly mandate a specific behavior
  -- for this edge case. Therefore, in order to avoid extra branches in the
  -- symbolic executor, we use the behavior mandated by SMT-LIB here.
  --
  -- TODO: Move this into the Expression abstraction (just like overshift handling).
  div :: RegVal -> RegVal -> Maybe RegVal
div RegVal
lhs = Maybe RegVal
-> (RegVal -> RegVal -> Maybe RegVal)
-> RegVal
-> RegVal
-> Maybe RegVal
withZeroDiv (RegVal -> Maybe RegVal
maxValue RegVal
lhs) (Maybe RegVal
-> (RegVal -> RegVal -> Maybe RegVal)
-> RegVal
-> RegVal
-> Maybe RegVal
withSDivOverflow (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just RegVal
lhs) RegVal -> RegVal -> Maybe RegVal
div') RegVal
lhs
  udiv :: RegVal -> RegVal -> Maybe RegVal
udiv RegVal
lhs = Maybe RegVal
-> (RegVal -> RegVal -> Maybe RegVal)
-> RegVal
-> RegVal
-> Maybe RegVal
withZeroDiv (RegVal -> Maybe RegVal
maxValue RegVal
lhs) RegVal -> RegVal -> Maybe RegVal
udiv' RegVal
lhs
  urem :: RegVal -> RegVal -> Maybe RegVal
urem RegVal
lhs = Maybe RegVal
-> (RegVal -> RegVal -> Maybe RegVal)
-> RegVal
-> RegVal
-> Maybe RegVal
withZeroDiv (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just RegVal
lhs) RegVal -> RegVal -> Maybe RegVal
urem' RegVal
lhs
  srem :: RegVal -> RegVal -> Maybe RegVal
srem RegVal
lhs = Maybe RegVal
-> (RegVal -> RegVal -> Maybe RegVal)
-> RegVal
-> RegVal
-> Maybe RegVal
withZeroDiv (RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just RegVal
lhs) (Maybe RegVal
-> (RegVal -> RegVal -> Maybe RegVal)
-> RegVal
-> RegVal
-> Maybe RegVal
withSDivOverflow (Int -> Integer -> Maybe RegVal
fromBits (RegVal -> Int
bitSize RegVal
lhs) Integer
0) RegVal -> RegVal -> Maybe RegVal
srem') RegVal
lhs

  add :: RegVal -> RegVal -> Maybe RegVal
add = RegVal -> RegVal -> Maybe RegVal
add'
  sub :: RegVal -> RegVal -> Maybe RegVal
sub = RegVal -> RegVal -> Maybe RegVal
sub'
  mul :: RegVal -> RegVal -> Maybe RegVal
mul = RegVal -> RegVal -> Maybe RegVal
mul'
  or :: RegVal -> RegVal -> Maybe RegVal
or = RegVal -> RegVal -> Maybe RegVal
or'
  xor :: RegVal -> RegVal -> Maybe RegVal
xor = RegVal -> RegVal -> Maybe RegVal
xor'
  and :: RegVal -> RegVal -> Maybe RegVal
and = RegVal -> RegVal -> Maybe RegVal
and'

  neg :: RegVal -> Maybe RegVal
neg = RegVal -> Maybe RegVal
neg'

  sar :: RegVal -> RegVal -> Maybe RegVal
sar = (RegVal -> Word32 -> Maybe RegVal)
-> RegVal -> RegVal -> Maybe RegVal
shiftInstr RegVal -> Word32 -> Maybe RegVal
shiftSar
  shr :: RegVal -> RegVal -> Maybe RegVal
shr = (RegVal -> Word32 -> Maybe RegVal)
-> RegVal -> RegVal -> Maybe RegVal
shiftInstr RegVal -> Word32 -> Maybe RegVal
shiftShr
  shl :: RegVal -> RegVal -> Maybe RegVal
shl = (RegVal -> Word32 -> Maybe RegVal)
-> RegVal -> RegVal -> Maybe RegVal
shiftInstr RegVal -> Word32 -> Maybe RegVal
shiftShl

  -- TODO: Provide default implementations
  eq :: RegVal -> RegVal -> Maybe RegVal
eq = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
eq'
  ne :: RegVal -> RegVal -> Maybe RegVal
ne = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
ne'
  sle :: RegVal -> RegVal -> Maybe RegVal
sle = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
sle'
  slt :: RegVal -> RegVal -> Maybe RegVal
slt = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
slt'
  sge :: RegVal -> RegVal -> Maybe RegVal
sge = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
sge'
  sgt :: RegVal -> RegVal -> Maybe RegVal
sgt = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
sgt'
  ule :: RegVal -> RegVal -> Maybe RegVal
ule = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
ule'
  ult :: RegVal -> RegVal -> Maybe RegVal
ult = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
ult'
  uge :: RegVal -> RegVal -> Maybe RegVal
uge = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
uge'
  ugt :: RegVal -> RegVal -> Maybe RegVal
ugt = RegVal -> RegVal -> Maybe RegVal
forall {a}. ValueRepr a => RegVal -> RegVal -> Maybe a
ugt'

  ord :: RegVal -> RegVal -> Maybe RegVal
ord (VSingle Float
lhs) (VSingle Float
rhs) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Bool -> RegVal) -> Bool -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RegVal
fromBool (Bool -> Maybe RegVal) -> Bool -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
lhs Bool -> Bool -> Bool
|| Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
rhs)
  ord (VDouble Double
lhs) (VDouble Double
rhs) =
    RegVal -> Maybe RegVal
forall a. a -> Maybe a
Just (RegVal -> Maybe RegVal)
-> (Bool -> RegVal) -> Bool -> Maybe RegVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> RegVal
fromBool (Bool -> Maybe RegVal) -> Bool -> Maybe RegVal
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
lhs Bool -> Bool -> Bool
|| Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
rhs)
  ord RegVal
_ RegVal
_ = Maybe RegVal
forall a. Maybe a
Nothing