{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Safe #-}
-- | Definitions of primitive types, the values that inhabit these
-- types, and operations on these values.  A primitive value can also
-- be called a scalar.
--
-- Essentially, this module describes the subset of the (internal)
-- Futhark language that operates on primitive types.
module Futhark.IR.Primitive
       ( -- * Types
         IntType (..), allIntTypes
       , FloatType (..), allFloatTypes
       , PrimType (..), allPrimTypes

         -- * Values
       , IntValue(..)
       , intValue, intValueType, valueIntegral
       , FloatValue(..)
       , floatValue, floatValueType
       , PrimValue(..)
       , primValueType
       , blankPrimValue

         -- * Operations
       , Overflow (..)
       , Safety(..)
       , UnOp (..), allUnOps
       , BinOp (..), allBinOps
       , ConvOp (..), allConvOps
       , CmpOp (..), allCmpOps

         -- ** Unary Operations
       , doUnOp
       , doComplement
       , doAbs, doFAbs
       , doSSignum, doUSignum

         -- ** Binary Operations
       , doBinOp
       , doAdd, doMul, doSDiv, doSMod
       , doPow

         -- ** Conversion Operations
       , doConvOp
       , doZExt, doSExt
       , doFPConv
       , doFPToUI, doFPToSI
       , doUIToFP, doSIToFP
       , intToInt64, intToWord64

         -- * Comparison Operations
       , doCmpOp
       , doCmpEq
       , doCmpUlt, doCmpUle
       , doCmpSlt, doCmpSle
       , doFCmpLt, doFCmpLe

        -- * Type Of
       , binOpType
       , unOpType
       , cmpOpType
       , convOpType

       -- * Primitive functions
       , primFuns

       -- * Utility
       , zeroIsh
       , zeroIshInt
       , oneIsh
       , oneIshInt
       , negativeIsh
       , primBitSize
       , primByteSize
       , intByteSize
       , floatByteSize
       , commutativeBinOp

       -- * Prettyprinting
       , convOpFun
       , prettySigned
       )
       where

import           Control.Applicative
import qualified Data.Binary.Get as G
import qualified Data.Binary.Put as P
import           Data.Bits
import           Data.Fixed (mod') -- Weird location.
import           Data.Int            (Int16, Int32, Int64, Int8)
import qualified Data.Map as M
import           Data.Word

import           Prelude

import           Futhark.Util.Pretty
import           Futhark.Util (roundFloat, ceilFloat, floorFloat,
                               roundDouble, ceilDouble, floorDouble,
                               lgamma, lgammaf, tgamma, tgammaf)

-- | An integer type, ordered by size.  Note that signedness is not a
-- property of the type, but a property of the operations performed on
-- values of these types.
data IntType = Int8
             | Int16
             | Int32
             | Int64
             deriving (IntType -> IntType -> Bool
(IntType -> IntType -> Bool)
-> (IntType -> IntType -> Bool) -> Eq IntType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntType -> IntType -> Bool
$c/= :: IntType -> IntType -> Bool
== :: IntType -> IntType -> Bool
$c== :: IntType -> IntType -> Bool
Eq, Eq IntType
Eq IntType
-> (IntType -> IntType -> Ordering)
-> (IntType -> IntType -> Bool)
-> (IntType -> IntType -> Bool)
-> (IntType -> IntType -> Bool)
-> (IntType -> IntType -> Bool)
-> (IntType -> IntType -> IntType)
-> (IntType -> IntType -> IntType)
-> Ord IntType
IntType -> IntType -> Bool
IntType -> IntType -> Ordering
IntType -> IntType -> IntType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IntType -> IntType -> IntType
$cmin :: IntType -> IntType -> IntType
max :: IntType -> IntType -> IntType
$cmax :: IntType -> IntType -> IntType
>= :: IntType -> IntType -> Bool
$c>= :: IntType -> IntType -> Bool
> :: IntType -> IntType -> Bool
$c> :: IntType -> IntType -> Bool
<= :: IntType -> IntType -> Bool
$c<= :: IntType -> IntType -> Bool
< :: IntType -> IntType -> Bool
$c< :: IntType -> IntType -> Bool
compare :: IntType -> IntType -> Ordering
$ccompare :: IntType -> IntType -> Ordering
$cp1Ord :: Eq IntType
Ord, Int -> IntType -> ShowS
[IntType] -> ShowS
IntType -> String
(Int -> IntType -> ShowS)
-> (IntType -> String) -> ([IntType] -> ShowS) -> Show IntType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntType] -> ShowS
$cshowList :: [IntType] -> ShowS
show :: IntType -> String
$cshow :: IntType -> String
showsPrec :: Int -> IntType -> ShowS
$cshowsPrec :: Int -> IntType -> ShowS
Show, Int -> IntType
IntType -> Int
IntType -> [IntType]
IntType -> IntType
IntType -> IntType -> [IntType]
IntType -> IntType -> IntType -> [IntType]
(IntType -> IntType)
-> (IntType -> IntType)
-> (Int -> IntType)
-> (IntType -> Int)
-> (IntType -> [IntType])
-> (IntType -> IntType -> [IntType])
-> (IntType -> IntType -> [IntType])
-> (IntType -> IntType -> IntType -> [IntType])
-> Enum IntType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IntType -> IntType -> IntType -> [IntType]
$cenumFromThenTo :: IntType -> IntType -> IntType -> [IntType]
enumFromTo :: IntType -> IntType -> [IntType]
$cenumFromTo :: IntType -> IntType -> [IntType]
enumFromThen :: IntType -> IntType -> [IntType]
$cenumFromThen :: IntType -> IntType -> [IntType]
enumFrom :: IntType -> [IntType]
$cenumFrom :: IntType -> [IntType]
fromEnum :: IntType -> Int
$cfromEnum :: IntType -> Int
toEnum :: Int -> IntType
$ctoEnum :: Int -> IntType
pred :: IntType -> IntType
$cpred :: IntType -> IntType
succ :: IntType -> IntType
$csucc :: IntType -> IntType
Enum, IntType
IntType -> IntType -> Bounded IntType
forall a. a -> a -> Bounded a
maxBound :: IntType
$cmaxBound :: IntType
minBound :: IntType
$cminBound :: IntType
Bounded)

instance Pretty IntType where
  ppr :: IntType -> Doc
ppr IntType
Int8  = String -> Doc
text String
"i8"
  ppr IntType
Int16 = String -> Doc
text String
"i16"
  ppr IntType
Int32 = String -> Doc
text String
"i32"
  ppr IntType
Int64 = String -> Doc
text String
"i64"

-- | A list of all integer types.
allIntTypes :: [IntType]
allIntTypes :: [IntType]
allIntTypes = [IntType
forall a. Bounded a => a
minBound..IntType
forall a. Bounded a => a
maxBound]

-- | A floating point type.
data FloatType = Float32
               | Float64
               deriving (FloatType -> FloatType -> Bool
(FloatType -> FloatType -> Bool)
-> (FloatType -> FloatType -> Bool) -> Eq FloatType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatType -> FloatType -> Bool
$c/= :: FloatType -> FloatType -> Bool
== :: FloatType -> FloatType -> Bool
$c== :: FloatType -> FloatType -> Bool
Eq, Eq FloatType
Eq FloatType
-> (FloatType -> FloatType -> Ordering)
-> (FloatType -> FloatType -> Bool)
-> (FloatType -> FloatType -> Bool)
-> (FloatType -> FloatType -> Bool)
-> (FloatType -> FloatType -> Bool)
-> (FloatType -> FloatType -> FloatType)
-> (FloatType -> FloatType -> FloatType)
-> Ord FloatType
FloatType -> FloatType -> Bool
FloatType -> FloatType -> Ordering
FloatType -> FloatType -> FloatType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FloatType -> FloatType -> FloatType
$cmin :: FloatType -> FloatType -> FloatType
max :: FloatType -> FloatType -> FloatType
$cmax :: FloatType -> FloatType -> FloatType
>= :: FloatType -> FloatType -> Bool
$c>= :: FloatType -> FloatType -> Bool
> :: FloatType -> FloatType -> Bool
$c> :: FloatType -> FloatType -> Bool
<= :: FloatType -> FloatType -> Bool
$c<= :: FloatType -> FloatType -> Bool
< :: FloatType -> FloatType -> Bool
$c< :: FloatType -> FloatType -> Bool
compare :: FloatType -> FloatType -> Ordering
$ccompare :: FloatType -> FloatType -> Ordering
$cp1Ord :: Eq FloatType
Ord, Int -> FloatType -> ShowS
[FloatType] -> ShowS
FloatType -> String
(Int -> FloatType -> ShowS)
-> (FloatType -> String)
-> ([FloatType] -> ShowS)
-> Show FloatType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FloatType] -> ShowS
$cshowList :: [FloatType] -> ShowS
show :: FloatType -> String
$cshow :: FloatType -> String
showsPrec :: Int -> FloatType -> ShowS
$cshowsPrec :: Int -> FloatType -> ShowS
Show, Int -> FloatType
FloatType -> Int
FloatType -> [FloatType]
FloatType -> FloatType
FloatType -> FloatType -> [FloatType]
FloatType -> FloatType -> FloatType -> [FloatType]
(FloatType -> FloatType)
-> (FloatType -> FloatType)
-> (Int -> FloatType)
-> (FloatType -> Int)
-> (FloatType -> [FloatType])
-> (FloatType -> FloatType -> [FloatType])
-> (FloatType -> FloatType -> [FloatType])
-> (FloatType -> FloatType -> FloatType -> [FloatType])
-> Enum FloatType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FloatType -> FloatType -> FloatType -> [FloatType]
$cenumFromThenTo :: FloatType -> FloatType -> FloatType -> [FloatType]
enumFromTo :: FloatType -> FloatType -> [FloatType]
$cenumFromTo :: FloatType -> FloatType -> [FloatType]
enumFromThen :: FloatType -> FloatType -> [FloatType]
$cenumFromThen :: FloatType -> FloatType -> [FloatType]
enumFrom :: FloatType -> [FloatType]
$cenumFrom :: FloatType -> [FloatType]
fromEnum :: FloatType -> Int
$cfromEnum :: FloatType -> Int
toEnum :: Int -> FloatType
$ctoEnum :: Int -> FloatType
pred :: FloatType -> FloatType
$cpred :: FloatType -> FloatType
succ :: FloatType -> FloatType
$csucc :: FloatType -> FloatType
Enum, FloatType
FloatType -> FloatType -> Bounded FloatType
forall a. a -> a -> Bounded a
maxBound :: FloatType
$cmaxBound :: FloatType
minBound :: FloatType
$cminBound :: FloatType
Bounded)

instance Pretty FloatType where
  ppr :: FloatType -> Doc
ppr FloatType
Float32 = String -> Doc
text String
"f32"
  ppr FloatType
Float64 = String -> Doc
text String
"f64"

-- | A list of all floating-point types.
allFloatTypes :: [FloatType]
allFloatTypes :: [FloatType]
allFloatTypes = [FloatType
forall a. Bounded a => a
minBound..FloatType
forall a. Bounded a => a
maxBound]

-- | Low-level primitive types.
data PrimType = IntType IntType
              | FloatType FloatType
              | Bool
              | Cert
              deriving (PrimType -> PrimType -> Bool
(PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool) -> Eq PrimType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimType -> PrimType -> Bool
$c/= :: PrimType -> PrimType -> Bool
== :: PrimType -> PrimType -> Bool
$c== :: PrimType -> PrimType -> Bool
Eq, Eq PrimType
Eq PrimType
-> (PrimType -> PrimType -> Ordering)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> Bool)
-> (PrimType -> PrimType -> PrimType)
-> (PrimType -> PrimType -> PrimType)
-> Ord PrimType
PrimType -> PrimType -> Bool
PrimType -> PrimType -> Ordering
PrimType -> PrimType -> PrimType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrimType -> PrimType -> PrimType
$cmin :: PrimType -> PrimType -> PrimType
max :: PrimType -> PrimType -> PrimType
$cmax :: PrimType -> PrimType -> PrimType
>= :: PrimType -> PrimType -> Bool
$c>= :: PrimType -> PrimType -> Bool
> :: PrimType -> PrimType -> Bool
$c> :: PrimType -> PrimType -> Bool
<= :: PrimType -> PrimType -> Bool
$c<= :: PrimType -> PrimType -> Bool
< :: PrimType -> PrimType -> Bool
$c< :: PrimType -> PrimType -> Bool
compare :: PrimType -> PrimType -> Ordering
$ccompare :: PrimType -> PrimType -> Ordering
$cp1Ord :: Eq PrimType
Ord, Int -> PrimType -> ShowS
[PrimType] -> ShowS
PrimType -> String
(Int -> PrimType -> ShowS)
-> (PrimType -> String) -> ([PrimType] -> ShowS) -> Show PrimType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimType] -> ShowS
$cshowList :: [PrimType] -> ShowS
show :: PrimType -> String
$cshow :: PrimType -> String
showsPrec :: Int -> PrimType -> ShowS
$cshowsPrec :: Int -> PrimType -> ShowS
Show)

instance Enum PrimType where
  toEnum :: Int -> PrimType
toEnum Int
0 = IntType -> PrimType
IntType IntType
Int8
  toEnum Int
1 = IntType -> PrimType
IntType IntType
Int16
  toEnum Int
2 = IntType -> PrimType
IntType IntType
Int32
  toEnum Int
3 = IntType -> PrimType
IntType IntType
Int64
  toEnum Int
4 = FloatType -> PrimType
FloatType FloatType
Float32
  toEnum Int
5 = FloatType -> PrimType
FloatType FloatType
Float64
  toEnum Int
6 = PrimType
Bool
  toEnum Int
_ = PrimType
Cert

  fromEnum :: PrimType -> Int
fromEnum (IntType IntType
Int8)      = Int
0
  fromEnum (IntType IntType
Int16)     = Int
1
  fromEnum (IntType IntType
Int32)     = Int
2
  fromEnum (IntType IntType
Int64)     = Int
3
  fromEnum (FloatType FloatType
Float32) = Int
4
  fromEnum (FloatType FloatType
Float64) = Int
5
  fromEnum PrimType
Bool                = Int
6
  fromEnum PrimType
Cert                = Int
7

instance Bounded PrimType where
  minBound :: PrimType
minBound = IntType -> PrimType
IntType IntType
Int8
  maxBound :: PrimType
maxBound = PrimType
Cert

instance Pretty PrimType where
  ppr :: PrimType -> Doc
ppr (IntType IntType
t)   = IntType -> Doc
forall a. Pretty a => a -> Doc
ppr IntType
t
  ppr (FloatType FloatType
t) = FloatType -> Doc
forall a. Pretty a => a -> Doc
ppr FloatType
t
  ppr PrimType
Bool          = String -> Doc
text String
"bool"
  ppr PrimType
Cert          = String -> Doc
text String
"cert"

-- | A list of all primitive types.
allPrimTypes :: [PrimType]
allPrimTypes :: [PrimType]
allPrimTypes = (IntType -> PrimType) -> [IntType] -> [PrimType]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> PrimType
IntType [IntType]
allIntTypes [PrimType] -> [PrimType] -> [PrimType]
forall a. [a] -> [a] -> [a]
++
               (FloatType -> PrimType) -> [FloatType] -> [PrimType]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> PrimType
FloatType [FloatType]
allFloatTypes [PrimType] -> [PrimType] -> [PrimType]
forall a. [a] -> [a] -> [a]
++
               [PrimType
Bool, PrimType
Cert]

-- | An integer value.
data IntValue = Int8Value !Int8
              | Int16Value !Int16
              | Int32Value !Int32
              | Int64Value !Int64
               deriving (IntValue -> IntValue -> Bool
(IntValue -> IntValue -> Bool)
-> (IntValue -> IntValue -> Bool) -> Eq IntValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntValue -> IntValue -> Bool
$c/= :: IntValue -> IntValue -> Bool
== :: IntValue -> IntValue -> Bool
$c== :: IntValue -> IntValue -> Bool
Eq, Eq IntValue
Eq IntValue
-> (IntValue -> IntValue -> Ordering)
-> (IntValue -> IntValue -> Bool)
-> (IntValue -> IntValue -> Bool)
-> (IntValue -> IntValue -> Bool)
-> (IntValue -> IntValue -> Bool)
-> (IntValue -> IntValue -> IntValue)
-> (IntValue -> IntValue -> IntValue)
-> Ord IntValue
IntValue -> IntValue -> Bool
IntValue -> IntValue -> Ordering
IntValue -> IntValue -> IntValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IntValue -> IntValue -> IntValue
$cmin :: IntValue -> IntValue -> IntValue
max :: IntValue -> IntValue -> IntValue
$cmax :: IntValue -> IntValue -> IntValue
>= :: IntValue -> IntValue -> Bool
$c>= :: IntValue -> IntValue -> Bool
> :: IntValue -> IntValue -> Bool
$c> :: IntValue -> IntValue -> Bool
<= :: IntValue -> IntValue -> Bool
$c<= :: IntValue -> IntValue -> Bool
< :: IntValue -> IntValue -> Bool
$c< :: IntValue -> IntValue -> Bool
compare :: IntValue -> IntValue -> Ordering
$ccompare :: IntValue -> IntValue -> Ordering
$cp1Ord :: Eq IntValue
Ord, Int -> IntValue -> ShowS
[IntValue] -> ShowS
IntValue -> String
(Int -> IntValue -> ShowS)
-> (IntValue -> String) -> ([IntValue] -> ShowS) -> Show IntValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntValue] -> ShowS
$cshowList :: [IntValue] -> ShowS
show :: IntValue -> String
$cshow :: IntValue -> String
showsPrec :: Int -> IntValue -> ShowS
$cshowsPrec :: Int -> IntValue -> ShowS
Show)

instance Pretty IntValue where
  ppr :: IntValue -> Doc
ppr (Int8Value Int8
v)  = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int8 -> String
forall a. Show a => a -> String
show Int8
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"i8"
  ppr (Int16Value Int16
v) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int16 -> String
forall a. Show a => a -> String
show Int16
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"i16"
  ppr (Int32Value Int32
v) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int32 -> String
forall a. Show a => a -> String
show Int32
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"i32"
  ppr (Int64Value Int64
v) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int64 -> String
forall a. Show a => a -> String
show Int64
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"i64"

-- | Create an t'IntValue' from a type and an 'Integer'.
intValue :: Integral int => IntType -> int -> IntValue
intValue :: IntType -> int -> IntValue
intValue IntType
Int8  = Int8 -> IntValue
Int8Value (Int8 -> IntValue) -> (int -> Int8) -> int -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
intValue IntType
Int16 = Int16 -> IntValue
Int16Value (Int16 -> IntValue) -> (int -> Int16) -> int -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. int -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
intValue IntType
Int32 = Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (int -> Int32) -> int -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
intValue IntType
Int64 = Int64 -> IntValue
Int64Value (Int64 -> IntValue) -> (int -> Int64) -> int -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | The type of an integer value.
intValueType :: IntValue -> IntType
intValueType :: IntValue -> IntType
intValueType Int8Value{}  = IntType
Int8
intValueType Int16Value{} = IntType
Int16
intValueType Int32Value{} = IntType
Int32
intValueType Int64Value{} = IntType
Int64

-- | Convert an t'IntValue' to any 'Integral' type.
valueIntegral :: Integral int => IntValue -> int
valueIntegral :: IntValue -> int
valueIntegral (Int8Value  Int8
v) = Int8 -> int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v
valueIntegral (Int16Value Int16
v) = Int16 -> int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
v
valueIntegral (Int32Value Int32
v) = Int32 -> int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v
valueIntegral (Int64Value Int64
v) = Int64 -> int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v

-- | A floating-point value.
data FloatValue = Float32Value !Float
                | Float64Value !Double
               deriving (FloatValue -> FloatValue -> Bool
(FloatValue -> FloatValue -> Bool)
-> (FloatValue -> FloatValue -> Bool) -> Eq FloatValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatValue -> FloatValue -> Bool
$c/= :: FloatValue -> FloatValue -> Bool
== :: FloatValue -> FloatValue -> Bool
$c== :: FloatValue -> FloatValue -> Bool
Eq, Eq FloatValue
Eq FloatValue
-> (FloatValue -> FloatValue -> Ordering)
-> (FloatValue -> FloatValue -> Bool)
-> (FloatValue -> FloatValue -> Bool)
-> (FloatValue -> FloatValue -> Bool)
-> (FloatValue -> FloatValue -> Bool)
-> (FloatValue -> FloatValue -> FloatValue)
-> (FloatValue -> FloatValue -> FloatValue)
-> Ord FloatValue
FloatValue -> FloatValue -> Bool
FloatValue -> FloatValue -> Ordering
FloatValue -> FloatValue -> FloatValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FloatValue -> FloatValue -> FloatValue
$cmin :: FloatValue -> FloatValue -> FloatValue
max :: FloatValue -> FloatValue -> FloatValue
$cmax :: FloatValue -> FloatValue -> FloatValue
>= :: FloatValue -> FloatValue -> Bool
$c>= :: FloatValue -> FloatValue -> Bool
> :: FloatValue -> FloatValue -> Bool
$c> :: FloatValue -> FloatValue -> Bool
<= :: FloatValue -> FloatValue -> Bool
$c<= :: FloatValue -> FloatValue -> Bool
< :: FloatValue -> FloatValue -> Bool
$c< :: FloatValue -> FloatValue -> Bool
compare :: FloatValue -> FloatValue -> Ordering
$ccompare :: FloatValue -> FloatValue -> Ordering
$cp1Ord :: Eq FloatValue
Ord, Int -> FloatValue -> ShowS
[FloatValue] -> ShowS
FloatValue -> String
(Int -> FloatValue -> ShowS)
-> (FloatValue -> String)
-> ([FloatValue] -> ShowS)
-> Show FloatValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FloatValue] -> ShowS
$cshowList :: [FloatValue] -> ShowS
show :: FloatValue -> String
$cshow :: FloatValue -> String
showsPrec :: Int -> FloatValue -> ShowS
$cshowsPrec :: Int -> FloatValue -> ShowS
Show)


instance Pretty FloatValue where
  ppr :: FloatValue -> Doc
ppr (Float32Value Float
v)
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
v, Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 = String -> Doc
text String
"f32.inf"
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
v, Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<  Float
0 = String -> Doc
text String
"-f32.inf"
    | Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
v = String -> Doc
text String
"f32.nan"
    | Bool
otherwise = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Float -> String
forall a. Show a => a -> String
show Float
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"f32"
  ppr (Float64Value Double
v)
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
v, Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
0 = String -> Doc
text String
"f64.inf"
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
v, Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<  Double
0 = String -> Doc
text String
"-f64.inf"
    | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v = String -> Doc
text String
"f64.nan"
    | Bool
otherwise = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"f64"

-- | Create a t'FloatValue' from a type and a 'Rational'.
floatValue :: Real num => FloatType -> num -> FloatValue
floatValue :: FloatType -> num -> FloatValue
floatValue FloatType
Float32 = Float -> FloatValue
Float32Value (Float -> FloatValue) -> (num -> Float) -> num -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Rational -> Float) -> (num -> Rational) -> num -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. num -> Rational
forall a. Real a => a -> Rational
toRational
floatValue FloatType
Float64 = Double -> FloatValue
Float64Value (Double -> FloatValue) -> (num -> Double) -> num -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> (num -> Rational) -> num -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. num -> Rational
forall a. Real a => a -> Rational
toRational

-- | The type of a floating-point value.
floatValueType :: FloatValue -> FloatType
floatValueType :: FloatValue -> FloatType
floatValueType Float32Value{} = FloatType
Float32
floatValueType Float64Value{} = FloatType
Float64

-- | Non-array values.
data PrimValue = IntValue !IntValue
               | FloatValue !FloatValue
               | BoolValue !Bool
               | Checked -- ^ The only value of type @cert@.
               deriving (PrimValue -> PrimValue -> Bool
(PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> Bool) -> Eq PrimValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimValue -> PrimValue -> Bool
$c/= :: PrimValue -> PrimValue -> Bool
== :: PrimValue -> PrimValue -> Bool
$c== :: PrimValue -> PrimValue -> Bool
Eq, Eq PrimValue
Eq PrimValue
-> (PrimValue -> PrimValue -> Ordering)
-> (PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> Bool)
-> (PrimValue -> PrimValue -> PrimValue)
-> (PrimValue -> PrimValue -> PrimValue)
-> Ord PrimValue
PrimValue -> PrimValue -> Bool
PrimValue -> PrimValue -> Ordering
PrimValue -> PrimValue -> PrimValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PrimValue -> PrimValue -> PrimValue
$cmin :: PrimValue -> PrimValue -> PrimValue
max :: PrimValue -> PrimValue -> PrimValue
$cmax :: PrimValue -> PrimValue -> PrimValue
>= :: PrimValue -> PrimValue -> Bool
$c>= :: PrimValue -> PrimValue -> Bool
> :: PrimValue -> PrimValue -> Bool
$c> :: PrimValue -> PrimValue -> Bool
<= :: PrimValue -> PrimValue -> Bool
$c<= :: PrimValue -> PrimValue -> Bool
< :: PrimValue -> PrimValue -> Bool
$c< :: PrimValue -> PrimValue -> Bool
compare :: PrimValue -> PrimValue -> Ordering
$ccompare :: PrimValue -> PrimValue -> Ordering
$cp1Ord :: Eq PrimValue
Ord, Int -> PrimValue -> ShowS
[PrimValue] -> ShowS
PrimValue -> String
(Int -> PrimValue -> ShowS)
-> (PrimValue -> String)
-> ([PrimValue] -> ShowS)
-> Show PrimValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrimValue] -> ShowS
$cshowList :: [PrimValue] -> ShowS
show :: PrimValue -> String
$cshow :: PrimValue -> String
showsPrec :: Int -> PrimValue -> ShowS
$cshowsPrec :: Int -> PrimValue -> ShowS
Show)

instance Pretty PrimValue where
  ppr :: PrimValue -> Doc
ppr (IntValue IntValue
v)      = IntValue -> Doc
forall a. Pretty a => a -> Doc
ppr IntValue
v
  ppr (BoolValue Bool
True)  = String -> Doc
text String
"true"
  ppr (BoolValue Bool
False) = String -> Doc
text String
"false"
  ppr (FloatValue FloatValue
v)    = FloatValue -> Doc
forall a. Pretty a => a -> Doc
ppr FloatValue
v
  ppr PrimValue
Checked           = String -> Doc
text String
"checked"

-- | The type of a basic value.
primValueType :: PrimValue -> PrimType
primValueType :: PrimValue -> PrimType
primValueType (IntValue IntValue
v)   = IntType -> PrimType
IntType (IntType -> PrimType) -> IntType -> PrimType
forall a b. (a -> b) -> a -> b
$ IntValue -> IntType
intValueType IntValue
v
primValueType (FloatValue FloatValue
v) = FloatType -> PrimType
FloatType (FloatType -> PrimType) -> FloatType -> PrimType
forall a b. (a -> b) -> a -> b
$ FloatValue -> FloatType
floatValueType FloatValue
v
primValueType BoolValue{}    = PrimType
Bool
primValueType PrimValue
Checked        = PrimType
Cert

-- | A "blank" value of the given primitive type - this is zero, or
-- whatever is close to it.  Don't depend on this value, but use it
-- for e.g. creating arrays to be populated by do-loops.
blankPrimValue :: PrimType -> PrimValue
blankPrimValue :: PrimType -> PrimValue
blankPrimValue (IntType IntType
Int8)      = IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Int8 -> IntValue
Int8Value Int8
0
blankPrimValue (IntType IntType
Int16)     = IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Int16 -> IntValue
Int16Value Int16
0
blankPrimValue (IntType IntType
Int32)     = IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Int32 -> IntValue
Int32Value Int32
0
blankPrimValue (IntType IntType
Int64)     = IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Int64 -> IntValue
Int64Value Int64
0
blankPrimValue (FloatType FloatType
Float32) = FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Float -> FloatValue
Float32Value Float
0.0
blankPrimValue (FloatType FloatType
Float64) = FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Double -> FloatValue
Float64Value Double
0.0
blankPrimValue PrimType
Bool                = Bool -> PrimValue
BoolValue Bool
False
blankPrimValue PrimType
Cert                = PrimValue
Checked

-- | Various unary operators.  It is a bit ad-hoc what is a unary
-- operator and what is a built-in function.  Perhaps these should all
-- go away eventually.
data UnOp = Not -- ^ E.g., @! True == False@.
          | Complement IntType -- ^ E.g., @~(~1) = 1@.
          | Abs IntType -- ^ @abs(-2) = 2@.
          | FAbs FloatType -- ^ @fabs(-2.0) = 2.0@.
          | SSignum IntType -- ^ Signed sign function: @ssignum(-2)@ = -1.
          | USignum IntType -- ^ Unsigned sign function: @usignum(2)@ = 1.
             deriving (UnOp -> UnOp -> Bool
(UnOp -> UnOp -> Bool) -> (UnOp -> UnOp -> Bool) -> Eq UnOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnOp -> UnOp -> Bool
$c/= :: UnOp -> UnOp -> Bool
== :: UnOp -> UnOp -> Bool
$c== :: UnOp -> UnOp -> Bool
Eq, Eq UnOp
Eq UnOp
-> (UnOp -> UnOp -> Ordering)
-> (UnOp -> UnOp -> Bool)
-> (UnOp -> UnOp -> Bool)
-> (UnOp -> UnOp -> Bool)
-> (UnOp -> UnOp -> Bool)
-> (UnOp -> UnOp -> UnOp)
-> (UnOp -> UnOp -> UnOp)
-> Ord UnOp
UnOp -> UnOp -> Bool
UnOp -> UnOp -> Ordering
UnOp -> UnOp -> UnOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UnOp -> UnOp -> UnOp
$cmin :: UnOp -> UnOp -> UnOp
max :: UnOp -> UnOp -> UnOp
$cmax :: UnOp -> UnOp -> UnOp
>= :: UnOp -> UnOp -> Bool
$c>= :: UnOp -> UnOp -> Bool
> :: UnOp -> UnOp -> Bool
$c> :: UnOp -> UnOp -> Bool
<= :: UnOp -> UnOp -> Bool
$c<= :: UnOp -> UnOp -> Bool
< :: UnOp -> UnOp -> Bool
$c< :: UnOp -> UnOp -> Bool
compare :: UnOp -> UnOp -> Ordering
$ccompare :: UnOp -> UnOp -> Ordering
$cp1Ord :: Eq UnOp
Ord, Int -> UnOp -> ShowS
[UnOp] -> ShowS
UnOp -> String
(Int -> UnOp -> ShowS)
-> (UnOp -> String) -> ([UnOp] -> ShowS) -> Show UnOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnOp] -> ShowS
$cshowList :: [UnOp] -> ShowS
show :: UnOp -> String
$cshow :: UnOp -> String
showsPrec :: Int -> UnOp -> ShowS
$cshowsPrec :: Int -> UnOp -> ShowS
Show)

-- | What to do in case of arithmetic overflow.  Futhark's semantics
-- are that overflow does wraparound, but for generated code (like
-- address arithmetic), it can be beneficial for overflow to be
-- undefined behaviour, as it allows better optimisation of things
-- such as GPU kernels.
--
-- Note that all values of this type are considered equal for 'Eq' and
-- 'Ord'.
data Overflow = OverflowWrap | OverflowUndef
              deriving (Int -> Overflow -> ShowS
[Overflow] -> ShowS
Overflow -> String
(Int -> Overflow -> ShowS)
-> (Overflow -> String) -> ([Overflow] -> ShowS) -> Show Overflow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Overflow] -> ShowS
$cshowList :: [Overflow] -> ShowS
show :: Overflow -> String
$cshow :: Overflow -> String
showsPrec :: Int -> Overflow -> ShowS
$cshowsPrec :: Int -> Overflow -> ShowS
Show)

instance Eq Overflow where
  Overflow
_ == :: Overflow -> Overflow -> Bool
== Overflow
_ = Bool
True

instance Ord Overflow where
  Overflow
_ compare :: Overflow -> Overflow -> Ordering
`compare` Overflow
_ = Ordering
EQ

-- | Whether something is safe or unsafe (mostly function calls, and
-- in the context of whether operations are dynamically checked).
-- When we inline an 'Unsafe' function, we remove all safety checks in
-- its body.  The 'Ord' instance picks 'Unsafe' as being less than
-- 'Safe'.
--
-- For operations like integer division, a safe division will not
-- explode the computer in case of division by zero, but instead
-- return some unspecified value.  This always involves a run-time
-- check, so generally the unsafe variant is what the compiler will
-- insert, but guarded by an explicit assertion elsewhere.  Safe
-- operations are useful when the optimiser wants to move e.g. a
-- division to a location where the divisor may be zero, but where the
-- result will only be used when it is non-zero (so it doesn't matter
-- what result is provided with a zero divisor, as long as the program
-- keeps running).
data Safety = Unsafe | Safe deriving (Safety -> Safety -> Bool
(Safety -> Safety -> Bool)
-> (Safety -> Safety -> Bool) -> Eq Safety
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Safety -> Safety -> Bool
$c/= :: Safety -> Safety -> Bool
== :: Safety -> Safety -> Bool
$c== :: Safety -> Safety -> Bool
Eq, Eq Safety
Eq Safety
-> (Safety -> Safety -> Ordering)
-> (Safety -> Safety -> Bool)
-> (Safety -> Safety -> Bool)
-> (Safety -> Safety -> Bool)
-> (Safety -> Safety -> Bool)
-> (Safety -> Safety -> Safety)
-> (Safety -> Safety -> Safety)
-> Ord Safety
Safety -> Safety -> Bool
Safety -> Safety -> Ordering
Safety -> Safety -> Safety
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Safety -> Safety -> Safety
$cmin :: Safety -> Safety -> Safety
max :: Safety -> Safety -> Safety
$cmax :: Safety -> Safety -> Safety
>= :: Safety -> Safety -> Bool
$c>= :: Safety -> Safety -> Bool
> :: Safety -> Safety -> Bool
$c> :: Safety -> Safety -> Bool
<= :: Safety -> Safety -> Bool
$c<= :: Safety -> Safety -> Bool
< :: Safety -> Safety -> Bool
$c< :: Safety -> Safety -> Bool
compare :: Safety -> Safety -> Ordering
$ccompare :: Safety -> Safety -> Ordering
$cp1Ord :: Eq Safety
Ord, Int -> Safety -> ShowS
[Safety] -> ShowS
Safety -> String
(Int -> Safety -> ShowS)
-> (Safety -> String) -> ([Safety] -> ShowS) -> Show Safety
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Safety] -> ShowS
$cshowList :: [Safety] -> ShowS
show :: Safety -> String
$cshow :: Safety -> String
showsPrec :: Int -> Safety -> ShowS
$cshowsPrec :: Int -> Safety -> ShowS
Show)

-- | Binary operators.  These correspond closely to the binary operators in
-- LLVM.  Most are parametrised by their expected input and output
-- types.
data BinOp = Add IntType Overflow -- ^ Integer addition.
           | FAdd FloatType -- ^ Floating-point addition.

           | Sub IntType Overflow -- ^ Integer subtraction.
           | FSub FloatType -- ^ Floating-point subtraction.

           | Mul IntType Overflow -- ^ Integer multiplication.
           | FMul FloatType -- ^ Floating-point multiplication.

           | UDiv IntType Safety
             -- ^ Unsigned integer division.  Rounds towards
             -- negativity infinity.  Note: this is different
             -- from LLVM.
           | UDivUp IntType Safety
             -- ^ Unsigned integer division.  Rounds towards positive
             -- infinity.

           | SDiv IntType Safety
             -- ^ Signed integer division.  Rounds towards
             -- negativity infinity.  Note: this is different
             -- from LLVM.
           | SDivUp IntType Safety
             -- ^ Signed integer division.  Rounds towards positive
             -- infinity.

           | FDiv FloatType -- ^ Floating-point division.
           | FMod FloatType -- ^ Floating-point modulus.

           | UMod IntType Safety
             -- ^ Unsigned integer modulus; the countepart to 'UDiv'.
           | SMod IntType Safety
             -- ^ Signed integer modulus; the countepart to 'SDiv'.

           | SQuot IntType Safety
             -- ^ Signed integer division.  Rounds towards zero.  This
             -- corresponds to the @sdiv@ instruction in LLVM and
             -- integer division in C.
           | SRem IntType Safety
             -- ^ Signed integer division.  Rounds towards zero.  This
             -- corresponds to the @srem@ instruction in LLVM and
             -- integer modulo in C.

           | SMin IntType
             -- ^ Returns the smallest of two signed integers.
           | UMin IntType
             -- ^ Returns the smallest of two unsigned integers.
           | FMin FloatType
             -- ^ Returns the smallest of two floating-point numbers.
           | SMax IntType
             -- ^ Returns the greatest of two signed integers.
           | UMax IntType
             -- ^ Returns the greatest of two unsigned integers.
           | FMax FloatType
             -- ^ Returns the greatest of two floating-point numbers.

           | Shl IntType -- ^ Left-shift.
           | LShr IntType -- ^ Logical right-shift, zero-extended.
           | AShr IntType -- ^ Arithmetic right-shift, sign-extended.

           | And IntType -- ^ Bitwise and.
           | Or IntType -- ^ Bitwise or.
           | Xor IntType -- ^ Bitwise exclusive-or.

           | Pow IntType -- ^ Integer exponentiation.
           | FPow FloatType -- ^ Floating-point exponentiation.

           | LogAnd -- ^ Boolean and - not short-circuiting.
           | LogOr -- ^ Boolean or - not short-circuiting.
             deriving (BinOp -> BinOp -> Bool
(BinOp -> BinOp -> Bool) -> (BinOp -> BinOp -> Bool) -> Eq BinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c== :: BinOp -> BinOp -> Bool
Eq, Eq BinOp
Eq BinOp
-> (BinOp -> BinOp -> Ordering)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> Bool)
-> (BinOp -> BinOp -> BinOp)
-> (BinOp -> BinOp -> BinOp)
-> Ord BinOp
BinOp -> BinOp -> Bool
BinOp -> BinOp -> Ordering
BinOp -> BinOp -> BinOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BinOp -> BinOp -> BinOp
$cmin :: BinOp -> BinOp -> BinOp
max :: BinOp -> BinOp -> BinOp
$cmax :: BinOp -> BinOp -> BinOp
>= :: BinOp -> BinOp -> Bool
$c>= :: BinOp -> BinOp -> Bool
> :: BinOp -> BinOp -> Bool
$c> :: BinOp -> BinOp -> Bool
<= :: BinOp -> BinOp -> Bool
$c<= :: BinOp -> BinOp -> Bool
< :: BinOp -> BinOp -> Bool
$c< :: BinOp -> BinOp -> Bool
compare :: BinOp -> BinOp -> Ordering
$ccompare :: BinOp -> BinOp -> Ordering
$cp1Ord :: Eq BinOp
Ord, Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinOp] -> ShowS
$cshowList :: [BinOp] -> ShowS
show :: BinOp -> String
$cshow :: BinOp -> String
showsPrec :: Int -> BinOp -> ShowS
$cshowsPrec :: Int -> BinOp -> ShowS
Show)

-- | Comparison operators are like 'BinOp's, but they always return a
-- boolean value.  The somewhat ugly constructor names are straight
-- out of LLVM.
data CmpOp = CmpEq PrimType -- ^ All types equality.
           | CmpUlt IntType -- ^ Unsigned less than.
           | CmpUle IntType -- ^ Unsigned less than or equal.
           | CmpSlt IntType -- ^ Signed less than.
           | CmpSle IntType -- ^ Signed less than or equal.

             -- Comparison operators for floating-point values.  TODO: extend
             -- this to handle NaNs and such, like the LLVM fcmp instruction.
           | FCmpLt FloatType -- ^ Floating-point less than.
           | FCmpLe FloatType -- ^ Floating-point less than or equal.

           -- Boolean comparison.
           | CmpLlt -- ^ Boolean less than.
           | CmpLle -- ^ Boolean less than or equal.
             deriving (CmpOp -> CmpOp -> Bool
(CmpOp -> CmpOp -> Bool) -> (CmpOp -> CmpOp -> Bool) -> Eq CmpOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmpOp -> CmpOp -> Bool
$c/= :: CmpOp -> CmpOp -> Bool
== :: CmpOp -> CmpOp -> Bool
$c== :: CmpOp -> CmpOp -> Bool
Eq, Eq CmpOp
Eq CmpOp
-> (CmpOp -> CmpOp -> Ordering)
-> (CmpOp -> CmpOp -> Bool)
-> (CmpOp -> CmpOp -> Bool)
-> (CmpOp -> CmpOp -> Bool)
-> (CmpOp -> CmpOp -> Bool)
-> (CmpOp -> CmpOp -> CmpOp)
-> (CmpOp -> CmpOp -> CmpOp)
-> Ord CmpOp
CmpOp -> CmpOp -> Bool
CmpOp -> CmpOp -> Ordering
CmpOp -> CmpOp -> CmpOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CmpOp -> CmpOp -> CmpOp
$cmin :: CmpOp -> CmpOp -> CmpOp
max :: CmpOp -> CmpOp -> CmpOp
$cmax :: CmpOp -> CmpOp -> CmpOp
>= :: CmpOp -> CmpOp -> Bool
$c>= :: CmpOp -> CmpOp -> Bool
> :: CmpOp -> CmpOp -> Bool
$c> :: CmpOp -> CmpOp -> Bool
<= :: CmpOp -> CmpOp -> Bool
$c<= :: CmpOp -> CmpOp -> Bool
< :: CmpOp -> CmpOp -> Bool
$c< :: CmpOp -> CmpOp -> Bool
compare :: CmpOp -> CmpOp -> Ordering
$ccompare :: CmpOp -> CmpOp -> Ordering
$cp1Ord :: Eq CmpOp
Ord, Int -> CmpOp -> ShowS
[CmpOp] -> ShowS
CmpOp -> String
(Int -> CmpOp -> ShowS)
-> (CmpOp -> String) -> ([CmpOp] -> ShowS) -> Show CmpOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CmpOp] -> ShowS
$cshowList :: [CmpOp] -> ShowS
show :: CmpOp -> String
$cshow :: CmpOp -> String
showsPrec :: Int -> CmpOp -> ShowS
$cshowsPrec :: Int -> CmpOp -> ShowS
Show)

-- | Conversion operators try to generalise the @from t0 x to t1@
-- instructions from LLVM.
data ConvOp = ZExt IntType IntType
              -- ^ Zero-extend the former integer type to the latter.
              -- If the new type is smaller, the result is a
              -- truncation.
            | SExt IntType IntType
              -- ^ Sign-extend the former integer type to the latter.
              -- If the new type is smaller, the result is a
              -- truncation.
            | FPConv FloatType FloatType
              -- ^ Convert value of the former floating-point type to
              -- the latter.  If the new type is smaller, the result
              -- is a truncation.
            | FPToUI FloatType IntType
              -- ^ Convert a floating-point value to the nearest
              -- unsigned integer (rounding towards zero).
            | FPToSI FloatType IntType
              -- ^ Convert a floating-point value to the nearest
              -- signed integer (rounding towards zero).
            | UIToFP IntType FloatType
              -- ^ Convert an unsigned integer to a floating-point value.
            | SIToFP IntType FloatType
              -- ^ Convert a signed integer to a floating-point value.
            | IToB IntType
              -- ^ Convert an integer to a boolean value.  Zero
              -- becomes false; anything else is true.
            | BToI IntType
              -- ^ Convert a boolean to an integer.  True is converted
              -- to 1 and False to 0.
             deriving (ConvOp -> ConvOp -> Bool
(ConvOp -> ConvOp -> Bool)
-> (ConvOp -> ConvOp -> Bool) -> Eq ConvOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConvOp -> ConvOp -> Bool
$c/= :: ConvOp -> ConvOp -> Bool
== :: ConvOp -> ConvOp -> Bool
$c== :: ConvOp -> ConvOp -> Bool
Eq, Eq ConvOp
Eq ConvOp
-> (ConvOp -> ConvOp -> Ordering)
-> (ConvOp -> ConvOp -> Bool)
-> (ConvOp -> ConvOp -> Bool)
-> (ConvOp -> ConvOp -> Bool)
-> (ConvOp -> ConvOp -> Bool)
-> (ConvOp -> ConvOp -> ConvOp)
-> (ConvOp -> ConvOp -> ConvOp)
-> Ord ConvOp
ConvOp -> ConvOp -> Bool
ConvOp -> ConvOp -> Ordering
ConvOp -> ConvOp -> ConvOp
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConvOp -> ConvOp -> ConvOp
$cmin :: ConvOp -> ConvOp -> ConvOp
max :: ConvOp -> ConvOp -> ConvOp
$cmax :: ConvOp -> ConvOp -> ConvOp
>= :: ConvOp -> ConvOp -> Bool
$c>= :: ConvOp -> ConvOp -> Bool
> :: ConvOp -> ConvOp -> Bool
$c> :: ConvOp -> ConvOp -> Bool
<= :: ConvOp -> ConvOp -> Bool
$c<= :: ConvOp -> ConvOp -> Bool
< :: ConvOp -> ConvOp -> Bool
$c< :: ConvOp -> ConvOp -> Bool
compare :: ConvOp -> ConvOp -> Ordering
$ccompare :: ConvOp -> ConvOp -> Ordering
$cp1Ord :: Eq ConvOp
Ord, Int -> ConvOp -> ShowS
[ConvOp] -> ShowS
ConvOp -> String
(Int -> ConvOp -> ShowS)
-> (ConvOp -> String) -> ([ConvOp] -> ShowS) -> Show ConvOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConvOp] -> ShowS
$cshowList :: [ConvOp] -> ShowS
show :: ConvOp -> String
$cshow :: ConvOp -> String
showsPrec :: Int -> ConvOp -> ShowS
$cshowsPrec :: Int -> ConvOp -> ShowS
Show)

-- | A list of all unary operators for all types.
allUnOps :: [UnOp]
allUnOps :: [UnOp]
allUnOps = UnOp
Not UnOp -> [UnOp] -> [UnOp]
forall a. a -> [a] -> [a]
:
           (IntType -> UnOp) -> [IntType] -> [UnOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> UnOp
Complement [IntType
forall a. Bounded a => a
minBound..IntType
forall a. Bounded a => a
maxBound] [UnOp] -> [UnOp] -> [UnOp]
forall a. [a] -> [a] -> [a]
++
           (IntType -> UnOp) -> [IntType] -> [UnOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> UnOp
Abs [IntType
forall a. Bounded a => a
minBound..IntType
forall a. Bounded a => a
maxBound] [UnOp] -> [UnOp] -> [UnOp]
forall a. [a] -> [a] -> [a]
++
           (FloatType -> UnOp) -> [FloatType] -> [UnOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> UnOp
FAbs [FloatType
forall a. Bounded a => a
minBound..FloatType
forall a. Bounded a => a
maxBound] [UnOp] -> [UnOp] -> [UnOp]
forall a. [a] -> [a] -> [a]
++
           (IntType -> UnOp) -> [IntType] -> [UnOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> UnOp
SSignum [IntType
forall a. Bounded a => a
minBound..IntType
forall a. Bounded a => a
maxBound] [UnOp] -> [UnOp] -> [UnOp]
forall a. [a] -> [a] -> [a]
++
           (IntType -> UnOp) -> [IntType] -> [UnOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> UnOp
USignum [IntType
forall a. Bounded a => a
minBound..IntType
forall a. Bounded a => a
maxBound]

-- | A list of all binary operators for all types.
allBinOps :: [BinOp]
allBinOps :: [BinOp]
allBinOps = [[BinOp]] -> [BinOp]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Overflow -> BinOp
`Add` Overflow
OverflowWrap) [IntType]
allIntTypes
                   , (FloatType -> BinOp) -> [FloatType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> BinOp
FAdd [FloatType]
allFloatTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Overflow -> BinOp
`Sub` Overflow
OverflowWrap) [IntType]
allIntTypes
                   , (FloatType -> BinOp) -> [FloatType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> BinOp
FSub [FloatType]
allFloatTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Overflow -> BinOp
`Mul` Overflow
OverflowWrap) [IntType]
allIntTypes
                   , (FloatType -> BinOp) -> [FloatType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> BinOp
FMul [FloatType]
allFloatTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Safety -> BinOp
`UDiv` Safety
Unsafe) [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Safety -> BinOp
`UDivUp` Safety
Unsafe) [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Safety -> BinOp
`SDiv` Safety
Unsafe) [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Safety -> BinOp
`SDivUp` Safety
Unsafe) [IntType]
allIntTypes
                   , (FloatType -> BinOp) -> [FloatType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> BinOp
FDiv [FloatType]
allFloatTypes
                   , (FloatType -> BinOp) -> [FloatType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> BinOp
FMod [FloatType]
allFloatTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Safety -> BinOp
`UMod` Safety
Unsafe) [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Safety -> BinOp
`SMod` Safety
Unsafe) [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Safety -> BinOp
`SQuot` Safety
Unsafe) [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map (IntType -> Safety -> BinOp
`SRem` Safety
Unsafe) [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
SMin [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
UMin [IntType]
allIntTypes
                   , (FloatType -> BinOp) -> [FloatType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> BinOp
FMin [FloatType]
allFloatTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
SMax [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
UMax [IntType]
allIntTypes
                   , (FloatType -> BinOp) -> [FloatType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> BinOp
FMax [FloatType]
allFloatTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
Shl [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
LShr [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
AShr [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
And [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
Or [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
Xor [IntType]
allIntTypes
                   , (IntType -> BinOp) -> [IntType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> BinOp
Pow [IntType]
allIntTypes
                   , (FloatType -> BinOp) -> [FloatType] -> [BinOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> BinOp
FPow [FloatType]
allFloatTypes
                   , [BinOp
LogAnd, BinOp
LogOr]
                   ]

-- | A list of all comparison operators for all types.
allCmpOps :: [CmpOp]
allCmpOps :: [CmpOp]
allCmpOps = [[CmpOp]] -> [CmpOp]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (PrimType -> CmpOp) -> [PrimType] -> [CmpOp]
forall a b. (a -> b) -> [a] -> [b]
map PrimType -> CmpOp
CmpEq [PrimType]
allPrimTypes
                   , (IntType -> CmpOp) -> [IntType] -> [CmpOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> CmpOp
CmpUlt [IntType]
allIntTypes
                   , (IntType -> CmpOp) -> [IntType] -> [CmpOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> CmpOp
CmpUle [IntType]
allIntTypes
                   , (IntType -> CmpOp) -> [IntType] -> [CmpOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> CmpOp
CmpSlt [IntType]
allIntTypes
                   , (IntType -> CmpOp) -> [IntType] -> [CmpOp]
forall a b. (a -> b) -> [a] -> [b]
map IntType -> CmpOp
CmpSle [IntType]
allIntTypes
                   , (FloatType -> CmpOp) -> [FloatType] -> [CmpOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> CmpOp
FCmpLt [FloatType]
allFloatTypes
                   , (FloatType -> CmpOp) -> [FloatType] -> [CmpOp]
forall a b. (a -> b) -> [a] -> [b]
map FloatType -> CmpOp
FCmpLe [FloatType]
allFloatTypes
                   ]

-- | A list of all conversion operators for all types.
allConvOps :: [ConvOp]
allConvOps :: [ConvOp]
allConvOps = [[ConvOp]] -> [ConvOp]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ IntType -> IntType -> ConvOp
ZExt (IntType -> IntType -> ConvOp) -> [IntType] -> [IntType -> ConvOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IntType]
allIntTypes [IntType -> ConvOp] -> [IntType] -> [ConvOp]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [IntType]
allIntTypes
                    , IntType -> IntType -> ConvOp
SExt (IntType -> IntType -> ConvOp) -> [IntType] -> [IntType -> ConvOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IntType]
allIntTypes [IntType -> ConvOp] -> [IntType] -> [ConvOp]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [IntType]
allIntTypes
                    , FloatType -> FloatType -> ConvOp
FPConv (FloatType -> FloatType -> ConvOp)
-> [FloatType] -> [FloatType -> ConvOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FloatType]
allFloatTypes [FloatType -> ConvOp] -> [FloatType] -> [ConvOp]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [FloatType]
allFloatTypes
                    , FloatType -> IntType -> ConvOp
FPToUI (FloatType -> IntType -> ConvOp)
-> [FloatType] -> [IntType -> ConvOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FloatType]
allFloatTypes [IntType -> ConvOp] -> [IntType] -> [ConvOp]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [IntType]
allIntTypes
                    , FloatType -> IntType -> ConvOp
FPToSI (FloatType -> IntType -> ConvOp)
-> [FloatType] -> [IntType -> ConvOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FloatType]
allFloatTypes [IntType -> ConvOp] -> [IntType] -> [ConvOp]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [IntType]
allIntTypes
                    , IntType -> FloatType -> ConvOp
UIToFP (IntType -> FloatType -> ConvOp)
-> [IntType] -> [FloatType -> ConvOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IntType]
allIntTypes [FloatType -> ConvOp] -> [FloatType] -> [ConvOp]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [FloatType]
allFloatTypes
                    , IntType -> FloatType -> ConvOp
SIToFP (IntType -> FloatType -> ConvOp)
-> [IntType] -> [FloatType -> ConvOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IntType]
allIntTypes [FloatType -> ConvOp] -> [FloatType] -> [ConvOp]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [FloatType]
allFloatTypes
                    , IntType -> ConvOp
IToB (IntType -> ConvOp) -> [IntType] -> [ConvOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IntType]
allIntTypes
                    , IntType -> ConvOp
BToI (IntType -> ConvOp) -> [IntType] -> [ConvOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IntType]
allIntTypes
                    ]

-- | Apply an 'UnOp' to an operand.  Returns 'Nothing' if the
-- application is mistyped.
doUnOp :: UnOp -> PrimValue -> Maybe PrimValue
doUnOp :: UnOp -> PrimValue -> Maybe PrimValue
doUnOp UnOp
Not (BoolValue Bool
b)         = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Bool -> PrimValue
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
b
doUnOp Complement{} (IntValue IntValue
v) = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue
doComplement IntValue
v
doUnOp Abs{} (IntValue IntValue
v)        = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue
doAbs IntValue
v
doUnOp FAbs{} (FloatValue FloatValue
v)     = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> FloatValue
doFAbs FloatValue
v
doUnOp SSignum{} (IntValue IntValue
v)    = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue
doSSignum IntValue
v
doUnOp USignum{} (IntValue IntValue
v)    = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue
doUSignum IntValue
v
doUnOp UnOp
_ PrimValue
_                       = Maybe PrimValue
forall a. Maybe a
Nothing

-- | E.g., @~(~1) = 1@.
doComplement :: IntValue -> IntValue
doComplement :: IntValue -> IntValue
doComplement IntValue
v = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Bits a => a -> a
complement (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v

-- | @abs(-2) = 2@.
doAbs :: IntValue -> IntValue
doAbs :: IntValue -> IntValue
doAbs IntValue
v = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Num a => a -> a
abs (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v

-- | @abs(-2.0) = 2.0@.
doFAbs :: FloatValue -> FloatValue
doFAbs :: FloatValue -> FloatValue
doFAbs FloatValue
v = FloatType -> Double -> FloatValue
forall num. Real num => FloatType -> num -> FloatValue
floatValue (FloatValue -> FloatType
floatValueType FloatValue
v) (Double -> FloatValue) -> Double -> FloatValue
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
abs (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ FloatValue -> Double
floatToDouble FloatValue
v

-- | @ssignum(-2)@ = -1.
doSSignum :: IntValue -> IntValue
doSSignum :: IntValue -> IntValue
doSSignum IntValue
v = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a. Num a => a -> a
signum (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v

-- | @usignum(-2)@ = -1.
doUSignum :: IntValue -> IntValue
doUSignum :: IntValue -> IntValue
doUSignum IntValue
v = IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a. Num a => a -> a
signum (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ IntValue -> Word64
intToWord64 IntValue
v

-- | Apply a 'BinOp' to an operand.  Returns 'Nothing' if the
-- application is mistyped, or outside the domain (e.g. division by
-- zero).
doBinOp :: BinOp -> PrimValue -> PrimValue -> Maybe PrimValue
doBinOp :: BinOp -> PrimValue -> PrimValue -> Maybe PrimValue
doBinOp Add{}    = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doAdd
doBinOp FAdd{}   = (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> PrimValue
-> PrimValue
-> Maybe PrimValue
doFloatBinOp Float -> Float -> Float
forall a. Num a => a -> a -> a
(+) Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
doBinOp Sub{}    = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doSub
doBinOp FSub{}   = (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> PrimValue
-> PrimValue
-> Maybe PrimValue
doFloatBinOp (-) (-)
doBinOp Mul{}    = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doMul
doBinOp FMul{}   = (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> PrimValue
-> PrimValue
-> Maybe PrimValue
doFloatBinOp Float -> Float -> Float
forall a. Num a => a -> a -> a
(*) Double -> Double -> Double
forall a. Num a => a -> a -> a
(*)
doBinOp UDiv{}   = (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
doUDiv
doBinOp UDivUp{} = (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
doUDivUp
doBinOp SDiv{}   = (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
doSDiv
doBinOp SDivUp{} = (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
doSDivUp
doBinOp FDiv{}   = (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> PrimValue
-> PrimValue
-> Maybe PrimValue
doFloatBinOp Float -> Float -> Float
forall a. Fractional a => a -> a -> a
(/) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
(/)
doBinOp FMod{}   = (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> PrimValue
-> PrimValue
-> Maybe PrimValue
doFloatBinOp Float -> Float -> Float
forall a. Real a => a -> a -> a
mod' Double -> Double -> Double
forall a. Real a => a -> a -> a
mod'
doBinOp UMod{}   = (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
doUMod
doBinOp SMod{}   = (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
doSMod
doBinOp SQuot{}  = (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
doSQuot
doBinOp SRem{}   = (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
doSRem
doBinOp SMin{}   = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doSMin
doBinOp UMin{}   = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doUMin
doBinOp FMin{}   = (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> PrimValue
-> PrimValue
-> Maybe PrimValue
doFloatBinOp Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Double -> Double -> Double
forall a. Ord a => a -> a -> a
min
doBinOp SMax{}   = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doSMax
doBinOp UMax{}   = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doUMax
doBinOp FMax{}   = (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> PrimValue
-> PrimValue
-> Maybe PrimValue
doFloatBinOp Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Double -> Double -> Double
forall a. Ord a => a -> a -> a
max
doBinOp Shl{}    = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doShl
doBinOp LShr{}   = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doLShr
doBinOp AShr{}   = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doAShr
doBinOp And{}    = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doAnd
doBinOp Or{}     = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doOr
doBinOp Xor{}    = (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
doXor
doBinOp Pow{}    = (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
doPow
doBinOp FPow{}   = (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> PrimValue
-> PrimValue
-> Maybe PrimValue
doFloatBinOp Float -> Float -> Float
forall a. Floating a => a -> a -> a
(**) Double -> Double -> Double
forall a. Floating a => a -> a -> a
(**)
doBinOp LogAnd{} = (Bool -> Bool -> Bool) -> PrimValue -> PrimValue -> Maybe PrimValue
doBoolBinOp Bool -> Bool -> Bool
(&&)
doBinOp LogOr{}  = (Bool -> Bool -> Bool) -> PrimValue -> PrimValue -> Maybe PrimValue
doBoolBinOp Bool -> Bool -> Bool
(||)

doIntBinOp :: (IntValue -> IntValue -> IntValue) -> PrimValue -> PrimValue
           -> Maybe PrimValue
doIntBinOp :: (IntValue -> IntValue -> IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doIntBinOp IntValue -> IntValue -> IntValue
f (IntValue IntValue
v1) (IntValue IntValue
v2) =
  PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> IntValue
f IntValue
v1 IntValue
v2
doIntBinOp IntValue -> IntValue -> IntValue
_ PrimValue
_ PrimValue
_ = Maybe PrimValue
forall a. Maybe a
Nothing

doRiskyIntBinOp :: (IntValue -> IntValue -> Maybe IntValue) -> PrimValue -> PrimValue
           -> Maybe PrimValue
doRiskyIntBinOp :: (IntValue -> IntValue -> Maybe IntValue)
-> PrimValue -> PrimValue -> Maybe PrimValue
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
f (IntValue IntValue
v1) (IntValue IntValue
v2) =
  IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> Maybe IntValue -> Maybe PrimValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntValue -> IntValue -> Maybe IntValue
f IntValue
v1 IntValue
v2
doRiskyIntBinOp IntValue -> IntValue -> Maybe IntValue
_ PrimValue
_ PrimValue
_ = Maybe PrimValue
forall a. Maybe a
Nothing

doFloatBinOp :: (Float -> Float -> Float)
             -> (Double -> Double -> Double)
             -> PrimValue -> PrimValue
             -> Maybe PrimValue
doFloatBinOp :: (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> PrimValue
-> PrimValue
-> Maybe PrimValue
doFloatBinOp Float -> Float -> Float
f32 Double -> Double -> Double
_ (FloatValue (Float32Value Float
v1)) (FloatValue (Float32Value Float
v2)) =
  PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Float -> FloatValue
Float32Value (Float -> FloatValue) -> Float -> FloatValue
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float
f32 Float
v1 Float
v2
doFloatBinOp Float -> Float -> Float
_ Double -> Double -> Double
f64 (FloatValue (Float64Value Double
v1)) (FloatValue (Float64Value Double
v2)) =
  PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Double -> FloatValue
Float64Value (Double -> FloatValue) -> Double -> FloatValue
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
f64 Double
v1 Double
v2
doFloatBinOp Float -> Float -> Float
_ Double -> Double -> Double
_ PrimValue
_ PrimValue
_ = Maybe PrimValue
forall a. Maybe a
Nothing

doBoolBinOp :: (Bool -> Bool -> Bool) -> PrimValue -> PrimValue
            -> Maybe PrimValue
doBoolBinOp :: (Bool -> Bool -> Bool) -> PrimValue -> PrimValue -> Maybe PrimValue
doBoolBinOp Bool -> Bool -> Bool
f (BoolValue Bool
v1) (BoolValue Bool
v2) =
  PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Bool -> PrimValue
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool
f Bool
v1 Bool
v2
doBoolBinOp Bool -> Bool -> Bool
_ PrimValue
_ PrimValue
_ = Maybe PrimValue
forall a. Maybe a
Nothing

-- | Integer addition.
doAdd :: IntValue -> IntValue -> IntValue
doAdd :: IntValue -> IntValue -> IntValue
doAdd IntValue
v1 IntValue
v2 = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ IntValue -> Int64
intToInt64 IntValue
v2

-- | Integer subtraction.
doSub :: IntValue -> IntValue -> IntValue
doSub :: IntValue -> IntValue -> IntValue
doSub IntValue
v1 IntValue
v2 = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- IntValue -> Int64
intToInt64 IntValue
v2

-- | Integer multiplication.
doMul :: IntValue -> IntValue -> IntValue
doMul :: IntValue -> IntValue -> IntValue
doMul IntValue
v1 IntValue
v2 = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* IntValue -> Int64
intToInt64 IntValue
v2

-- | Unsigned integer division.  Rounds towards negativity infinity.
-- Note: this is different from LLVM.
doUDiv :: IntValue -> IntValue -> Maybe IntValue
doUDiv :: IntValue -> IntValue -> Maybe IntValue
doUDiv IntValue
v1 IntValue
v2
  | IntValue -> Bool
zeroIshInt IntValue
v2 = Maybe IntValue
forall a. Maybe a
Nothing
  | Bool
otherwise = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (IntValue -> Maybe IntValue) -> IntValue -> Maybe IntValue
forall a b. (a -> b) -> a -> b
$ IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$
                IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` IntValue -> Word64
intToWord64 IntValue
v2

-- | Unsigned integer division.  Rounds towards positive infinity.
doUDivUp :: IntValue -> IntValue -> Maybe IntValue
doUDivUp :: IntValue -> IntValue -> Maybe IntValue
doUDivUp IntValue
v1 IntValue
v2
  | IntValue -> Bool
zeroIshInt IntValue
v2 = Maybe IntValue
forall a. Maybe a
Nothing
  | Bool
otherwise = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (IntValue -> Maybe IntValue) -> IntValue -> Maybe IntValue
forall a b. (a -> b) -> a -> b
$ IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$
                (IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ IntValue -> Word64
intToWord64 IntValue
v2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` IntValue -> Word64
intToWord64 IntValue
v2

-- | Signed integer division.  Rounds towards negativity infinity.
-- Note: this is different from LLVM.
doSDiv :: IntValue -> IntValue -> Maybe IntValue
doSDiv :: IntValue -> IntValue -> Maybe IntValue
doSDiv IntValue
v1 IntValue
v2
  | IntValue -> Bool
zeroIshInt IntValue
v2 = Maybe IntValue
forall a. Maybe a
Nothing
  | Bool
otherwise = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (IntValue -> Maybe IntValue) -> IntValue -> Maybe IntValue
forall a b. (a -> b) -> a -> b
$ IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$
                IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` IntValue -> Int64
intToInt64 IntValue
v2

-- | Signed integer division.  Rounds towards positive infinity.
doSDivUp :: IntValue -> IntValue -> Maybe IntValue
doSDivUp :: IntValue -> IntValue -> Maybe IntValue
doSDivUp IntValue
v1 IntValue
v2
  | IntValue -> Bool
zeroIshInt IntValue
v2 = Maybe IntValue
forall a. Maybe a
Nothing
  | Bool
otherwise = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (IntValue -> Maybe IntValue) -> IntValue -> Maybe IntValue
forall a b. (a -> b) -> a -> b
$ IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$
                (IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ IntValue -> Int64
intToInt64 IntValue
v2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` IntValue -> Int64
intToInt64 IntValue
v2

-- | Unsigned integer modulus; the countepart to 'UDiv'.
doUMod :: IntValue -> IntValue -> Maybe IntValue
doUMod :: IntValue -> IntValue -> Maybe IntValue
doUMod IntValue
v1 IntValue
v2
  | IntValue -> Bool
zeroIshInt IntValue
v2 = Maybe IntValue
forall a. Maybe a
Nothing
  | Bool
otherwise = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (IntValue -> Maybe IntValue) -> IntValue -> Maybe IntValue
forall a b. (a -> b) -> a -> b
$ IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` IntValue -> Word64
intToWord64 IntValue
v2

-- | Signed integer modulus; the countepart to 'SDiv'.
doSMod :: IntValue -> IntValue -> Maybe IntValue
doSMod :: IntValue -> IntValue -> Maybe IntValue
doSMod IntValue
v1 IntValue
v2
  | IntValue -> Bool
zeroIshInt IntValue
v2 = Maybe IntValue
forall a. Maybe a
Nothing
  | Bool
otherwise = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (IntValue -> Maybe IntValue) -> IntValue -> Maybe IntValue
forall a b. (a -> b) -> a -> b
$ IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` IntValue -> Int64
intToInt64 IntValue
v2

-- | Signed integer division.  Rounds towards zero.
-- This corresponds to the @sdiv@ instruction in LLVM.
doSQuot :: IntValue -> IntValue -> Maybe IntValue
doSQuot :: IntValue -> IntValue -> Maybe IntValue
doSQuot IntValue
v1 IntValue
v2
  | IntValue -> Bool
zeroIshInt IntValue
v2 = Maybe IntValue
forall a. Maybe a
Nothing
  | Bool
otherwise = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (IntValue -> Maybe IntValue) -> IntValue -> Maybe IntValue
forall a b. (a -> b) -> a -> b
$ IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` IntValue -> Int64
intToInt64 IntValue
v2

-- | Signed integer division.  Rounds towards zero.
-- This corresponds to the @srem@ instruction in LLVM.
doSRem :: IntValue -> IntValue -> Maybe IntValue
doSRem :: IntValue -> IntValue -> Maybe IntValue
doSRem IntValue
v1 IntValue
v2
  | IntValue -> Bool
zeroIshInt IntValue
v2 = Maybe IntValue
forall a. Maybe a
Nothing
  | Bool
otherwise = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (IntValue -> Maybe IntValue) -> IntValue -> Maybe IntValue
forall a b. (a -> b) -> a -> b
$ IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`rem` IntValue -> Int64
intToInt64 IntValue
v2

-- | Minimum of two signed integers.
doSMin :: IntValue -> IntValue -> IntValue
doSMin :: IntValue -> IntValue -> IntValue
doSMin IntValue
v1 IntValue
v2 = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
`min` IntValue -> Int64
intToInt64 IntValue
v2

-- | Minimum of two unsigned integers.
doUMin :: IntValue -> IntValue -> IntValue
doUMin :: IntValue -> IntValue -> IntValue
doUMin IntValue
v1 IntValue
v2 = IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
`min` IntValue -> Word64
intToWord64 IntValue
v2

-- | Maximum of two signed integers.
doSMax :: IntValue -> IntValue -> IntValue
doSMax :: IntValue -> IntValue -> IntValue
doSMax IntValue
v1 IntValue
v2 = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
`max` IntValue -> Int64
intToInt64 IntValue
v2

-- | Maximum of two unsigned integers.
doUMax :: IntValue -> IntValue -> IntValue
doUMax :: IntValue -> IntValue -> IntValue
doUMax IntValue
v1 IntValue
v2 = IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
`max` IntValue -> Word64
intToWord64 IntValue
v2

-- | Left-shift.
doShl :: IntValue -> IntValue -> IntValue
doShl :: IntValue -> IntValue -> IntValue
doShl IntValue
v1 IntValue
v2 = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shift` IntValue -> Int
intToInt IntValue
v2

-- | Logical right-shift, zero-extended.
doLShr :: IntValue -> IntValue -> IntValue
doLShr :: IntValue -> IntValue -> IntValue
doLShr IntValue
v1 IntValue
v2 = IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shift` Int -> Int
forall a. Num a => a -> a
negate (IntValue -> Int
intToInt IntValue
v2)

-- | Arithmetic right-shift, sign-extended.
doAShr :: IntValue -> IntValue -> IntValue
doAShr :: IntValue -> IntValue -> IntValue
doAShr IntValue
v1 IntValue
v2 = IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int -> Int64
forall a. Bits a => a -> Int -> a
`shift` Int -> Int
forall a. Num a => a -> a
negate (IntValue -> Int
intToInt IntValue
v2)

-- | Bitwise and.
doAnd :: IntValue -> IntValue -> IntValue
doAnd :: IntValue -> IntValue -> IntValue
doAnd IntValue
v1 IntValue
v2 = IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. IntValue -> Word64
intToWord64 IntValue
v2

-- | Bitwise or.
doOr :: IntValue -> IntValue -> IntValue
doOr :: IntValue -> IntValue -> IntValue
doOr IntValue
v1 IntValue
v2 = IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. IntValue -> Word64
intToWord64 IntValue
v2

-- | Bitwise exclusive-or.
doXor :: IntValue -> IntValue -> IntValue
doXor :: IntValue -> IntValue -> IntValue
doXor IntValue
v1 IntValue
v2 = IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Word64 -> IntValue) -> Word64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` IntValue -> Word64
intToWord64 IntValue
v2

-- | Signed integer exponentatation.
doPow :: IntValue -> IntValue -> Maybe IntValue
doPow :: IntValue -> IntValue -> Maybe IntValue
doPow IntValue
v1 IntValue
v2
  | IntValue -> Bool
negativeIshInt IntValue
v2 = Maybe IntValue
forall a. Maybe a
Nothing
  | Bool
otherwise         = IntValue -> Maybe IntValue
forall a. a -> Maybe a
Just (IntValue -> Maybe IntValue) -> IntValue -> Maybe IntValue
forall a b. (a -> b) -> a -> b
$ IntType -> Int64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue (IntValue -> IntType
intValueType IntValue
v1) (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v1 Int64 -> Int64 -> Int64
forall a b. (Num a, Integral b) => a -> b -> a
^ IntValue -> Int64
intToInt64 IntValue
v2

-- | Apply a 'ConvOp' to an operand.  Returns 'Nothing' if the
-- application is mistyped.
doConvOp :: ConvOp -> PrimValue -> Maybe PrimValue
doConvOp :: ConvOp -> PrimValue -> Maybe PrimValue
doConvOp (ZExt IntType
_ IntType
to) (IntValue IntValue
v)     = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntType -> IntValue
doZExt IntValue
v IntType
to
doConvOp (SExt IntType
_ IntType
to) (IntValue IntValue
v)     = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntType -> IntValue
doSExt IntValue
v IntType
to
doConvOp (FPConv FloatType
_ FloatType
to) (FloatValue FloatValue
v) = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> FloatType -> FloatValue
doFPConv FloatValue
v FloatType
to
doConvOp (FPToUI FloatType
_ IntType
to) (FloatValue FloatValue
v) = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> IntType -> IntValue
doFPToUI FloatValue
v IntType
to
doConvOp (FPToSI FloatType
_ IntType
to) (FloatValue FloatValue
v) = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> IntType -> IntValue
doFPToSI FloatValue
v IntType
to
doConvOp (UIToFP IntType
_ FloatType
to) (IntValue IntValue
v)   = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> FloatType -> FloatValue
doUIToFP IntValue
v FloatType
to
doConvOp (SIToFP IntType
_ FloatType
to) (IntValue IntValue
v)   = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> FloatType -> FloatValue
doSIToFP IntValue
v FloatType
to
doConvOp (IToB IntType
_) (IntValue IntValue
v)        = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Bool -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
0
doConvOp (BToI IntType
to) (BoolValue Bool
v)      = PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntType -> Int -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
to (Int -> IntValue) -> Int -> IntValue
forall a b. (a -> b) -> a -> b
$ if Bool
v then Int
1 else Int
0::Int
doConvOp ConvOp
_ PrimValue
_                          = Maybe PrimValue
forall a. Maybe a
Nothing

-- | Zero-extend the given integer value to the size of the given
-- type.  If the type is smaller than the given value, the result is a
-- truncation.
doZExt :: IntValue -> IntType -> IntValue
doZExt :: IntValue -> IntType -> IntValue
doZExt (Int8Value Int8
x) IntType
t  = IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Integer -> IntValue) -> Integer -> IntValue
forall a b. (a -> b) -> a -> b
$ Word8 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
x :: Word8)
doZExt (Int16Value Int16
x) IntType
t = IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Integer -> IntValue) -> Integer -> IntValue
forall a b. (a -> b) -> a -> b
$ Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
x :: Word16)
doZExt (Int32Value Int32
x) IntType
t = IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Integer -> IntValue) -> Integer -> IntValue
forall a b. (a -> b) -> a -> b
$ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x :: Word32)
doZExt (Int64Value Int64
x) IntType
t = IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Integer -> IntValue) -> Integer -> IntValue
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x :: Word64)

-- | Sign-extend the given integer value to the size of the given
-- type.  If the type is smaller than the given value, the result is a
-- truncation.
doSExt :: IntValue -> IntType -> IntValue
doSExt :: IntValue -> IntType -> IntValue
doSExt (Int8Value Int8
x) IntType
t  = IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Integer -> IntValue) -> Integer -> IntValue
forall a b. (a -> b) -> a -> b
$ Int8 -> Integer
forall a. Integral a => a -> Integer
toInteger Int8
x
doSExt (Int16Value Int16
x) IntType
t = IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Integer -> IntValue) -> Integer -> IntValue
forall a b. (a -> b) -> a -> b
$ Int16 -> Integer
forall a. Integral a => a -> Integer
toInteger Int16
x
doSExt (Int32Value Int32
x) IntType
t = IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Integer -> IntValue) -> Integer -> IntValue
forall a b. (a -> b) -> a -> b
$ Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger Int32
x
doSExt (Int64Value Int64
x) IntType
t = IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Integer -> IntValue) -> Integer -> IntValue
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
x

-- | Convert the former floating-point type to the latter.
doFPConv :: FloatValue -> FloatType -> FloatValue
doFPConv :: FloatValue -> FloatType -> FloatValue
doFPConv (Float32Value Float
v) FloatType
Float32 = Float -> FloatValue
Float32Value Float
v
doFPConv (Float64Value Double
v) FloatType
Float32 = Float -> FloatValue
Float32Value (Float -> FloatValue) -> Float -> FloatValue
forall a b. (a -> b) -> a -> b
$ Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Rational -> Float) -> Rational -> Float
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
v
doFPConv (Float64Value Double
v) FloatType
Float64 = Double -> FloatValue
Float64Value Double
v
doFPConv (Float32Value Float
v) FloatType
Float64 = Double -> FloatValue
Float64Value (Double -> FloatValue) -> Double -> FloatValue
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Float -> Rational
forall a. Real a => a -> Rational
toRational Float
v

-- | Convert a floating-point value to the nearest
-- unsigned integer (rounding towards zero).
doFPToUI :: FloatValue -> IntType -> IntValue
doFPToUI :: FloatValue -> IntType -> IntValue
doFPToUI FloatValue
v IntType
t = IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Double -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Word64) -> Double -> Word64
forall a b. (a -> b) -> a -> b
$ FloatValue -> Double
floatToDouble FloatValue
v :: Word64)

-- | Convert a floating-point value to the nearest
-- signed integer (rounding towards zero).
doFPToSI :: FloatValue -> IntType -> IntValue
doFPToSI :: FloatValue -> IntType -> IntValue
doFPToSI FloatValue
v IntType
t = IntType -> Word64 -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
t (Double -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Word64) -> Double -> Word64
forall a b. (a -> b) -> a -> b
$ FloatValue -> Double
floatToDouble FloatValue
v :: Word64)

-- | Convert an unsigned integer to a floating-point value.
doUIToFP :: IntValue -> FloatType -> FloatValue
doUIToFP :: IntValue -> FloatType -> FloatValue
doUIToFP IntValue
v FloatType
t = FloatType -> Word64 -> FloatValue
forall num. Real num => FloatType -> num -> FloatValue
floatValue FloatType
t (Word64 -> FloatValue) -> Word64 -> FloatValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Word64
intToWord64 IntValue
v

-- | Convert a signed integer to a floating-point value.
doSIToFP :: IntValue -> FloatType -> FloatValue
doSIToFP :: IntValue -> FloatType -> FloatValue
doSIToFP IntValue
v FloatType
t = FloatType -> Int64 -> FloatValue
forall num. Real num => FloatType -> num -> FloatValue
floatValue FloatType
t (Int64 -> FloatValue) -> Int64 -> FloatValue
forall a b. (a -> b) -> a -> b
$ IntValue -> Int64
intToInt64 IntValue
v

-- | Apply a 'CmpOp' to an operand.  Returns 'Nothing' if the
-- application is mistyped.
doCmpOp :: CmpOp -> PrimValue -> PrimValue -> Maybe Bool
doCmpOp :: CmpOp -> PrimValue -> PrimValue -> Maybe Bool
doCmpOp CmpEq{} PrimValue
v1 PrimValue
v2                            = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ PrimValue -> PrimValue -> Bool
doCmpEq PrimValue
v1 PrimValue
v2
doCmpOp CmpUlt{} (IntValue IntValue
v1) (IntValue IntValue
v2)     = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Bool
doCmpUlt IntValue
v1 IntValue
v2
doCmpOp CmpUle{} (IntValue IntValue
v1) (IntValue IntValue
v2)     = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Bool
doCmpUle IntValue
v1 IntValue
v2
doCmpOp CmpSlt{} (IntValue IntValue
v1) (IntValue IntValue
v2)     = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Bool
doCmpSlt IntValue
v1 IntValue
v2
doCmpOp CmpSle{} (IntValue IntValue
v1) (IntValue IntValue
v2)     = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Bool
doCmpSle IntValue
v1 IntValue
v2
doCmpOp FCmpLt{} (FloatValue FloatValue
v1) (FloatValue FloatValue
v2) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ FloatValue -> FloatValue -> Bool
doFCmpLt FloatValue
v1 FloatValue
v2
doCmpOp FCmpLe{} (FloatValue FloatValue
v1) (FloatValue FloatValue
v2) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ FloatValue -> FloatValue -> Bool
doFCmpLe FloatValue
v1 FloatValue
v2
doCmpOp CmpLlt{} (BoolValue Bool
v1) (BoolValue Bool
v2)   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
v1 Bool -> Bool -> Bool
&& Bool
v2
doCmpOp CmpLle{} (BoolValue Bool
v1) (BoolValue Bool
v2)   = Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool
v1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
v2)
doCmpOp CmpOp
_ PrimValue
_ PrimValue
_                                    = Maybe Bool
forall a. Maybe a
Nothing

-- | Compare any two primtive values for exact equality.
doCmpEq :: PrimValue -> PrimValue -> Bool
doCmpEq :: PrimValue -> PrimValue -> Bool
doCmpEq PrimValue
v1 PrimValue
v2 = PrimValue
v1 PrimValue -> PrimValue -> Bool
forall a. Eq a => a -> a -> Bool
== PrimValue
v2

-- | Unsigned less than.
doCmpUlt :: IntValue -> IntValue -> Bool
doCmpUlt :: IntValue -> IntValue -> Bool
doCmpUlt IntValue
v1 IntValue
v2 = IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< IntValue -> Word64
intToWord64 IntValue
v2

-- | Unsigned less than or equal.
doCmpUle :: IntValue -> IntValue -> Bool
doCmpUle :: IntValue -> IntValue -> Bool
doCmpUle IntValue
v1 IntValue
v2 = IntValue -> Word64
intToWord64 IntValue
v1 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= IntValue -> Word64
intToWord64 IntValue
v2

-- | Signed less than.
doCmpSlt :: IntValue -> IntValue -> Bool
doCmpSlt :: IntValue -> IntValue -> Bool
doCmpSlt = IntValue -> IntValue -> Bool
forall a. Ord a => a -> a -> Bool
(<)

-- | Signed less than or equal.
doCmpSle :: IntValue -> IntValue -> Bool
doCmpSle :: IntValue -> IntValue -> Bool
doCmpSle = IntValue -> IntValue -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

-- | Floating-point less than.
doFCmpLt :: FloatValue -> FloatValue -> Bool
doFCmpLt :: FloatValue -> FloatValue -> Bool
doFCmpLt = FloatValue -> FloatValue -> Bool
forall a. Ord a => a -> a -> Bool
(<)

-- | Floating-point less than or equal.
doFCmpLe :: FloatValue -> FloatValue -> Bool
doFCmpLe :: FloatValue -> FloatValue -> Bool
doFCmpLe = FloatValue -> FloatValue -> Bool
forall a. Ord a => a -> a -> Bool
(<=)

-- | Translate an t'IntValue' to 'Word64'.  This is guaranteed to fit.
intToWord64 :: IntValue -> Word64
intToWord64 :: IntValue -> Word64
intToWord64 (Int8Value Int8
v)  = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v :: Word8)
intToWord64 (Int16Value Int16
v) = Word16 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
v :: Word16)
intToWord64 (Int32Value Int32
v) = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v :: Word32)
intToWord64 (Int64Value Int64
v) = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v :: Word64)

-- | Translate an t'IntValue' to t'Int64'.  This is guaranteed to fit.
intToInt64 :: IntValue -> Int64
intToInt64 :: IntValue -> Int64
intToInt64 (Int8Value Int8
v)  = Int8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v
intToInt64 (Int16Value Int16
v) = Int16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
v
intToInt64 (Int32Value Int32
v) = Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
v
intToInt64 (Int64Value Int64
v) = Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
v

-- | Careful - there is no guarantee this will fit.
intToInt :: IntValue -> Int
intToInt :: IntValue -> Int
intToInt = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (IntValue -> Int64) -> IntValue -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntValue -> Int64
intToInt64

floatToDouble :: FloatValue -> Double
floatToDouble :: FloatValue -> Double
floatToDouble (Float32Value Float
v) = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Rational -> Double
forall a b. (a -> b) -> a -> b
$ Float -> Rational
forall a. Real a => a -> Rational
toRational Float
v
floatToDouble (Float64Value Double
v) = Double
v

-- | The result type of a binary operator.
binOpType :: BinOp -> PrimType
binOpType :: BinOp -> PrimType
binOpType (Add IntType
t Overflow
_) = IntType -> PrimType
IntType IntType
t
binOpType (Sub IntType
t Overflow
_) = IntType -> PrimType
IntType IntType
t
binOpType (Mul IntType
t Overflow
_) = IntType -> PrimType
IntType IntType
t
binOpType (SDiv IntType
t Safety
_)   = IntType -> PrimType
IntType IntType
t
binOpType (SDivUp IntType
t Safety
_) = IntType -> PrimType
IntType IntType
t
binOpType (SMod IntType
t Safety
_)  = IntType -> PrimType
IntType IntType
t
binOpType (SQuot IntType
t Safety
_) = IntType -> PrimType
IntType IntType
t
binOpType (SRem IntType
t Safety
_)  = IntType -> PrimType
IntType IntType
t
binOpType (UDiv IntType
t Safety
_)  = IntType -> PrimType
IntType IntType
t
binOpType (UDivUp IntType
t Safety
_) = IntType -> PrimType
IntType IntType
t
binOpType (UMod IntType
t Safety
_)   = IntType -> PrimType
IntType IntType
t
binOpType (SMin IntType
t)  = IntType -> PrimType
IntType IntType
t
binOpType (UMin IntType
t)  = IntType -> PrimType
IntType IntType
t
binOpType (FMin FloatType
t)  = FloatType -> PrimType
FloatType FloatType
t
binOpType (SMax IntType
t)  = IntType -> PrimType
IntType IntType
t
binOpType (UMax IntType
t)  = IntType -> PrimType
IntType IntType
t
binOpType (FMax FloatType
t)  = FloatType -> PrimType
FloatType FloatType
t
binOpType (Shl IntType
t)   = IntType -> PrimType
IntType IntType
t
binOpType (LShr IntType
t)  = IntType -> PrimType
IntType IntType
t
binOpType (AShr IntType
t)  = IntType -> PrimType
IntType IntType
t
binOpType (And IntType
t)   = IntType -> PrimType
IntType IntType
t
binOpType (Or IntType
t)    = IntType -> PrimType
IntType IntType
t
binOpType (Xor IntType
t)   = IntType -> PrimType
IntType IntType
t
binOpType (Pow IntType
t)   = IntType -> PrimType
IntType IntType
t
binOpType (FPow FloatType
t)  = FloatType -> PrimType
FloatType FloatType
t
binOpType BinOp
LogAnd    = PrimType
Bool
binOpType BinOp
LogOr     = PrimType
Bool
binOpType (FAdd FloatType
t)  = FloatType -> PrimType
FloatType FloatType
t
binOpType (FSub FloatType
t)  = FloatType -> PrimType
FloatType FloatType
t
binOpType (FMul FloatType
t)  = FloatType -> PrimType
FloatType FloatType
t
binOpType (FDiv FloatType
t)  = FloatType -> PrimType
FloatType FloatType
t
binOpType (FMod FloatType
t)  = FloatType -> PrimType
FloatType FloatType
t

-- | The operand types of a comparison operator.
cmpOpType :: CmpOp -> PrimType
cmpOpType :: CmpOp -> PrimType
cmpOpType (CmpEq PrimType
t) = PrimType
t
cmpOpType (CmpSlt IntType
t) = IntType -> PrimType
IntType IntType
t
cmpOpType (CmpSle IntType
t) = IntType -> PrimType
IntType IntType
t
cmpOpType (CmpUlt IntType
t) = IntType -> PrimType
IntType IntType
t
cmpOpType (CmpUle IntType
t) = IntType -> PrimType
IntType IntType
t
cmpOpType (FCmpLt FloatType
t) = FloatType -> PrimType
FloatType FloatType
t
cmpOpType (FCmpLe FloatType
t) = FloatType -> PrimType
FloatType FloatType
t
cmpOpType CmpOp
CmpLlt = PrimType
Bool
cmpOpType CmpOp
CmpLle = PrimType
Bool

-- | The operand and result type of a unary operator.
unOpType :: UnOp -> PrimType
unOpType :: UnOp -> PrimType
unOpType (SSignum IntType
t)    = IntType -> PrimType
IntType IntType
t
unOpType (USignum IntType
t)    = IntType -> PrimType
IntType IntType
t
unOpType UnOp
Not            = PrimType
Bool
unOpType (Complement IntType
t) = IntType -> PrimType
IntType IntType
t
unOpType (Abs IntType
t)        = IntType -> PrimType
IntType IntType
t
unOpType (FAbs FloatType
t)       = FloatType -> PrimType
FloatType FloatType
t

-- | The input and output types of a conversion operator.
convOpType :: ConvOp -> (PrimType, PrimType)
convOpType :: ConvOp -> (PrimType, PrimType)
convOpType (ZExt IntType
from IntType
to) = (IntType -> PrimType
IntType IntType
from, IntType -> PrimType
IntType IntType
to)
convOpType (SExt IntType
from IntType
to) = (IntType -> PrimType
IntType IntType
from, IntType -> PrimType
IntType IntType
to)
convOpType (FPConv FloatType
from FloatType
to) = (FloatType -> PrimType
FloatType FloatType
from, FloatType -> PrimType
FloatType FloatType
to)
convOpType (FPToUI FloatType
from IntType
to) = (FloatType -> PrimType
FloatType FloatType
from, IntType -> PrimType
IntType IntType
to)
convOpType (FPToSI FloatType
from IntType
to) = (FloatType -> PrimType
FloatType FloatType
from, IntType -> PrimType
IntType IntType
to)
convOpType (UIToFP IntType
from FloatType
to) = (IntType -> PrimType
IntType IntType
from, FloatType -> PrimType
FloatType FloatType
to)
convOpType (SIToFP IntType
from FloatType
to) = (IntType -> PrimType
IntType IntType
from, FloatType -> PrimType
FloatType FloatType
to)
convOpType (IToB IntType
from) = (IntType -> PrimType
IntType IntType
from, PrimType
Bool)
convOpType (BToI IntType
to) = (PrimType
Bool, IntType -> PrimType
IntType IntType
to)

floatToWord :: Float -> Word32
floatToWord :: Float -> Word32
floatToWord = Get Word32 -> ByteString -> Word32
forall a. Get a -> ByteString -> a
G.runGet Get Word32
G.getWord32le (ByteString -> Word32) -> (Float -> ByteString) -> Float -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
P.runPut (Put -> ByteString) -> (Float -> Put) -> Float -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Put
P.putFloatle

wordToFloat :: Word32 -> Float
wordToFloat :: Word32 -> Float
wordToFloat = Get Float -> ByteString -> Float
forall a. Get a -> ByteString -> a
G.runGet Get Float
G.getFloatle (ByteString -> Float) -> (Word32 -> ByteString) -> Word32 -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
P.runPut (Put -> ByteString) -> (Word32 -> Put) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Put
P.putWord32le

doubleToWord :: Double -> Word64
doubleToWord :: Double -> Word64
doubleToWord = Get Word64 -> ByteString -> Word64
forall a. Get a -> ByteString -> a
G.runGet Get Word64
G.getWord64le (ByteString -> Word64)
-> (Double -> ByteString) -> Double -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
P.runPut (Put -> ByteString) -> (Double -> Put) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Put
P.putDoublele

wordToDouble :: Word64 -> Double
wordToDouble :: Word64 -> Double
wordToDouble = Get Double -> ByteString -> Double
forall a. Get a -> ByteString -> a
G.runGet Get Double
G.getDoublele (ByteString -> Double)
-> (Word64 -> ByteString) -> Word64 -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
P.runPut (Put -> ByteString) -> (Word64 -> Put) -> Word64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Put
P.putWord64le

-- | A mapping from names of primitive functions to their parameter
-- types, their result type, and a function for evaluating them.
primFuns :: M.Map String ([PrimType], PrimType,
                          [PrimValue] -> Maybe PrimValue)
primFuns :: Map String ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)
primFuns = [(String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))]
-> Map
     String ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"sqrt32" Float -> Float
forall a. Floating a => a -> a
sqrt, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"sqrt64" Double -> Double
forall a. Floating a => a -> a
sqrt
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"log32" Float -> Float
forall a. Floating a => a -> a
log, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"log64" Double -> Double
forall a. Floating a => a -> a
log
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"log10_32" (Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase Float
10), String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"log10_64" (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10)
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"log2_32" (Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase Float
2), String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"log2_64" (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
2)
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"exp32" Float -> Float
forall a. Floating a => a -> a
exp, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"exp64" Double -> Double
forall a. Floating a => a -> a
exp

  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"sin32" Float -> Float
forall a. Floating a => a -> a
sin, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"sin64" Double -> Double
forall a. Floating a => a -> a
sin
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"sinh32" Float -> Float
forall a. Floating a => a -> a
sinh, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"sinh64" Double -> Double
forall a. Floating a => a -> a
sinh
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"cos32" Float -> Float
forall a. Floating a => a -> a
cos, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"cos64" Double -> Double
forall a. Floating a => a -> a
cos
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"cosh32" Float -> Float
forall a. Floating a => a -> a
cosh, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"cosh64" Double -> Double
forall a. Floating a => a -> a
cosh
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"tan32" Float -> Float
forall a. Floating a => a -> a
tan, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"tan64" Double -> Double
forall a. Floating a => a -> a
tan
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"tanh32" Float -> Float
forall a. Floating a => a -> a
tanh, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"tanh64" Double -> Double
forall a. Floating a => a -> a
tanh
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"asin32" Float -> Float
forall a. Floating a => a -> a
asin, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"asin64" Double -> Double
forall a. Floating a => a -> a
asin
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"asinh32" Float -> Float
forall a. Floating a => a -> a
asinh, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"asinh64" Double -> Double
forall a. Floating a => a -> a
asinh
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"acos32" Float -> Float
forall a. Floating a => a -> a
acos, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"acos64" Double -> Double
forall a. Floating a => a -> a
acos
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"acosh32" Float -> Float
forall a. Floating a => a -> a
acosh, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"acosh64" Double -> Double
forall a. Floating a => a -> a
acosh
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"atan32" Float -> Float
forall a. Floating a => a -> a
atan, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"atan64" Double -> Double
forall a. Floating a => a -> a
atan
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"atanh32" Float -> Float
forall a. Floating a => a -> a
atanh, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"atanh64" Double -> Double
forall a. Floating a => a -> a
atanh

  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"round32" Float -> Float
roundFloat, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"round64" Double -> Double
roundDouble
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"ceil32" Float -> Float
ceilFloat, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"ceil64" Double -> Double
ceilDouble
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"floor32" Float -> Float
floorFloat, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"floor64" Double -> Double
floorDouble
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"gamma32" Float -> Float
tgammaf, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"gamma64" Double -> Double
tgamma
  , String
-> (Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 String
"lgamma32" Float -> Float
lgammaf, String
-> (Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 String
"lgamma64" Double -> Double
lgamma

  , String
-> (Int8 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int8 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i8 String
"clz8" ((Int8 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int8 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> (Int8 -> IntValue) -> Int8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int8 -> Int32) -> Int8 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int8 -> Int) -> Int8 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros
  , String
-> (Int16 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int16 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i16 String
"clz16" ((Int16 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int16 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int16 -> IntValue) -> Int16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int16 -> Int32) -> Int16 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int16 -> Int) -> Int16 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros
  , String
-> (Int32 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int32 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i32 String
"clz32" ((Int32 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int32 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int32 -> IntValue) -> Int32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int32 -> Int32) -> Int32 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int32 -> Int) -> Int32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros
  , String
-> (Int64 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int64 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i64 String
"clz64" ((Int64 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int64 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int64 -> IntValue) -> Int64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int64 -> Int32) -> Int64 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int64 -> Int) -> Int64 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros

  , String
-> (Int8 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int8 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i8 String
"ctz8" ((Int8 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int8 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> (Int8 -> IntValue) -> Int8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int8 -> Int32) -> Int8 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int8 -> Int) -> Int8 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros
  , String
-> (Int16 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int16 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i16 String
"ctz16" ((Int16 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int16 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int16 -> IntValue) -> Int16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int16 -> Int32) -> Int16 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int16 -> Int) -> Int16 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros
  , String
-> (Int32 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int32 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i32 String
"ctz32" ((Int32 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int32 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int32 -> IntValue) -> Int32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int32 -> Int32) -> Int32 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int32 -> Int) -> Int32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros
  , String
-> (Int64 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int64 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i64 String
"ctz64" ((Int64 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int64 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int64 -> IntValue) -> Int64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int64 -> Int32) -> Int64 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int64 -> Int) -> Int64 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros

  , String
-> (Int8 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int8 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i8 String
"popc8" ((Int8 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int8 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> (Int8 -> IntValue) -> Int8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int8 -> Int32) -> Int8 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int8 -> Int) -> Int8 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int
forall a. Bits a => a -> Int
popCount
  , String
-> (Int16 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int16 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i16 String
"popc16" ((Int16 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int16 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int16 -> IntValue) -> Int16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int16 -> Int32) -> Int16 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int16 -> Int) -> Int16 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Int
forall a. Bits a => a -> Int
popCount
  , String
-> (Int32 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int32 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i32 String
"popc32" ((Int32 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int32 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int32 -> IntValue) -> Int32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int32 -> Int32) -> Int32 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int32 -> Int) -> Int32 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a. Bits a => a -> Int
popCount
  , String
-> (Int64 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a a.
a
-> (Int64 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i64 String
"popc64" ((Int64 -> PrimValue)
 -> (String,
     ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)))
-> (Int64 -> PrimValue)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int64 -> IntValue) -> Int64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Int64 -> Int32) -> Int64 -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int64 -> Int) -> Int64 -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int
forall a. Bits a => a -> Int
popCount

  , (String
"mad_hi8", ([IntType -> PrimType
IntType IntType
Int8, IntType -> PrimType
IntType IntType
Int8, IntType -> PrimType
IntType IntType
Int8], IntType -> PrimType
IntType IntType
Int8,
                 \case
                   [IntValue (Int8Value Int8
a), IntValue (Int8Value Int8
b), IntValue (Int8Value Int8
c)] ->
                     PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> (Int8 -> IntValue) -> Int8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value (Int8 -> PrimValue) -> Int8 -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Int8 -> Int8
mad_hi8 (Int8 -> IntValue
Int8Value Int8
a) (Int8 -> IntValue
Int8Value Int8
b) Int8
c
                   [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing
                ))
  , (String
"mad_hi16", ([IntType -> PrimType
IntType IntType
Int16, IntType -> PrimType
IntType IntType
Int16, IntType -> PrimType
IntType IntType
Int16], IntType -> PrimType
IntType IntType
Int16,
                 \case
                   [IntValue (Int16Value Int16
a), IntValue (Int16Value Int16
b), IntValue (Int16Value Int16
c)] ->
                     PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int16 -> IntValue) -> Int16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value  (Int16 -> PrimValue) -> Int16 -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Int16 -> Int16
mad_hi16 (Int16 -> IntValue
Int16Value Int16
a) (Int16 -> IntValue
Int16Value Int16
b) Int16
c
                   [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing
                ))
  , (String
"mad_hi32", ([IntType -> PrimType
IntType IntType
Int32, IntType -> PrimType
IntType IntType
Int32, IntType -> PrimType
IntType IntType
Int32], IntType -> PrimType
IntType IntType
Int32,
                  \case
                   [IntValue (Int32Value Int32
a), IntValue (Int32Value Int32
b), IntValue (Int32Value Int32
c)] ->
                     PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int32 -> IntValue) -> Int32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value  (Int32 -> PrimValue) -> Int32 -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Int32 -> Int32
mad_hi32 (Int32 -> IntValue
Int32Value Int32
a) (Int32 -> IntValue
Int32Value Int32
b) Int32
c
                   [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing
                ))
  , (String
"mad_hi64", ([IntType -> PrimType
IntType IntType
Int64, IntType -> PrimType
IntType IntType
Int64, IntType -> PrimType
IntType IntType
Int64], IntType -> PrimType
IntType IntType
Int64,
                  \case
                    [IntValue (Int64Value Int64
a), IntValue (Int64Value Int64
b), IntValue (Int64Value Int64
c)] ->
                      PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int64 -> IntValue) -> Int64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value (Int64 -> PrimValue) -> Int64 -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Int64 -> Int64
mad_hi64 (Int64 -> IntValue
Int64Value Int64
a) (Int64 -> IntValue
Int64Value Int64
b) Int64
c
                    [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing
                ))

  , (String
"mul_hi8", ([IntType -> PrimType
IntType IntType
Int8, IntType -> PrimType
IntType IntType
Int8], IntType -> PrimType
IntType IntType
Int8,
                 \case
                   [IntValue (Int8Value Int8
a), IntValue (Int8Value Int8
b)] ->
                     PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> (Int8 -> IntValue) -> Int8 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> IntValue
Int8Value (Int8 -> PrimValue) -> Int8 -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Int8
mul_hi8 (Int8 -> IntValue
Int8Value Int8
a) (Int8 -> IntValue
Int8Value Int8
b)
                   [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing
                ))
  , (String
"mul_hi16", ([IntType -> PrimType
IntType IntType
Int16, IntType -> PrimType
IntType IntType
Int16], IntType -> PrimType
IntType IntType
Int16,
                 \case
                   [IntValue (Int16Value Int16
a), IntValue (Int16Value Int16
b)] ->
                     PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int16 -> IntValue) -> Int16 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> IntValue
Int16Value  (Int16 -> PrimValue) -> Int16 -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Int16
mul_hi16 (Int16 -> IntValue
Int16Value Int16
a) (Int16 -> IntValue
Int16Value Int16
b)
                   [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing
                ))
  , (String
"mul_hi32", ([IntType -> PrimType
IntType IntType
Int32, IntType -> PrimType
IntType IntType
Int32], IntType -> PrimType
IntType IntType
Int32,
                  \case
                   [IntValue (Int32Value Int32
a), IntValue (Int32Value Int32
b)] ->
                     PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int32 -> IntValue) -> Int32 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> IntValue
Int32Value  (Int32 -> PrimValue) -> Int32 -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Int32
mul_hi32 (Int32 -> IntValue
Int32Value Int32
a) (Int32 -> IntValue
Int32Value Int32
b)
                   [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing
                ))
  , (String
"mul_hi64", ([IntType -> PrimType
IntType IntType
Int64, IntType -> PrimType
IntType IntType
Int64], IntType -> PrimType
IntType IntType
Int64,
                  \case
                    [IntValue (Int64Value Int64
a), IntValue (Int64Value Int64
b)] ->
                      PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Int64 -> IntValue) -> Int64 -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> IntValue
Int64Value (Int64 -> PrimValue) -> Int64 -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntValue -> Int64
mul_hi64 (Int64 -> IntValue
Int64Value Int64
a) (Int64 -> IntValue
Int64Value Int64
b)
                    [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing
                ))

  , (String
"atan2_32",
     ([FloatType -> PrimType
FloatType FloatType
Float32, FloatType -> PrimType
FloatType FloatType
Float32], FloatType -> PrimType
FloatType FloatType
Float32,
      \case
        [FloatValue (Float32Value Float
x), FloatValue (Float32Value Float
y)] ->
          PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Float -> FloatValue
Float32Value (Float -> FloatValue) -> Float -> FloatValue
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float
forall a. RealFloat a => a -> a -> a
atan2 Float
x Float
y
        [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))
  , (String
"atan2_64",
     ([FloatType -> PrimType
FloatType FloatType
Float64, FloatType -> PrimType
FloatType FloatType
Float64], FloatType -> PrimType
FloatType FloatType
Float64,
       \case
         [FloatValue (Float64Value Double
x), FloatValue (Float64Value Double
y)] ->
           PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Double -> FloatValue
Float64Value (Double -> FloatValue) -> Double -> FloatValue
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
x Double
y
         [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))

  , (String
"isinf32",
     ([FloatType -> PrimType
FloatType FloatType
Float32], PrimType
Bool,
      \case
        [FloatValue (Float32Value Float
x)] -> PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Bool -> PrimValue
forall a b. (a -> b) -> a -> b
$ Float -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Float
x
        [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))
  , (String
"isinf64",
     ([FloatType -> PrimType
FloatType FloatType
Float64], PrimType
Bool,
      \case
        [FloatValue (Float64Value Double
x)] -> PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Bool -> PrimValue
forall a b. (a -> b) -> a -> b
$ Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
x
        [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))

  , (String
"isnan32",
     ([FloatType -> PrimType
FloatType FloatType
Float32], PrimType
Bool,
      \case
        [FloatValue (Float32Value Float
x)] -> PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Bool -> PrimValue
forall a b. (a -> b) -> a -> b
$ Float -> Bool
forall a. RealFloat a => a -> Bool
isNaN Float
x
        [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))
  , (String
"isnan64",
     ([FloatType -> PrimType
FloatType FloatType
Float64], PrimType
Bool,
      \case
        [FloatValue (Float64Value Double
x)] -> PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue (Bool -> PrimValue) -> Bool -> PrimValue
forall a b. (a -> b) -> a -> b
$ Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
x
        [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))

  , (String
"to_bits32",
     ([FloatType -> PrimType
FloatType FloatType
Float32], IntType -> PrimType
IntType IntType
Int32,
      \case
        [FloatValue (Float32Value Float
x)] ->
          PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> Int32 -> IntValue
forall a b. (a -> b) -> a -> b
$ Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int32) -> Word32 -> Int32
forall a b. (a -> b) -> a -> b
$ Float -> Word32
floatToWord Float
x
        [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))
  , (String
"to_bits64",
     ([FloatType -> PrimType
FloatType FloatType
Float64], IntType -> PrimType
IntType IntType
Int64,
      \case
        [FloatValue (Float64Value Double
x)] ->
          PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Int64 -> IntValue
Int64Value (Int64 -> IntValue) -> Int64 -> IntValue
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ Double -> Word64
doubleToWord Double
x
        [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))

  , (String
"from_bits32",
     ([IntType -> PrimType
IntType IntType
Int32], FloatType -> PrimType
FloatType FloatType
Float32,
      \case
        [IntValue (Int32Value Int32
x)] ->
          PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Float -> FloatValue
Float32Value (Float -> FloatValue) -> Float -> FloatValue
forall a b. (a -> b) -> a -> b
$ Word32 -> Float
wordToFloat (Word32 -> Float) -> Word32 -> Float
forall a b. (a -> b) -> a -> b
$ Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
x
        [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))
  , (String
"from_bits64",
     ([IntType -> PrimType
IntType IntType
Int64], FloatType -> PrimType
FloatType FloatType
Float64,
      \case
        [IntValue (Int64Value Int64
x)] ->
          PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Double -> FloatValue
Float64Value (Double -> FloatValue) -> Double -> FloatValue
forall a b. (a -> b) -> a -> b
$ Word64 -> Double
wordToDouble (Word64 -> Double) -> Word64 -> Double
forall a b. (a -> b) -> a -> b
$ Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
x
        [PrimValue]
_ -> Maybe PrimValue
forall a. Maybe a
Nothing))

  , String
-> (Float -> Float -> Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float -> Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32_3 String
"lerp32" (\Float
v0 Float
v1 Float
t -> Float
v0 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ (Float
v1Float -> Float -> Float
forall a. Num a => a -> a -> a
-Float
v0)Float -> Float -> Float
forall a. Num a => a -> a -> a
*Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
1 Float
t))
  , String
-> (Double -> Double -> Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double -> Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64_3 String
"lerp64" (\Double
v0 Double
v1 Double
t -> Double
v0 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
v1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
v0)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
1 Double
t))

  , String
-> (Float -> Float -> Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float -> Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32_3 String
"mad32" (\Float
a Float
b Float
c -> Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
bFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
c)
  , String
-> (Double -> Double -> Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double -> Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64_3 String
"mad64" (\Double
a Double
b Double
c -> Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c)

  , String
-> (Float -> Float -> Float -> Float)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Float -> Float -> Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32_3 String
"fma32" (\Float
a Float
b Float
c -> Float
aFloat -> Float -> Float
forall a. Num a => a -> a -> a
*Float
bFloat -> Float -> Float
forall a. Num a => a -> a -> a
+Float
c)
  , String
-> (Double -> Double -> Double -> Double)
-> (String, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
forall a.
a
-> (Double -> Double -> Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64_3 String
"fma64" (\Double
a Double
b Double
c -> Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
c)

  ]
  where i8 :: a
-> (Int8 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i8 a
s Int8 -> a
f = (a
s, ([IntType -> PrimType
IntType IntType
Int8], IntType -> PrimType
IntType IntType
Int32, (Int8 -> a) -> [PrimValue] -> Maybe a
forall a. (Int8 -> a) -> [PrimValue] -> Maybe a
i8PrimFun Int8 -> a
f))
        i16 :: a
-> (Int16 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i16 a
s Int16 -> a
f = (a
s, ([IntType -> PrimType
IntType IntType
Int16], IntType -> PrimType
IntType IntType
Int32, (Int16 -> a) -> [PrimValue] -> Maybe a
forall a. (Int16 -> a) -> [PrimValue] -> Maybe a
i16PrimFun Int16 -> a
f))
        i32 :: a
-> (Int32 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i32 a
s Int32 -> a
f = (a
s, ([IntType -> PrimType
IntType IntType
Int32], IntType -> PrimType
IntType IntType
Int32, (Int32 -> a) -> [PrimValue] -> Maybe a
forall a. (Int32 -> a) -> [PrimValue] -> Maybe a
i32PrimFun Int32 -> a
f))
        i64 :: a
-> (Int64 -> a)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe a))
i64 a
s Int64 -> a
f = (a
s, ([IntType -> PrimType
IntType IntType
Int64], IntType -> PrimType
IntType IntType
Int32, (Int64 -> a) -> [PrimValue] -> Maybe a
forall a. (Int64 -> a) -> [PrimValue] -> Maybe a
i64PrimFun Int64 -> a
f))
        f32 :: a
-> (Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32 a
s Float -> Float
f = (a
s, ([FloatType -> PrimType
FloatType FloatType
Float32], FloatType -> PrimType
FloatType FloatType
Float32, (Float -> Float) -> [PrimValue] -> Maybe PrimValue
f32PrimFun Float -> Float
f))
        f64 :: a
-> (Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64 a
s Double -> Double
f = (a
s, ([FloatType -> PrimType
FloatType FloatType
Float64], FloatType -> PrimType
FloatType FloatType
Float64, (Double -> Double) -> [PrimValue] -> Maybe PrimValue
f64PrimFun Double -> Double
f))
        f32_3 :: a
-> (Float -> Float -> Float -> Float)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f32_3 a
s Float -> Float -> Float -> Float
f = (a
s, ([FloatType -> PrimType
FloatType FloatType
Float32,FloatType -> PrimType
FloatType FloatType
Float32,FloatType -> PrimType
FloatType FloatType
Float32],
                         FloatType -> PrimType
FloatType FloatType
Float32, (Float -> Float -> Float -> Float)
-> [PrimValue] -> Maybe PrimValue
f32PrimFun3 Float -> Float -> Float -> Float
f))
        f64_3 :: a
-> (Double -> Double -> Double -> Double)
-> (a, ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue))
f64_3 a
s Double -> Double -> Double -> Double
f = (a
s, ([FloatType -> PrimType
FloatType FloatType
Float64,FloatType -> PrimType
FloatType FloatType
Float64,FloatType -> PrimType
FloatType FloatType
Float64],
                         FloatType -> PrimType
FloatType FloatType
Float64, (Double -> Double -> Double -> Double)
-> [PrimValue] -> Maybe PrimValue
f64PrimFun3 Double -> Double -> Double -> Double
f))

        i8PrimFun :: (Int8 -> a) -> [PrimValue] -> Maybe a
i8PrimFun Int8 -> a
f [IntValue (Int8Value Int8
x)] =
          a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int8 -> a
f Int8
x
        i8PrimFun Int8 -> a
_ [PrimValue]
_ = Maybe a
forall a. Maybe a
Nothing

        i16PrimFun :: (Int16 -> a) -> [PrimValue] -> Maybe a
i16PrimFun Int16 -> a
f [IntValue (Int16Value Int16
x)] =
          a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int16 -> a
f Int16
x
        i16PrimFun Int16 -> a
_ [PrimValue]
_ = Maybe a
forall a. Maybe a
Nothing

        i32PrimFun :: (Int32 -> a) -> [PrimValue] -> Maybe a
i32PrimFun Int32 -> a
f [IntValue (Int32Value Int32
x)] =
          a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int32 -> a
f Int32
x
        i32PrimFun Int32 -> a
_ [PrimValue]
_ = Maybe a
forall a. Maybe a
Nothing

        i64PrimFun :: (Int64 -> a) -> [PrimValue] -> Maybe a
i64PrimFun Int64 -> a
f [IntValue (Int64Value Int64
x)] =
          a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Int64 -> a
f Int64
x
        i64PrimFun Int64 -> a
_ [PrimValue]
_ = Maybe a
forall a. Maybe a
Nothing

        f32PrimFun :: (Float -> Float) -> [PrimValue] -> Maybe PrimValue
f32PrimFun Float -> Float
f [FloatValue (Float32Value Float
x)] =
          PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Float -> FloatValue
Float32Value (Float -> FloatValue) -> Float -> FloatValue
forall a b. (a -> b) -> a -> b
$ Float -> Float
f Float
x
        f32PrimFun Float -> Float
_ [PrimValue]
_ = Maybe PrimValue
forall a. Maybe a
Nothing

        f64PrimFun :: (Double -> Double) -> [PrimValue] -> Maybe PrimValue
f64PrimFun Double -> Double
f [FloatValue (Float64Value Double
x)] =
          PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Double -> FloatValue
Float64Value (Double -> FloatValue) -> Double -> FloatValue
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
x
        f64PrimFun Double -> Double
_ [PrimValue]
_ = Maybe PrimValue
forall a. Maybe a
Nothing

        f32PrimFun3 :: (Float -> Float -> Float -> Float)
-> [PrimValue] -> Maybe PrimValue
f32PrimFun3 Float -> Float -> Float -> Float
f [FloatValue (Float32Value Float
a),
                       FloatValue (Float32Value Float
b),
                       FloatValue (Float32Value Float
c)] =
          PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Float -> FloatValue
Float32Value (Float -> FloatValue) -> Float -> FloatValue
forall a b. (a -> b) -> a -> b
$ Float -> Float -> Float -> Float
f Float
a Float
b Float
c
        f32PrimFun3 Float -> Float -> Float -> Float
_ [PrimValue]
_ = Maybe PrimValue
forall a. Maybe a
Nothing

        f64PrimFun3 :: (Double -> Double -> Double -> Double)
-> [PrimValue] -> Maybe PrimValue
f64PrimFun3 Double -> Double -> Double -> Double
f [FloatValue (Float64Value Double
a),
                       FloatValue (Float64Value Double
b),
                       FloatValue (Float64Value Double
c)] =
          PrimValue -> Maybe PrimValue
forall a. a -> Maybe a
Just (PrimValue -> Maybe PrimValue) -> PrimValue -> Maybe PrimValue
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Double -> FloatValue
Float64Value (Double -> FloatValue) -> Double -> FloatValue
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double
f Double
a Double
b Double
c
        f64PrimFun3 Double -> Double -> Double -> Double
_ [PrimValue]
_ = Maybe PrimValue
forall a. Maybe a
Nothing

-- | Is the given value kind of zero?
zeroIsh :: PrimValue -> Bool
zeroIsh :: PrimValue -> Bool
zeroIsh (IntValue IntValue
k)                  = IntValue -> Bool
zeroIshInt IntValue
k
zeroIsh (FloatValue (Float32Value Float
k)) = Float
k Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0
zeroIsh (FloatValue (Float64Value Double
k)) = Double
k Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0
zeroIsh (BoolValue Bool
False)             = Bool
True
zeroIsh PrimValue
_                             = Bool
False

-- | Is the given value kind of one?
oneIsh :: PrimValue -> Bool
oneIsh :: PrimValue -> Bool
oneIsh (IntValue IntValue
k)                  = IntValue -> Bool
oneIshInt IntValue
k
oneIsh (FloatValue (Float32Value Float
k)) = Float
k Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
1
oneIsh (FloatValue (Float64Value Double
k)) = Double
k Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
1
oneIsh (BoolValue Bool
True)              = Bool
True
oneIsh PrimValue
_                             = Bool
False

-- | Is the given value kind of negative?
negativeIsh :: PrimValue -> Bool
negativeIsh :: PrimValue -> Bool
negativeIsh (IntValue IntValue
k)                  = IntValue -> Bool
negativeIshInt IntValue
k
negativeIsh (FloatValue (Float32Value Float
k)) = Float
k Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0
negativeIsh (FloatValue (Float64Value Double
k)) = Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0
negativeIsh (BoolValue Bool
_)                 = Bool
False
negativeIsh PrimValue
Checked                       = Bool
False

-- | Is the given integer value kind of zero?
zeroIshInt :: IntValue -> Bool
zeroIshInt :: IntValue -> Bool
zeroIshInt (Int8Value Int8
k)  = Int8
k Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
0
zeroIshInt (Int16Value Int16
k) = Int16
k Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
0
zeroIshInt (Int32Value Int32
k) = Int32
k Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0
zeroIshInt (Int64Value Int64
k) = Int64
k Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
0

-- | Is the given integer value kind of one?
oneIshInt :: IntValue -> Bool
oneIshInt :: IntValue -> Bool
oneIshInt (Int8Value Int8
k)  = Int8
k Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int8
1
oneIshInt (Int16Value Int16
k) = Int16
k Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
== Int16
1
oneIshInt (Int32Value Int32
k) = Int32
k Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
1
oneIshInt (Int64Value Int64
k) = Int64
k Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
1

-- | Is the given integer value kind of negative?
negativeIshInt :: IntValue -> Bool
negativeIshInt :: IntValue -> Bool
negativeIshInt (Int8Value Int8
k)  = Int8
k Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
< Int8
0
negativeIshInt (Int16Value Int16
k) = Int16
k Int16 -> Int16 -> Bool
forall a. Ord a => a -> a -> Bool
< Int16
0
negativeIshInt (Int32Value Int32
k) = Int32
k Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0
negativeIshInt (Int64Value Int64
k) = Int64
k Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0

-- | The size of a value of a given primitive type in bites.
primBitSize :: PrimType -> Int
primBitSize :: PrimType -> Int
primBitSize = (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
8) (Int -> Int) -> (PrimType -> Int) -> PrimType -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimType -> Int
forall a. Num a => PrimType -> a
primByteSize

-- | The size of a value of a given primitive type in eight-bit bytes.
primByteSize :: Num a => PrimType -> a
primByteSize :: PrimType -> a
primByteSize (IntType IntType
t)   = IntType -> a
forall a. Num a => IntType -> a
intByteSize IntType
t
primByteSize (FloatType FloatType
t) = FloatType -> a
forall a. Num a => FloatType -> a
floatByteSize FloatType
t
primByteSize PrimType
Bool          = a
1
primByteSize PrimType
Cert          = a
1

-- | The size of a value of a given integer type in eight-bit bytes.
intByteSize :: Num a => IntType -> a
intByteSize :: IntType -> a
intByteSize IntType
Int8  = a
1
intByteSize IntType
Int16 = a
2
intByteSize IntType
Int32 = a
4
intByteSize IntType
Int64 = a
8

-- | The size of a value of a given floating-point type in eight-bit bytes.
floatByteSize :: Num a => FloatType -> a
floatByteSize :: FloatType -> a
floatByteSize FloatType
Float32 = a
4
floatByteSize FloatType
Float64 = a
8

-- | True if the given binary operator is commutative.
commutativeBinOp :: BinOp -> Bool
commutativeBinOp :: BinOp -> Bool
commutativeBinOp Add{} = Bool
True
commutativeBinOp FAdd{} = Bool
True
commutativeBinOp Mul{} = Bool
True
commutativeBinOp FMul{} = Bool
True
commutativeBinOp And{} = Bool
True
commutativeBinOp Or{} = Bool
True
commutativeBinOp Xor{} = Bool
True
commutativeBinOp LogOr{} = Bool
True
commutativeBinOp LogAnd{} = Bool
True
commutativeBinOp SMax{} = Bool
True
commutativeBinOp SMin{} = Bool
True
commutativeBinOp UMax{} = Bool
True
commutativeBinOp UMin{} = Bool
True
commutativeBinOp FMax{} = Bool
True
commutativeBinOp FMin{} = Bool
True
commutativeBinOp BinOp
_ = Bool
False

-- Prettyprinting instances

instance Pretty BinOp where
  ppr :: BinOp -> Doc
ppr (Add IntType
t Overflow
OverflowWrap)  = String -> IntType -> Doc
taggedI String
"add" IntType
t
  ppr (Add IntType
t Overflow
OverflowUndef) = String -> IntType -> Doc
taggedI String
"add_nw" IntType
t
  ppr (Sub IntType
t Overflow
OverflowWrap)  = String -> IntType -> Doc
taggedI String
"sub" IntType
t
  ppr (Sub IntType
t Overflow
OverflowUndef) = String -> IntType -> Doc
taggedI String
"sub_nw" IntType
t
  ppr (Mul IntType
t Overflow
OverflowWrap)  = String -> IntType -> Doc
taggedI String
"mul" IntType
t
  ppr (Mul IntType
t Overflow
OverflowUndef) = String -> IntType -> Doc
taggedI String
"mul_nw" IntType
t
  ppr (FAdd FloatType
t)  = String -> FloatType -> Doc
taggedF String
"fadd" FloatType
t
  ppr (FSub FloatType
t)  = String -> FloatType -> Doc
taggedF String
"fsub" FloatType
t
  ppr (FMul FloatType
t)  = String -> FloatType -> Doc
taggedF String
"fmul" FloatType
t
  ppr (UDiv IntType
t Safety
Safe)    = String -> IntType -> Doc
taggedI String
"udiv_safe" IntType
t
  ppr (UDiv IntType
t Safety
Unsafe)  = String -> IntType -> Doc
taggedI String
"udiv" IntType
t
  ppr (UDivUp IntType
t Safety
Safe)   = String -> IntType -> Doc
taggedI String
"udiv_up_safe" IntType
t
  ppr (UDivUp IntType
t Safety
Unsafe) = String -> IntType -> Doc
taggedI String
"udiv_up" IntType
t
  ppr (UMod IntType
t Safety
Safe)    = String -> IntType -> Doc
taggedI String
"umod_safe" IntType
t
  ppr (UMod IntType
t Safety
Unsafe)  = String -> IntType -> Doc
taggedI String
"umod" IntType
t
  ppr (SDiv IntType
t Safety
Safe)    = String -> IntType -> Doc
taggedI String
"sdiv_safe" IntType
t
  ppr (SDiv IntType
t Safety
Unsafe)  = String -> IntType -> Doc
taggedI String
"sdiv" IntType
t
  ppr (SDivUp IntType
t Safety
Safe)   = String -> IntType -> Doc
taggedI String
"sdiv_up_safe" IntType
t
  ppr (SDivUp IntType
t Safety
Unsafe) = String -> IntType -> Doc
taggedI String
"sdiv_up" IntType
t
  ppr (SMod IntType
t Safety
Safe)    = String -> IntType -> Doc
taggedI String
"smod_safe" IntType
t
  ppr (SMod IntType
t Safety
Unsafe)  = String -> IntType -> Doc
taggedI String
"smod" IntType
t
  ppr (SQuot IntType
t Safety
Safe)   = String -> IntType -> Doc
taggedI String
"squot_safe" IntType
t
  ppr (SQuot IntType
t Safety
Unsafe) = String -> IntType -> Doc
taggedI String
"squot" IntType
t
  ppr (SRem IntType
t Safety
Safe)    = String -> IntType -> Doc
taggedI String
"srem_safe" IntType
t
  ppr (SRem IntType
t Safety
Unsafe)  = String -> IntType -> Doc
taggedI String
"srem" IntType
t
  ppr (FDiv FloatType
t)  = String -> FloatType -> Doc
taggedF String
"fdiv" FloatType
t
  ppr (FMod FloatType
t)  = String -> FloatType -> Doc
taggedF String
"fmod" FloatType
t
  ppr (SMin IntType
t)  = String -> IntType -> Doc
taggedI String
"smin" IntType
t
  ppr (UMin IntType
t)  = String -> IntType -> Doc
taggedI String
"umin" IntType
t
  ppr (FMin FloatType
t)  = String -> FloatType -> Doc
taggedF String
"fmin" FloatType
t
  ppr (SMax IntType
t)  = String -> IntType -> Doc
taggedI String
"smax" IntType
t
  ppr (UMax IntType
t)  = String -> IntType -> Doc
taggedI String
"umax" IntType
t
  ppr (FMax FloatType
t)  = String -> FloatType -> Doc
taggedF String
"fmax" FloatType
t
  ppr (Shl IntType
t)   = String -> IntType -> Doc
taggedI String
"shl" IntType
t
  ppr (LShr IntType
t)  = String -> IntType -> Doc
taggedI String
"lshr" IntType
t
  ppr (AShr IntType
t)  = String -> IntType -> Doc
taggedI String
"ashr" IntType
t
  ppr (And IntType
t)   = String -> IntType -> Doc
taggedI String
"and" IntType
t
  ppr (Or IntType
t)    = String -> IntType -> Doc
taggedI String
"or" IntType
t
  ppr (Xor IntType
t)   = String -> IntType -> Doc
taggedI String
"xor" IntType
t
  ppr (Pow IntType
t)   = String -> IntType -> Doc
taggedI String
"pow" IntType
t
  ppr (FPow FloatType
t)  = String -> FloatType -> Doc
taggedF String
"fpow" FloatType
t
  ppr BinOp
LogAnd    = String -> Doc
text String
"logand"
  ppr BinOp
LogOr     = String -> Doc
text String
"logor"

instance Pretty CmpOp where
  ppr :: CmpOp -> Doc
ppr (CmpEq PrimType
t)  = String -> Doc
text String
"eq_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> PrimType -> Doc
forall a. Pretty a => a -> Doc
ppr PrimType
t
  ppr (CmpUlt IntType
t) = String -> IntType -> Doc
taggedI String
"ult" IntType
t
  ppr (CmpUle IntType
t) = String -> IntType -> Doc
taggedI String
"ule" IntType
t
  ppr (CmpSlt IntType
t) = String -> IntType -> Doc
taggedI String
"slt" IntType
t
  ppr (CmpSle IntType
t) = String -> IntType -> Doc
taggedI String
"sle" IntType
t
  ppr (FCmpLt FloatType
t) = String -> FloatType -> Doc
taggedF String
"lt" FloatType
t
  ppr (FCmpLe FloatType
t) = String -> FloatType -> Doc
taggedF String
"le" FloatType
t
  ppr CmpOp
CmpLlt = String -> Doc
text String
"llt"
  ppr CmpOp
CmpLle = String -> Doc
text String
"lle"

instance Pretty ConvOp where
  ppr :: ConvOp -> Doc
ppr ConvOp
op = String -> PrimType -> PrimType -> Doc
forall from to.
(Pretty from, Pretty to) =>
String -> from -> to -> Doc
convOp (ConvOp -> String
convOpFun ConvOp
op) PrimType
from PrimType
to
    where (PrimType
from, PrimType
to) = ConvOp -> (PrimType, PrimType)
convOpType ConvOp
op

instance Pretty UnOp where
  ppr :: UnOp -> Doc
ppr UnOp
Not            = String -> Doc
text String
"not"
  ppr (Abs IntType
t)        = String -> IntType -> Doc
taggedI String
"abs" IntType
t
  ppr (FAbs FloatType
t)       = String -> FloatType -> Doc
taggedF String
"fabs" FloatType
t
  ppr (SSignum IntType
t)    = String -> IntType -> Doc
taggedI String
"ssignum" IntType
t
  ppr (USignum IntType
t)    = String -> IntType -> Doc
taggedI String
"usignum" IntType
t
  ppr (Complement IntType
t) = String -> IntType -> Doc
taggedI String
"complement" IntType
t

-- | The human-readable name for a 'ConvOp'.  This is used to expose
-- the 'ConvOp' in the @intrinsics@ module of a Futhark program.
convOpFun :: ConvOp -> String
convOpFun :: ConvOp -> String
convOpFun ZExt{}   = String
"zext"
convOpFun SExt{}   = String
"sext"
convOpFun FPConv{} = String
"fpconv"
convOpFun FPToUI{} = String
"fptoui"
convOpFun FPToSI{} = String
"fptosi"
convOpFun UIToFP{} = String
"uitofp"
convOpFun SIToFP{} = String
"sitofp"
convOpFun IToB{}   = String
"itob"
convOpFun BToI{}   = String
"btoi"

taggedI :: String -> IntType -> Doc
taggedI :: String -> IntType -> Doc
taggedI String
s IntType
Int8  = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"8"
taggedI String
s IntType
Int16 = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"16"
taggedI String
s IntType
Int32 = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"32"
taggedI String
s IntType
Int64 = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"64"

taggedF :: String -> FloatType -> Doc
taggedF :: String -> FloatType -> Doc
taggedF String
s FloatType
Float32 = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"32"
taggedF String
s FloatType
Float64 = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"64"

convOp :: (Pretty from, Pretty to) => String -> from -> to -> Doc
convOp :: String -> from -> to -> Doc
convOp String
s from
from to
to = String -> Doc
text String
s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> from -> Doc
forall a. Pretty a => a -> Doc
ppr from
from Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"_" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> to -> Doc
forall a. Pretty a => a -> Doc
ppr to
to

-- | True if signed.  Only makes a difference for integer types.
prettySigned :: Bool -> PrimType -> String
prettySigned :: Bool -> PrimType -> String
prettySigned Bool
True (IntType IntType
it) = Char
'u' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 (IntType -> String
forall a. Pretty a => a -> String
pretty IntType
it)
prettySigned Bool
_ PrimType
t = PrimType -> String
forall a. Pretty a => a -> String
pretty PrimType
t

mul_hi8 :: IntValue -> IntValue -> Int8
mul_hi8 :: IntValue -> IntValue -> Int8
mul_hi8 IntValue
a IntValue
b =
  let a' :: Word64
a' = IntValue -> Word64
intToWord64 IntValue
a
      b' :: Word64
b' = IntValue -> Word64
intToWord64 IntValue
b
  in Word64 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR (Word64
a' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
b') Int
8)

mul_hi16 :: IntValue -> IntValue -> Int16
mul_hi16 :: IntValue -> IntValue -> Int16
mul_hi16 IntValue
a IntValue
b =
  let a' :: Word64
a' = IntValue -> Word64
intToWord64 IntValue
a
      b' :: Word64
b' = IntValue -> Word64
intToWord64 IntValue
b
  in Word64 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR (Word64
a' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
b') Int
16)

mul_hi32 :: IntValue -> IntValue -> Int32
mul_hi32 :: IntValue -> IntValue -> Int32
mul_hi32 IntValue
a IntValue
b =
  let a' :: Word64
a' = IntValue -> Word64
intToWord64 IntValue
a
      b' :: Word64
b' = IntValue -> Word64
intToWord64 IntValue
b
  in Word64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR (Word64
a' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
b') Int
32)

mul_hi64 :: IntValue -> IntValue -> Int64
mul_hi64 :: IntValue -> IntValue -> Int64
mul_hi64 IntValue
a IntValue
b =
  let a' :: Integer
a' = (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (IntValue -> Word64) -> IntValue -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntValue -> Word64
intToWord64) IntValue
a
      b' :: Integer
b' = (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (IntValue -> Word64) -> IntValue -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntValue -> Word64
intToWord64) IntValue
b
  in Integer -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftR (Integer
a' Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
b') Int
64)

mad_hi8 :: IntValue -> IntValue -> Int8 -> Int8
mad_hi8 :: IntValue -> IntValue -> Int8 -> Int8
mad_hi8 IntValue
a IntValue
b Int8
c = IntValue -> IntValue -> Int8
mul_hi8 IntValue
a IntValue
b Int8 -> Int8 -> Int8
forall a. Num a => a -> a -> a
+ Int8
c

mad_hi16 :: IntValue -> IntValue -> Int16 -> Int16
mad_hi16 :: IntValue -> IntValue -> Int16 -> Int16
mad_hi16 IntValue
a IntValue
b Int16
c = IntValue -> IntValue -> Int16
mul_hi16 IntValue
a IntValue
b Int16 -> Int16 -> Int16
forall a. Num a => a -> a -> a
+ Int16
c

mad_hi32 :: IntValue -> IntValue -> Int32 -> Int32
mad_hi32 :: IntValue -> IntValue -> Int32 -> Int32
mad_hi32 IntValue
a IntValue
b Int32
c = IntValue -> IntValue -> Int32
mul_hi32 IntValue
a IntValue
b Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
c

mad_hi64 :: IntValue -> IntValue -> Int64 -> Int64
mad_hi64 :: IntValue -> IntValue -> Int64 -> Int64
mad_hi64 IntValue
a IntValue
b Int64
c = IntValue -> IntValue -> Int64
mul_hi64 IntValue
a IntValue
b Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
c