{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

-- | A primitive expression is an expression where the non-leaves are
-- primitive operators.  Our representation does not guarantee that
-- the expression is type-correct.
module Futhark.Analysis.PrimExp
  ( PrimExp (..),
    TPrimExp (..),
    isInt8,
    isInt16,
    isInt32,
    isInt64,
    isBool,
    isF16,
    isF32,
    isF64,
    evalPrimExp,
    primExpType,
    primExpSizeAtLeast,
    coerceIntPrimExp,
    leafExpTypes,
    true,
    false,
    fromBool,
    constFoldPrimExp,

    -- * Construction
    module Language.Futhark.Primitive,
    NumExp (..),
    IntExp (..),
    FloatExp (..),
    sExt,
    zExt,
    (.&&.),
    (.||.),
    (.<.),
    (.<=.),
    (.>.),
    (.>=.),
    (.==.),
    (.&.),
    (.|.),
    (.^.),
    (.>>.),
    (.<<.),
    bNot,
    sMax32,
    sMin32,
    sMax64,
    sMin64,
    sExt32,
    sExt64,
    zExt32,
    zExt64,
    sExtAs,
    fMin16,
    fMin32,
    fMin64,
    fMax16,
    fMax32,
    fMax64,
    condExp,

    -- * Untyped construction
    (~*~),
    (~/~),
    (~+~),
    (~-~),
    (~==~),
  )
where

import Control.Category
import Control.Monad
import Data.Map qualified as M
import Data.Set qualified as S
import Data.Text qualified as T
import Data.Traversable
import Futhark.IR.Prop.Names
import Futhark.Util.IntegralExp
import Futhark.Util.Pretty
import Language.Futhark.Primitive
import Prelude hiding (id, (.))

-- | A primitive expression parametrised over the representation of
-- free variables.  Note that the 'Functor', 'Traversable', and 'Num'
-- instances perform automatic (but simple) constant folding.
--
-- Note also that the 'Num' instance assumes 'OverflowUndef'
-- semantics!
data PrimExp v
  = LeafExp v PrimType
  | ValueExp PrimValue
  | BinOpExp BinOp (PrimExp v) (PrimExp v)
  | CmpOpExp CmpOp (PrimExp v) (PrimExp v)
  | UnOpExp UnOp (PrimExp v)
  | ConvOpExp ConvOp (PrimExp v)
  | FunExp T.Text [PrimExp v] PrimType
  deriving (PrimExp v -> PrimExp v -> Bool
(PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> Bool) -> Eq (PrimExp v)
forall v. Eq v => PrimExp v -> PrimExp v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => PrimExp v -> PrimExp v -> Bool
== :: PrimExp v -> PrimExp v -> Bool
$c/= :: forall v. Eq v => PrimExp v -> PrimExp v -> Bool
/= :: PrimExp v -> PrimExp v -> Bool
Eq, Eq (PrimExp v)
Eq (PrimExp v) =>
(PrimExp v -> PrimExp v -> Ordering)
-> (PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> PrimExp v)
-> (PrimExp v -> PrimExp v -> PrimExp v)
-> Ord (PrimExp v)
PrimExp v -> PrimExp v -> Bool
PrimExp v -> PrimExp v -> Ordering
PrimExp v -> PrimExp v -> PrimExp v
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
forall v. Ord v => Eq (PrimExp v)
forall v. Ord v => PrimExp v -> PrimExp v -> Bool
forall v. Ord v => PrimExp v -> PrimExp v -> Ordering
forall v. Ord v => PrimExp v -> PrimExp v -> PrimExp v
$ccompare :: forall v. Ord v => PrimExp v -> PrimExp v -> Ordering
compare :: PrimExp v -> PrimExp v -> Ordering
$c< :: forall v. Ord v => PrimExp v -> PrimExp v -> Bool
< :: PrimExp v -> PrimExp v -> Bool
$c<= :: forall v. Ord v => PrimExp v -> PrimExp v -> Bool
<= :: PrimExp v -> PrimExp v -> Bool
$c> :: forall v. Ord v => PrimExp v -> PrimExp v -> Bool
> :: PrimExp v -> PrimExp v -> Bool
$c>= :: forall v. Ord v => PrimExp v -> PrimExp v -> Bool
>= :: PrimExp v -> PrimExp v -> Bool
$cmax :: forall v. Ord v => PrimExp v -> PrimExp v -> PrimExp v
max :: PrimExp v -> PrimExp v -> PrimExp v
$cmin :: forall v. Ord v => PrimExp v -> PrimExp v -> PrimExp v
min :: PrimExp v -> PrimExp v -> PrimExp v
Ord, Int -> PrimExp v -> ShowS
[PrimExp v] -> ShowS
PrimExp v -> String
(Int -> PrimExp v -> ShowS)
-> (PrimExp v -> String)
-> ([PrimExp v] -> ShowS)
-> Show (PrimExp v)
forall v. Show v => Int -> PrimExp v -> ShowS
forall v. Show v => [PrimExp v] -> ShowS
forall v. Show v => PrimExp v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> PrimExp v -> ShowS
showsPrec :: Int -> PrimExp v -> ShowS
$cshow :: forall v. Show v => PrimExp v -> String
show :: PrimExp v -> String
$cshowList :: forall v. Show v => [PrimExp v] -> ShowS
showList :: [PrimExp v] -> ShowS
Show)

instance Functor PrimExp where
  fmap :: forall a b. (a -> b) -> PrimExp a -> PrimExp b
fmap = (a -> b) -> PrimExp a -> PrimExp b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable PrimExp where
  foldMap :: forall m a. Monoid m => (a -> m) -> PrimExp a -> m
foldMap = (a -> m) -> PrimExp a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable PrimExp where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimExp a -> f (PrimExp b)
traverse a -> f b
f (LeafExp a
v PrimType
t) =
    b -> PrimType -> PrimExp b
forall v. v -> PrimType -> PrimExp v
LeafExp (b -> PrimType -> PrimExp b) -> f b -> f (PrimType -> PrimExp b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
v f (PrimType -> PrimExp b) -> f PrimType -> f (PrimExp b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PrimType -> f PrimType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimType
t
  traverse a -> f b
_ (ValueExp PrimValue
v) =
    PrimExp b -> f (PrimExp b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimExp b -> f (PrimExp b)) -> PrimExp b -> f (PrimExp b)
forall a b. (a -> b) -> a -> b
$ PrimValue -> PrimExp b
forall v. PrimValue -> PrimExp v
ValueExp PrimValue
v
  traverse a -> f b
f (BinOpExp BinOp
op PrimExp a
x PrimExp a
y) =
    BinOp -> PrimExp b -> PrimExp b -> PrimExp b
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op (PrimExp b -> PrimExp b -> PrimExp b)
-> f (PrimExp b) -> f (PrimExp b -> PrimExp b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> PrimExp a -> f (PrimExp b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimExp a -> f (PrimExp b)
traverse a -> f b
f PrimExp a
x f (PrimExp b -> PrimExp b) -> f (PrimExp b) -> f (PrimExp b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> PrimExp a -> f (PrimExp b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimExp a -> f (PrimExp b)
traverse a -> f b
f PrimExp a
y
  traverse a -> f b
f (CmpOpExp CmpOp
op PrimExp a
x PrimExp a
y) =
    CmpOp -> PrimExp b -> PrimExp b -> PrimExp b
forall v. CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
CmpOpExp CmpOp
op (PrimExp b -> PrimExp b -> PrimExp b)
-> f (PrimExp b) -> f (PrimExp b -> PrimExp b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> PrimExp a -> f (PrimExp b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimExp a -> f (PrimExp b)
traverse a -> f b
f PrimExp a
x f (PrimExp b -> PrimExp b) -> f (PrimExp b) -> f (PrimExp b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> PrimExp a -> f (PrimExp b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimExp a -> f (PrimExp b)
traverse a -> f b
f PrimExp a
y
  traverse a -> f b
f (ConvOpExp ConvOp
op PrimExp a
x) =
    ConvOp -> PrimExp b -> PrimExp b
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp ConvOp
op (PrimExp b -> PrimExp b) -> f (PrimExp b) -> f (PrimExp b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> PrimExp a -> f (PrimExp b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimExp a -> f (PrimExp b)
traverse a -> f b
f PrimExp a
x
  traverse a -> f b
f (UnOpExp UnOp
op PrimExp a
x) =
    UnOp -> PrimExp b -> PrimExp b
forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp UnOp
op (PrimExp b -> PrimExp b) -> f (PrimExp b) -> f (PrimExp b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> PrimExp a -> f (PrimExp b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimExp a -> f (PrimExp b)
traverse a -> f b
f PrimExp a
x
  traverse a -> f b
f (FunExp Text
h [PrimExp a]
args PrimType
t) =
    Text -> [PrimExp b] -> PrimType -> PrimExp b
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
h ([PrimExp b] -> PrimType -> PrimExp b)
-> f [PrimExp b] -> f (PrimType -> PrimExp b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PrimExp a -> f (PrimExp b)) -> [PrimExp a] -> f [PrimExp b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((a -> f b) -> PrimExp a -> f (PrimExp b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimExp a -> f (PrimExp b)
traverse a -> f b
f) [PrimExp a]
args f (PrimType -> PrimExp b) -> f PrimType -> f (PrimExp b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> PrimType -> f PrimType
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimType
t

instance (FreeIn v) => FreeIn (PrimExp v) where
  freeIn' :: PrimExp v -> FV
freeIn' = (v -> FV) -> PrimExp v -> FV
forall m a. Monoid m => (a -> m) -> PrimExp a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap v -> FV
forall a. FreeIn a => a -> FV
freeIn'

-- | A 'PrimExp' tagged with a phantom type used to provide type-safe
-- construction.  Does not guarantee that the underlying expression is
-- actually type correct.
newtype TPrimExp t v = TPrimExp {forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped :: PrimExp v}
  deriving (TPrimExp t v -> TPrimExp t v -> Bool
(TPrimExp t v -> TPrimExp t v -> Bool)
-> (TPrimExp t v -> TPrimExp t v -> Bool) -> Eq (TPrimExp t v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (t :: k) v. Eq v => TPrimExp t v -> TPrimExp t v -> Bool
$c== :: forall k (t :: k) v. Eq v => TPrimExp t v -> TPrimExp t v -> Bool
== :: TPrimExp t v -> TPrimExp t v -> Bool
$c/= :: forall k (t :: k) v. Eq v => TPrimExp t v -> TPrimExp t v -> Bool
/= :: TPrimExp t v -> TPrimExp t v -> Bool
Eq, Eq (TPrimExp t v)
Eq (TPrimExp t v) =>
(TPrimExp t v -> TPrimExp t v -> Ordering)
-> (TPrimExp t v -> TPrimExp t v -> Bool)
-> (TPrimExp t v -> TPrimExp t v -> Bool)
-> (TPrimExp t v -> TPrimExp t v -> Bool)
-> (TPrimExp t v -> TPrimExp t v -> Bool)
-> (TPrimExp t v -> TPrimExp t v -> TPrimExp t v)
-> (TPrimExp t v -> TPrimExp t v -> TPrimExp t v)
-> Ord (TPrimExp t v)
TPrimExp t v -> TPrimExp t v -> Bool
TPrimExp t v -> TPrimExp t v -> Ordering
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
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
forall k (t :: k) v. Ord v => Eq (TPrimExp t v)
forall k (t :: k) v. Ord v => TPrimExp t v -> TPrimExp t v -> Bool
forall k (t :: k) v.
Ord v =>
TPrimExp t v -> TPrimExp t v -> Ordering
forall k (t :: k) v.
Ord v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
$ccompare :: forall k (t :: k) v.
Ord v =>
TPrimExp t v -> TPrimExp t v -> Ordering
compare :: TPrimExp t v -> TPrimExp t v -> Ordering
$c< :: forall k (t :: k) v. Ord v => TPrimExp t v -> TPrimExp t v -> Bool
< :: TPrimExp t v -> TPrimExp t v -> Bool
$c<= :: forall k (t :: k) v. Ord v => TPrimExp t v -> TPrimExp t v -> Bool
<= :: TPrimExp t v -> TPrimExp t v -> Bool
$c> :: forall k (t :: k) v. Ord v => TPrimExp t v -> TPrimExp t v -> Bool
> :: TPrimExp t v -> TPrimExp t v -> Bool
$c>= :: forall k (t :: k) v. Ord v => TPrimExp t v -> TPrimExp t v -> Bool
>= :: TPrimExp t v -> TPrimExp t v -> Bool
$cmax :: forall k (t :: k) v.
Ord v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
max :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
$cmin :: forall k (t :: k) v.
Ord v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
min :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
Ord, Int -> TPrimExp t v -> ShowS
[TPrimExp t v] -> ShowS
TPrimExp t v -> String
(Int -> TPrimExp t v -> ShowS)
-> (TPrimExp t v -> String)
-> ([TPrimExp t v] -> ShowS)
-> Show (TPrimExp t v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) v. Show v => Int -> TPrimExp t v -> ShowS
forall k (t :: k) v. Show v => [TPrimExp t v] -> ShowS
forall k (t :: k) v. Show v => TPrimExp t v -> String
$cshowsPrec :: forall k (t :: k) v. Show v => Int -> TPrimExp t v -> ShowS
showsPrec :: Int -> TPrimExp t v -> ShowS
$cshow :: forall k (t :: k) v. Show v => TPrimExp t v -> String
show :: TPrimExp t v -> String
$cshowList :: forall k (t :: k) v. Show v => [TPrimExp t v] -> ShowS
showList :: [TPrimExp t v] -> ShowS
Show)

instance Functor (TPrimExp t) where
  fmap :: forall a b. (a -> b) -> TPrimExp t a -> TPrimExp t b
fmap = (a -> b) -> TPrimExp t a -> TPrimExp t b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

instance Foldable (TPrimExp t) where
  foldMap :: forall m a. Monoid m => (a -> m) -> TPrimExp t a -> m
foldMap = (a -> m) -> TPrimExp t a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable (TPrimExp t) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TPrimExp t a -> f (TPrimExp t b)
traverse a -> f b
f (TPrimExp PrimExp a
e) = PrimExp b -> TPrimExp t b
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp b -> TPrimExp t b) -> f (PrimExp b) -> f (TPrimExp t b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> PrimExp a -> f (PrimExp b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PrimExp a -> f (PrimExp b)
traverse a -> f b
f PrimExp a
e

instance (FreeIn v) => FreeIn (TPrimExp t v) where
  freeIn' :: TPrimExp t v -> FV
freeIn' = PrimExp v -> FV
forall a. FreeIn a => a -> FV
freeIn' (PrimExp v -> FV)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> FV
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp t v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

-- | This expression is of type t'Int8'.
isInt8 :: PrimExp v -> TPrimExp Int8 v
isInt8 :: forall v. PrimExp v -> TPrimExp Int8 v
isInt8 = PrimExp v -> TPrimExp Int8 v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Int16'.
isInt16 :: PrimExp v -> TPrimExp Int16 v
isInt16 :: forall v. PrimExp v -> TPrimExp Int16 v
isInt16 = PrimExp v -> TPrimExp Int16 v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Int32'.
isInt32 :: PrimExp v -> TPrimExp Int32 v
isInt32 :: forall v. PrimExp v -> TPrimExp Int32 v
isInt32 = PrimExp v -> TPrimExp Int32 v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Int64'.
isInt64 :: PrimExp v -> TPrimExp Int64 v
isInt64 :: forall v. PrimExp v -> TPrimExp Int64 v
isInt64 = PrimExp v -> TPrimExp Int64 v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This is a boolean expression.
isBool :: PrimExp v -> TPrimExp Bool v
isBool :: forall v. PrimExp v -> TPrimExp Bool v
isBool = PrimExp v -> TPrimExp Bool v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Half'.
isF16 :: PrimExp v -> TPrimExp Half v
isF16 :: forall v. PrimExp v -> TPrimExp Half v
isF16 = PrimExp v -> TPrimExp Half v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Float'.
isF32 :: PrimExp v -> TPrimExp Float v
isF32 :: forall v. PrimExp v -> TPrimExp Float v
isF32 = PrimExp v -> TPrimExp Float v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Double'.
isF64 :: PrimExp v -> TPrimExp Double v
isF64 :: forall v. PrimExp v -> TPrimExp Double v
isF64 = PrimExp v -> TPrimExp Double v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp

-- | True if the 'PrimExp' has at least this many nodes.  This can be
-- much more efficient than comparing with 'length' for large
-- 'PrimExp's, as this function is lazy.
primExpSizeAtLeast :: Int -> PrimExp v -> Bool
primExpSizeAtLeast :: forall v. Int -> PrimExp v -> Bool
primExpSizeAtLeast Int
k = Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k) (Maybe Int -> Bool)
-> (PrimExp v -> Maybe Int) -> PrimExp v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> PrimExp v -> Maybe Int
forall {v}. Int -> PrimExp v -> Maybe Int
descend Int
0
  where
    descend :: Int -> PrimExp v -> Maybe Int
descend Int
i PrimExp v
_
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k = Maybe Int
forall a. Maybe a
Nothing
    descend Int
i LeafExp {} = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    descend Int
i ValueExp {} = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    descend Int
i (BinOpExp BinOp
_ PrimExp v
x PrimExp v
y) = do
      Int
x' <- Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PrimExp v
x
      Int -> PrimExp v -> Maybe Int
descend Int
x' PrimExp v
y
    descend Int
i (CmpOpExp CmpOp
_ PrimExp v
x PrimExp v
y) = do
      Int
x' <- Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PrimExp v
x
      Int -> PrimExp v -> Maybe Int
descend Int
x' PrimExp v
y
    descend Int
i (ConvOpExp ConvOp
_ PrimExp v
x) = Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PrimExp v
x
    descend Int
i (UnOpExp UnOp
_ PrimExp v
x) = Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PrimExp v
x
    descend Int
i (FunExp Text
_ [PrimExp v]
args PrimType
_) = (Int -> PrimExp v -> Maybe Int) -> Int -> [PrimExp v] -> Maybe Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [PrimExp v]
args

-- | Perform quick and dirty constant folding on the top level of a
-- PrimExp.  This is necessary because we want to consider
-- e.g. equality modulo constant folding.
constFoldPrimExp :: PrimExp v -> PrimExp v
constFoldPrimExp :: forall v. PrimExp v -> PrimExp v
constFoldPrimExp (BinOpExp Add {} PrimExp v
x PrimExp v
y)
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
x = PrimExp v
y
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (BinOpExp Sub {} PrimExp v
x PrimExp v
y)
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (BinOpExp Mul {} PrimExp v
x PrimExp v
y)
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
x = PrimExp v
y
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
x
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
x,
    IntType IntType
it <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
y =
      PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
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
it (Int
0 :: Int)
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y,
    IntType IntType
it <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x =
      PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
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
it (Int
0 :: Int)
constFoldPrimExp (BinOpExp SDiv {} PrimExp v
x PrimExp v
y)
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (BinOpExp SQuot {} PrimExp v
x PrimExp v
y)
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (BinOpExp UDiv {} PrimExp v
x PrimExp v
y)
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (BinOpExp BinOp
bop (ValueExp PrimValue
x) (ValueExp PrimValue
y))
  | Just PrimValue
z <- BinOp -> PrimValue -> PrimValue -> Maybe PrimValue
doBinOp BinOp
bop PrimValue
x PrimValue
y =
      PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp PrimValue
z
constFoldPrimExp (BinOpExp BinOp
LogAnd PrimExp v
x PrimExp v
y)
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
x = PrimExp v
y
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
x
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
x = PrimExp v
x
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y = PrimExp v
y
constFoldPrimExp (BinOpExp BinOp
LogOr PrimExp v
x PrimExp v
y)
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
x = PrimExp v
x
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
y
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
x = PrimExp v
y
  | PrimExp v -> Bool
forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (UnOpExp Abs {} PrimExp v
x)
  | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PrimExp v -> Bool
forall a. PrimExp a -> Bool
negativeIshExp PrimExp v
x = PrimExp v
x
constFoldPrimExp (UnOpExp (Neg PrimType
_) (ValueExp (BoolValue Bool
x))) =
  PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
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
x
constFoldPrimExp (BinOpExp UMod {} PrimExp v
x PrimExp v
y)
  | PrimExp v -> PrimExp v -> Bool
forall v. PrimExp v -> PrimExp v -> Bool
sameIshExp PrimExp v
x PrimExp v
y,
    IntType IntType
it <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x =
      PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
it (Integer
0 :: Integer)
constFoldPrimExp (BinOpExp SMod {} PrimExp v
x PrimExp v
y)
  | PrimExp v -> PrimExp v -> Bool
forall v. PrimExp v -> PrimExp v -> Bool
sameIshExp PrimExp v
x PrimExp v
y,
    IntType IntType
it <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x =
      PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
it (Integer
0 :: Integer)
constFoldPrimExp (BinOpExp SRem {} PrimExp v
x PrimExp v
y)
  | PrimExp v -> PrimExp v -> Bool
forall v. PrimExp v -> PrimExp v -> Bool
sameIshExp PrimExp v
x PrimExp v
y,
    IntType IntType
it <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x =
      PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntType -> Integer -> IntValue
forall int. Integral int => IntType -> int -> IntValue
intValue IntType
it (Integer
0 :: Integer)
constFoldPrimExp PrimExp v
e = PrimExp v
e

constFoldCmpExp :: (Eq v) => PrimExp v -> PrimExp v
constFoldCmpExp :: forall v. Eq v => PrimExp v -> PrimExp v
constFoldCmpExp (CmpOpExp (CmpEq PrimType
_) PrimExp v
x PrimExp v
y)
  | PrimExp v
x PrimExp v -> PrimExp v -> Bool
forall a. Eq a => a -> a -> Bool
== PrimExp v
y =
      TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Bool v
forall v. TPrimExp Bool v
true
constFoldCmpExp (CmpOpExp (CmpEq PrimType
_) (ValueExp PrimValue
x) (ValueExp PrimValue
y))
  | PrimValue
x PrimValue -> PrimValue -> Bool
forall a. Eq a => a -> a -> Bool
/= PrimValue
y =
      TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Bool v
forall v. TPrimExp Bool v
false
constFoldCmpExp PrimExp v
e = PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
e

-- | The class of numeric types that can be used for constructing
-- 'TPrimExp's.
class NumExp t where
  -- | Construct a typed expression from an integer.
  fromInteger' :: Integer -> TPrimExp t v

  -- | Construct a numeric expression from a boolean expression.  This
  -- can be used to encode arithmetic control flow.
  fromBoolExp :: TPrimExp Bool v -> TPrimExp t v

-- | The class of integer types that can be used for constructing
-- 'TPrimExp's.
class (NumExp t) => IntExp t where
  -- | The type of an expression, known to be an integer type.
  expIntType :: TPrimExp t v -> IntType

instance NumExp Int8 where
  fromInteger' :: forall v. Integer -> TPrimExp Int8 v
fromInteger' = PrimExp v -> TPrimExp Int8 v
forall v. PrimExp v -> TPrimExp Int8 v
isInt8 (PrimExp v -> TPrimExp Int8 v)
-> (Integer -> PrimExp v) -> Integer -> TPrimExp Int8 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Integer -> PrimValue) -> Integer -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Integer -> IntValue) -> Integer -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int8 -> IntValue
Int8Value (Int8 -> IntValue) -> (Integer -> Int8) -> Integer -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Int8
forall a. Num a => Integer -> a
fromInteger
  fromBoolExp :: forall v. TPrimExp Bool v -> TPrimExp Int8 v
fromBoolExp = PrimExp v -> TPrimExp Int8 v
forall v. PrimExp v -> TPrimExp Int8 v
isInt8 (PrimExp v -> TPrimExp Int8 v)
-> (TPrimExp Bool v -> PrimExp v)
-> TPrimExp Bool v
-> TPrimExp Int8 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> ConvOp
BToI IntType
Int8) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

instance IntExp Int8 where
  expIntType :: forall v. TPrimExp Int8 v -> IntType
expIntType = IntType -> TPrimExp Int8 v -> IntType
forall a b. a -> b -> a
const IntType
Int8

instance NumExp Int16 where
  fromInteger' :: forall v. Integer -> TPrimExp Int16 v
fromInteger' = PrimExp v -> TPrimExp Int16 v
forall v. PrimExp v -> TPrimExp Int16 v
isInt16 (PrimExp v -> TPrimExp Int16 v)
-> (Integer -> PrimExp v) -> Integer -> TPrimExp Int16 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Integer -> PrimValue) -> Integer -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Integer -> IntValue) -> Integer -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int16 -> IntValue
Int16Value (Int16 -> IntValue) -> (Integer -> Int16) -> Integer -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Int16
forall a. Num a => Integer -> a
fromInteger
  fromBoolExp :: forall v. TPrimExp Bool v -> TPrimExp Int16 v
fromBoolExp = PrimExp v -> TPrimExp Int16 v
forall v. PrimExp v -> TPrimExp Int16 v
isInt16 (PrimExp v -> TPrimExp Int16 v)
-> (TPrimExp Bool v -> PrimExp v)
-> TPrimExp Bool v
-> TPrimExp Int16 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> ConvOp
BToI IntType
Int16) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

instance IntExp Int16 where
  expIntType :: forall v. TPrimExp Int16 v -> IntType
expIntType = IntType -> TPrimExp Int16 v -> IntType
forall a b. a -> b -> a
const IntType
Int16

instance NumExp Int32 where
  fromInteger' :: forall v. Integer -> TPrimExp Int32 v
fromInteger' = PrimExp v -> TPrimExp Int32 v
forall v. PrimExp v -> TPrimExp Int32 v
isInt32 (PrimExp v -> TPrimExp Int32 v)
-> (Integer -> PrimExp v) -> Integer -> TPrimExp Int32 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Integer -> PrimValue) -> Integer -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Integer -> IntValue) -> Integer -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int32 -> IntValue
Int32Value (Int32 -> IntValue) -> (Integer -> Int32) -> Integer -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Int32
forall a. Num a => Integer -> a
fromInteger
  fromBoolExp :: forall v. TPrimExp Bool v -> TPrimExp Int32 v
fromBoolExp = PrimExp v -> TPrimExp Int32 v
forall v. PrimExp v -> TPrimExp Int32 v
isInt32 (PrimExp v -> TPrimExp Int32 v)
-> (TPrimExp Bool v -> PrimExp v)
-> TPrimExp Bool v
-> TPrimExp Int32 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> ConvOp
BToI IntType
Int32) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

instance IntExp Int32 where
  expIntType :: forall v. TPrimExp Int32 v -> IntType
expIntType = IntType -> TPrimExp Int32 v -> IntType
forall a b. a -> b -> a
const IntType
Int32

instance NumExp Int64 where
  fromInteger' :: forall v. Integer -> TPrimExp Int64 v
fromInteger' = PrimExp v -> TPrimExp Int64 v
forall v. PrimExp v -> TPrimExp Int64 v
isInt64 (PrimExp v -> TPrimExp Int64 v)
-> (Integer -> PrimExp v) -> Integer -> TPrimExp Int64 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Integer -> PrimValue) -> Integer -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntValue -> PrimValue
IntValue (IntValue -> PrimValue)
-> (Integer -> IntValue) -> Integer -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int64 -> IntValue
Int64Value (Int64 -> IntValue) -> (Integer -> Int64) -> Integer -> IntValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Int64
forall a. Num a => Integer -> a
fromInteger
  fromBoolExp :: forall v. TPrimExp Bool v -> TPrimExp Int64 v
fromBoolExp = PrimExp v -> TPrimExp Int64 v
forall v. PrimExp v -> TPrimExp Int64 v
isInt64 (PrimExp v -> TPrimExp Int64 v)
-> (TPrimExp Bool v -> PrimExp v)
-> TPrimExp Bool v
-> TPrimExp Int64 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> ConvOp
BToI IntType
Int64) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

instance IntExp Int64 where
  expIntType :: forall v. TPrimExp Int64 v -> IntType
expIntType = IntType -> TPrimExp Int64 v -> IntType
forall a b. a -> b -> a
const IntType
Int64

-- | The class of floating-point types that can be used for
-- constructing 'TPrimExp's.
class (NumExp t) => FloatExp t where
  -- | Construct a typed expression from a rational.
  fromRational' :: Rational -> TPrimExp t v

  -- | The type of an expression, known to be a floating-point type.
  expFloatType :: TPrimExp t v -> FloatType

instance NumExp Half where
  fromInteger' :: forall v. Integer -> TPrimExp Half v
fromInteger' = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v)
-> (Integer -> PrimExp v) -> Integer -> TPrimExp Half v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Integer -> PrimValue) -> Integer -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Integer -> FloatValue) -> Integer -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Half -> FloatValue
Float16Value (Half -> FloatValue) -> (Integer -> Half) -> Integer -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Half
forall a. Num a => Integer -> a
fromInteger
  fromBoolExp :: forall v. TPrimExp Bool v -> TPrimExp Half v
fromBoolExp = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v)
-> (TPrimExp Bool v -> PrimExp v)
-> TPrimExp Bool v
-> TPrimExp Half v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> FloatType -> ConvOp
SIToFP IntType
Int16 FloatType
Float16) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> ConvOp
BToI IntType
Int16) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

instance NumExp Float where
  fromInteger' :: forall v. Integer -> TPrimExp Float v
fromInteger' = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v)
-> (Integer -> PrimExp v) -> Integer -> TPrimExp Float v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Integer -> PrimValue) -> Integer -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Integer -> FloatValue) -> Integer -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Float -> FloatValue
Float32Value (Float -> FloatValue)
-> (Integer -> Float) -> Integer -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Float
forall a. Num a => Integer -> a
fromInteger
  fromBoolExp :: forall v. TPrimExp Bool v -> TPrimExp Float v
fromBoolExp = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v)
-> (TPrimExp Bool v -> PrimExp v)
-> TPrimExp Bool v
-> TPrimExp Float v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> FloatType -> ConvOp
SIToFP IntType
Int32 FloatType
Float32) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> ConvOp
BToI IntType
Int32) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

instance NumExp Double where
  fromInteger' :: forall v. Integer -> TPrimExp Double v
fromInteger' = PrimExp v -> TPrimExp Double v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Double v)
-> (Integer -> PrimExp v) -> Integer -> TPrimExp Double v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Integer -> PrimValue) -> Integer -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Integer -> FloatValue) -> Integer -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> FloatValue
Float64Value (Double -> FloatValue)
-> (Integer -> Double) -> Integer -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Double
forall a. Num a => Integer -> a
fromInteger
  fromBoolExp :: forall v. TPrimExp Bool v -> TPrimExp Double v
fromBoolExp = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v)
-> (TPrimExp Bool v -> PrimExp v)
-> TPrimExp Bool v
-> TPrimExp Double v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> FloatType -> ConvOp
SIToFP IntType
Int32 FloatType
Float64) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> ConvOp
BToI IntType
Int32) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

instance FloatExp Half where
  fromRational' :: forall v. Rational -> TPrimExp Half v
fromRational' = PrimExp v -> TPrimExp Half v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Half v)
-> (Rational -> PrimExp v) -> Rational -> TPrimExp Half v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Rational -> PrimValue) -> Rational -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Rational -> FloatValue) -> Rational -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Half -> FloatValue
Float16Value (Half -> FloatValue)
-> (Rational -> Half) -> Rational -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Half
forall a. Fractional a => Rational -> a
fromRational
  expFloatType :: forall v. TPrimExp Half v -> FloatType
expFloatType = FloatType -> TPrimExp Half v -> FloatType
forall a b. a -> b -> a
const FloatType
Float16

instance FloatExp Float where
  fromRational' :: forall v. Rational -> TPrimExp Float v
fromRational' = PrimExp v -> TPrimExp Float v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Float v)
-> (Rational -> PrimExp v) -> Rational -> TPrimExp Float v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Rational -> PrimValue) -> Rational -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Rational -> FloatValue) -> Rational -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Float -> FloatValue
Float32Value (Float -> FloatValue)
-> (Rational -> Float) -> Rational -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Float
forall a. Fractional a => Rational -> a
fromRational
  expFloatType :: forall v. TPrimExp Float v -> FloatType
expFloatType = FloatType -> TPrimExp Float v -> FloatType
forall a b. a -> b -> a
const FloatType
Float32

instance FloatExp Double where
  fromRational' :: forall v. Rational -> TPrimExp Double v
fromRational' = PrimExp v -> TPrimExp Double v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Double v)
-> (Rational -> PrimExp v) -> Rational -> TPrimExp Double v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v)
-> (Rational -> PrimValue) -> Rational -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue)
-> (Rational -> FloatValue) -> Rational -> PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> FloatValue
Float64Value (Double -> FloatValue)
-> (Rational -> Double) -> Rational -> FloatValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rational -> Double
forall a. Fractional a => Rational -> a
fromRational
  expFloatType :: forall v. TPrimExp Double v -> FloatType
expFloatType = FloatType -> TPrimExp Double v -> FloatType
forall a b. a -> b -> a
const FloatType
Float64

instance (NumExp t, Pretty v) => Num (TPrimExp t v) where
  TPrimExp PrimExp v
x + :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
+ TPrimExp PrimExp v
y
    | Just PrimExp v
z <-
        [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ (IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Overflow -> BinOp
`Add` Overflow
OverflowUndef) PrimExp v
x PrimExp v
y,
            (FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FAdd PrimExp v
x PrimExp v
y
          ] =
        PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"+" (PrimExp v
x, PrimExp v
y)

  TPrimExp PrimExp v
x - :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
- TPrimExp PrimExp v
y
    | Just PrimExp v
z <-
        [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ (IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Overflow -> BinOp
`Sub` Overflow
OverflowUndef) PrimExp v
x PrimExp v
y,
            (FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FSub PrimExp v
x PrimExp v
y
          ] =
        PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"-" (PrimExp v
x, PrimExp v
y)

  TPrimExp PrimExp v
x * :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
* TPrimExp PrimExp v
y
    | Just PrimExp v
z <-
        [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ (IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Overflow -> BinOp
`Mul` Overflow
OverflowUndef) PrimExp v
x PrimExp v
y,
            (FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FMul PrimExp v
x PrimExp v
y
          ] =
        PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"*" (PrimExp v
x, PrimExp v
y)

  abs :: TPrimExp t v -> TPrimExp t v
abs (TPrimExp PrimExp v
x)
    | IntType IntType
t <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp (PrimExp v -> PrimExp v) -> PrimExp v -> PrimExp v
forall a b. (a -> b) -> a -> b
$ UnOp -> PrimExp v -> PrimExp v
forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp (IntType -> UnOp
Abs IntType
t) PrimExp v
x
    | FloatType FloatType
t <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp (PrimExp v -> PrimExp v) -> PrimExp v -> PrimExp v
forall a b. (a -> b) -> a -> b
$ UnOp -> PrimExp v -> PrimExp v
forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp (FloatType -> UnOp
FAbs FloatType
t) PrimExp v
x
    | Bool
otherwise = String -> PrimExp v -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"abs" PrimExp v
x

  signum :: TPrimExp t v -> TPrimExp t v
signum (TPrimExp PrimExp v
x)
    | IntType IntType
t <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ UnOp -> PrimExp v -> PrimExp v
forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp (IntType -> UnOp
SSignum IntType
t) PrimExp v
x
    | Bool
otherwise = String -> PrimExp v -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"signum" PrimExp v
x

  fromInteger :: Integer -> TPrimExp t v
fromInteger = Integer -> TPrimExp t v
forall v. Integer -> TPrimExp t v
forall {k} (t :: k) v. NumExp t => Integer -> TPrimExp t v
fromInteger'

instance (FloatExp t, Pretty v) => Fractional (TPrimExp t v) where
  TPrimExp PrimExp v
x / :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
/ TPrimExp PrimExp v
y
    | Just PrimExp v
z <- [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FDiv PrimExp v
x PrimExp v
y] = PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"/" (PrimExp v
x, PrimExp v
y)

  fromRational :: Rational -> TPrimExp t v
fromRational = Rational -> TPrimExp t v
forall v. Rational -> TPrimExp t v
forall {k} (t :: k) v. FloatExp t => Rational -> TPrimExp t v
fromRational'

instance (Pretty v) => Floating (TPrimExp Half v) where
  TPrimExp Half v
x ** :: TPrimExp Half v -> TPrimExp Half v -> TPrimExp Half v
** TPrimExp Half v
y = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FPow FloatType
Float16) (TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x) (TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
y)
  pi :: TPrimExp Half v
pi = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue (FloatValue -> PrimValue) -> FloatValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ Half -> FloatValue
Float16Value Half
forall a. Floating a => a
pi
  exp :: TPrimExp Half v -> TPrimExp Half v
exp TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"exp16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  log :: TPrimExp Half v -> TPrimExp Half v
log TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"log16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  sin :: TPrimExp Half v -> TPrimExp Half v
sin TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"sin16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  cos :: TPrimExp Half v -> TPrimExp Half v
cos TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"cos16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  tan :: TPrimExp Half v -> TPrimExp Half v
tan TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"tan16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  asin :: TPrimExp Half v -> TPrimExp Half v
asin TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"asin16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  acos :: TPrimExp Half v -> TPrimExp Half v
acos TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"acos16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  atan :: TPrimExp Half v -> TPrimExp Half v
atan TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"atan16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  sinh :: TPrimExp Half v -> TPrimExp Half v
sinh TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"sinh16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  cosh :: TPrimExp Half v -> TPrimExp Half v
cosh TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"cosh16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  tanh :: TPrimExp Half v -> TPrimExp Half v
tanh TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"tanh16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  asinh :: TPrimExp Half v -> TPrimExp Half v
asinh TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"asinh16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  acosh :: TPrimExp Half v -> TPrimExp Half v
acosh TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"acosh16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  atanh :: TPrimExp Half v -> TPrimExp Half v
atanh TPrimExp Half v
x = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"atanh16" [TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16

instance (Pretty v) => Floating (TPrimExp Float v) where
  TPrimExp Float v
x ** :: TPrimExp Float v -> TPrimExp Float v -> TPrimExp Float v
** TPrimExp Float v
y = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FPow FloatType
Float32) (TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x) (TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
y)
  pi :: TPrimExp Float v
pi = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
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
forall a. Floating a => a
pi
  exp :: TPrimExp Float v -> TPrimExp Float v
exp TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"exp32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  log :: TPrimExp Float v -> TPrimExp Float v
log TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"log32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  sin :: TPrimExp Float v -> TPrimExp Float v
sin TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"sin32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  cos :: TPrimExp Float v -> TPrimExp Float v
cos TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"cos32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  tan :: TPrimExp Float v -> TPrimExp Float v
tan TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"tan32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  asin :: TPrimExp Float v -> TPrimExp Float v
asin TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"asin32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  acos :: TPrimExp Float v -> TPrimExp Float v
acos TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"acos32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  atan :: TPrimExp Float v -> TPrimExp Float v
atan TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"atan32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  sinh :: TPrimExp Float v -> TPrimExp Float v
sinh TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"sinh32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  cosh :: TPrimExp Float v -> TPrimExp Float v
cosh TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"cosh32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  tanh :: TPrimExp Float v -> TPrimExp Float v
tanh TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"tanh32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  asinh :: TPrimExp Float v -> TPrimExp Float v
asinh TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"asinh32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  acosh :: TPrimExp Float v -> TPrimExp Float v
acosh TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"acosh32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  atanh :: TPrimExp Float v -> TPrimExp Float v
atanh TPrimExp Float v
x = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"atanh32" [TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32

instance (Pretty v) => Floating (TPrimExp Double v) where
  TPrimExp Double v
x ** :: TPrimExp Double v -> TPrimExp Double v -> TPrimExp Double v
** TPrimExp Double v
y = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FPow FloatType
Float64) (TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x) (TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
y)
  pi :: TPrimExp Double v
pi = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
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
forall a. Floating a => a
pi
  exp :: TPrimExp Double v -> TPrimExp Double v
exp TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"exp64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  log :: TPrimExp Double v -> TPrimExp Double v
log TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"log64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  sin :: TPrimExp Double v -> TPrimExp Double v
sin TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"sin64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  cos :: TPrimExp Double v -> TPrimExp Double v
cos TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"cos64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  tan :: TPrimExp Double v -> TPrimExp Double v
tan TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"tan64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  asin :: TPrimExp Double v -> TPrimExp Double v
asin TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"asin64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  acos :: TPrimExp Double v -> TPrimExp Double v
acos TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"acos64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  atan :: TPrimExp Double v -> TPrimExp Double v
atan TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"atan64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  sinh :: TPrimExp Double v -> TPrimExp Double v
sinh TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"sinh64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  cosh :: TPrimExp Double v -> TPrimExp Double v
cosh TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"cosh64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  tanh :: TPrimExp Double v -> TPrimExp Double v
tanh TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"tanh64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  asinh :: TPrimExp Double v -> TPrimExp Double v
asinh TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"asinh64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  acosh :: TPrimExp Double v -> TPrimExp Double v
acosh TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"acosh64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  atanh :: TPrimExp Double v -> TPrimExp Double v
atanh TPrimExp Double v
x = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp Text
"atanh64" [TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] (PrimType -> PrimExp v) -> PrimType -> PrimExp v
forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64

instance (IntExp t, Pretty v) => IntegralExp (TPrimExp t v) where
  TPrimExp PrimExp v
x div :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
`div` TPrimExp PrimExp v
y
    | Just PrimExp v
z <-
        [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ (IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SDiv` Safety
Unsafe) PrimExp v
x PrimExp v
y,
            (FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FDiv PrimExp v
x PrimExp v
y
          ] =
        PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"div" (PrimExp v
x, PrimExp v
y)

  TPrimExp PrimExp v
x mod :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
`mod` TPrimExp PrimExp v
y
    | Just PrimExp v
z <- [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SMod` Safety
Unsafe) PrimExp v
x PrimExp v
y] =
        PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"mod" (PrimExp v
x, PrimExp v
y)

  TPrimExp PrimExp v
x quot :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
`quot` TPrimExp PrimExp v
y
    | PrimExp v -> Bool
forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp PrimExp v
x
    | Just PrimExp v
z <- [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SQuot` Safety
Unsafe) PrimExp v
x PrimExp v
y] =
        PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"quot" (PrimExp v
x, PrimExp v
y)

  TPrimExp PrimExp v
x rem :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
`rem` TPrimExp PrimExp v
y
    | Just PrimExp v
z <- [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SRem` Safety
Unsafe) PrimExp v
x PrimExp v
y] =
        PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"rem" (PrimExp v
x, PrimExp v
y)

  TPrimExp PrimExp v
x divUp :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
`divUp` TPrimExp PrimExp v
y
    | Just PrimExp v
z <- [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SDivUp` Safety
Unsafe) PrimExp v
x PrimExp v
y] =
        PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"divRoundingUp" (PrimExp v
x, PrimExp v
y)

  TPrimExp PrimExp v
x pow :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
`pow` TPrimExp PrimExp v
y
    | Just PrimExp v
z <-
        [Maybe (PrimExp v)] -> Maybe (PrimExp v)
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ (IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp IntType -> BinOp
Pow PrimExp v
x PrimExp v
y,
            (FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FPow PrimExp v
x PrimExp v
y
          ] =
        PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = String -> (PrimExp v, PrimExp v) -> TPrimExp t v
forall a b. Pretty a => String -> a -> b
numBad String
"pow" (PrimExp v
x, PrimExp v
y)

  sgn :: TPrimExp t v -> Maybe Int
sgn (TPrimExp (ValueExp (IntValue IntValue
i))) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
signum (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ IntValue -> Int
forall int. Integral int => IntValue -> int
valueIntegral IntValue
i
  sgn TPrimExp t v
_ = Maybe Int
forall a. Maybe a
Nothing

-- | Lifted logical conjunction.
(.&&.) :: (Eq v) => TPrimExp Bool v -> TPrimExp Bool v -> TPrimExp Bool v
TPrimExp PrimExp v
x .&&. :: forall v.
Eq v =>
TPrimExp Bool v -> TPrimExp Bool v -> TPrimExp Bool v
.&&. TPrimExp PrimExp v
y = PrimExp v -> TPrimExp Bool v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Bool v) -> PrimExp v -> TPrimExp Bool v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp (PrimExp v -> PrimExp v) -> PrimExp v -> PrimExp v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
LogAnd PrimExp v
x PrimExp v
y

-- | Lifted logical conjunction.
(.||.) :: (Eq v) => TPrimExp Bool v -> TPrimExp Bool v -> TPrimExp Bool v
TPrimExp PrimExp v
x .||. :: forall v.
Eq v =>
TPrimExp Bool v -> TPrimExp Bool v -> TPrimExp Bool v
.||. TPrimExp PrimExp v
y = PrimExp v -> TPrimExp Bool v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Bool v) -> PrimExp v -> TPrimExp Bool v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp (PrimExp v -> PrimExp v) -> PrimExp v -> PrimExp v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
LogOr PrimExp v
x PrimExp v
y

-- | Lifted relational operators; assuming signed numbers in case of
-- integers.
(.<.), (.>.), (.<=.), (.>=.), (.==.) :: (Eq v) => TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
TPrimExp PrimExp v
x .<. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
.<. TPrimExp PrimExp v
y =
  PrimExp v -> TPrimExp Bool v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Bool v) -> PrimExp v -> TPrimExp Bool v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. Eq v => PrimExp v -> PrimExp v
constFoldCmpExp (PrimExp v -> PrimExp v) -> PrimExp v -> PrimExp v
forall a b. (a -> b) -> a -> b
$ CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
CmpOpExp CmpOp
cmp PrimExp v
x PrimExp v
y
  where
    cmp :: CmpOp
cmp = case PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x of
      IntType IntType
t -> IntType -> CmpOp
CmpSlt IntType
t
      FloatType FloatType
t -> FloatType -> CmpOp
FCmpLt FloatType
t
      PrimType
_ -> CmpOp
CmpLlt
TPrimExp PrimExp v
x .<=. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
.<=. TPrimExp PrimExp v
y =
  PrimExp v -> TPrimExp Bool v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Bool v) -> PrimExp v -> TPrimExp Bool v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. Eq v => PrimExp v -> PrimExp v
constFoldCmpExp (PrimExp v -> PrimExp v) -> PrimExp v -> PrimExp v
forall a b. (a -> b) -> a -> b
$ CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
CmpOpExp CmpOp
cmp PrimExp v
x PrimExp v
y
  where
    cmp :: CmpOp
cmp = case PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x of
      IntType IntType
t -> IntType -> CmpOp
CmpSle IntType
t
      FloatType FloatType
t -> FloatType -> CmpOp
FCmpLe FloatType
t
      PrimType
_ -> CmpOp
CmpLle
TPrimExp PrimExp v
x .==. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
.==. TPrimExp PrimExp v
y =
  PrimExp v -> TPrimExp Bool v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Bool v) -> PrimExp v -> TPrimExp Bool v
forall a b. (a -> b) -> a -> b
$ PrimExp v -> PrimExp v
forall v. Eq v => PrimExp v -> PrimExp v
constFoldCmpExp (PrimExp v -> PrimExp v) -> PrimExp v -> PrimExp v
forall a b. (a -> b) -> a -> b
$ CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
CmpOpExp (PrimType -> CmpOp
CmpEq PrimType
t) PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x PrimType -> PrimType -> PrimType
forall a. Ord a => a -> a -> a
`min` PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
y
TPrimExp t v
x .>. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
.>. TPrimExp t v
y = TPrimExp t v
y TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
.<. TPrimExp t v
x
TPrimExp t v
x .>=. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
.>=. TPrimExp t v
y = TPrimExp t v
y TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp Bool v
.<=. TPrimExp t v
x

-- | Lifted bitwise operators.  The right-shift is logical, *not* arithmetic.
(.&.), (.|.), (.^.), (.>>.), (.<<.) :: (Eq v) => TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp :: (Eq v) => (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp :: forall {k} v (t :: k).
Eq v =>
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
op (TPrimExp PrimExp v
x) (TPrimExp PrimExp v
y) =
  PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$
    PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp (PrimExp v -> PrimExp v) -> PrimExp v -> PrimExp v
forall a b. (a -> b) -> a -> b
$
      BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
op (IntType -> BinOp) -> IntType -> BinOp
forall a b. (a -> b) -> a -> b
$ PrimExp v -> IntType
forall v. PrimExp v -> IntType
primExpIntType PrimExp v
x) PrimExp v
x PrimExp v
y
.&. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.&.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall {k} v (t :: k).
Eq v =>
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
And
.|. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.|.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall {k} v (t :: k).
Eq v =>
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
Or
.^. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.^.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall {k} v (t :: k).
Eq v =>
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
Xor
.>>. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.>>.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall {k} v (t :: k).
Eq v =>
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
LShr
.<<. :: forall {k} v (t :: k).
Eq v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.<<.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall {k} v (t :: k).
Eq v =>
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
Shl

infix 4 .==., .<., .>., .<=., .>=.

infixr 3 .&&.

infixr 2 .||.

-- | Untyped smart constructor for sign extension that does a bit of
-- constant folding.
sExt :: IntType -> PrimExp v -> PrimExp v
sExt :: forall v. IntType -> PrimExp v -> PrimExp v
sExt IntType
it (ValueExp (IntValue IntValue
v)) = PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
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
it
sExt IntType
it PrimExp v
e
  | PrimExp v -> IntType
forall v. PrimExp v -> IntType
primExpIntType PrimExp v
e IntType -> IntType -> Bool
forall a. Eq a => a -> a -> Bool
== IntType
it = PrimExp v
e
  | Bool
otherwise = ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> IntType -> ConvOp
SExt (PrimExp v -> IntType
forall v. PrimExp v -> IntType
primExpIntType PrimExp v
e) IntType
it) PrimExp v
e

-- | Untyped smart constructor for zero extension that does a bit of
-- constant folding.
zExt :: IntType -> PrimExp v -> PrimExp v
zExt :: forall v. IntType -> PrimExp v -> PrimExp v
zExt IntType
it (ValueExp (IntValue IntValue
v)) = PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
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
it
zExt IntType
it PrimExp v
e
  | PrimExp v -> IntType
forall v. PrimExp v -> IntType
primExpIntType PrimExp v
e IntType -> IntType -> Bool
forall a. Eq a => a -> a -> Bool
== IntType
it = PrimExp v
e
  | Bool
otherwise = ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> IntType -> ConvOp
ZExt (PrimExp v -> IntType
forall v. PrimExp v -> IntType
primExpIntType PrimExp v
e) IntType
it) PrimExp v
e

asIntOp :: (IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp :: forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp IntType -> BinOp
f PrimExp v
x PrimExp v
y
  | IntType IntType
x_t <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = PrimExp v -> Maybe (PrimExp v)
forall a. a -> Maybe a
Just (PrimExp v -> Maybe (PrimExp v)) -> PrimExp v -> Maybe (PrimExp v)
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
f IntType
x_t) PrimExp v
x PrimExp v
y
  | Bool
otherwise = Maybe (PrimExp v)
forall a. Maybe a
Nothing

asFloatOp :: (FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp :: forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
f PrimExp v
x PrimExp v
y
  | FloatType FloatType
t <- PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = PrimExp v -> Maybe (PrimExp v)
forall a. a -> Maybe a
Just (PrimExp v -> Maybe (PrimExp v)) -> PrimExp v -> Maybe (PrimExp v)
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
f FloatType
t) PrimExp v
x PrimExp v
y
  | Bool
otherwise = Maybe (PrimExp v)
forall a. Maybe a
Nothing

numBad :: (Pretty a) => String -> a -> b
numBad :: forall a b. Pretty a => String -> a -> b
numBad String
s a
x =
  String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"Invalid argument to PrimExp method " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
prettyString a
x

-- | Evaluate a 'PrimExp' in the given monad.  Invokes 'fail' on type
-- errors.
evalPrimExp :: (Pretty v, MonadFail m) => (v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp :: forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f (LeafExp v
v PrimType
_) = v -> m PrimValue
f v
v
evalPrimExp v -> m PrimValue
_ (ValueExp PrimValue
v) = PrimValue -> m PrimValue
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PrimValue
v
evalPrimExp v -> m PrimValue
f (BinOpExp BinOp
op PrimExp v
x PrimExp v
y) = do
  PrimValue
x' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  PrimValue
y' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
y
  m PrimValue
-> (PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BinOp -> (PrimExp v, PrimExp v) -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad BinOp
op (PrimExp v
x, PrimExp v
y)) PrimValue -> m PrimValue
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimValue -> PrimValue -> Maybe PrimValue
doBinOp BinOp
op PrimValue
x' PrimValue
y'
evalPrimExp v -> m PrimValue
f (CmpOpExp CmpOp
op PrimExp v
x PrimExp v
y) = do
  PrimValue
x' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  PrimValue
y' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
y
  m PrimValue -> (Bool -> m PrimValue) -> Maybe Bool -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CmpOp -> (PrimExp v, PrimExp v) -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad CmpOp
op (PrimExp v
x, PrimExp v
y)) (PrimValue -> m PrimValue
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimValue -> m PrimValue)
-> (Bool -> PrimValue) -> Bool -> m PrimValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bool -> PrimValue
BoolValue) (Maybe Bool -> m PrimValue) -> Maybe Bool -> m PrimValue
forall a b. (a -> b) -> a -> b
$ CmpOp -> PrimValue -> PrimValue -> Maybe Bool
doCmpOp CmpOp
op PrimValue
x' PrimValue
y'
evalPrimExp v -> m PrimValue
f (UnOpExp UnOp
op PrimExp v
x) = do
  PrimValue
x' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  m PrimValue
-> (PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UnOp -> PrimExp v -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad UnOp
op PrimExp v
x) PrimValue -> m PrimValue
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall a b. (a -> b) -> a -> b
$ UnOp -> PrimValue -> Maybe PrimValue
doUnOp UnOp
op PrimValue
x'
evalPrimExp v -> m PrimValue
f (ConvOpExp ConvOp
op PrimExp v
x) = do
  PrimValue
x' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  m PrimValue
-> (PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConvOp -> PrimExp v -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad ConvOp
op PrimExp v
x) PrimValue -> m PrimValue
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall a b. (a -> b) -> a -> b
$ ConvOp -> PrimValue -> Maybe PrimValue
doConvOp ConvOp
op PrimValue
x'
evalPrimExp v -> m PrimValue
f (FunExp Text
h [PrimExp v]
args PrimType
_) = do
  [PrimValue]
args' <- (PrimExp v -> m PrimValue) -> [PrimExp v] -> m [PrimValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f) [PrimExp v]
args
  m PrimValue
-> (PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> [PrimExp v] -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad Text
h [PrimExp v]
args) PrimValue -> m PrimValue
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall a b. (a -> b) -> a -> b
$ do
    ([PrimType]
_, PrimType
_, [PrimValue] -> Maybe PrimValue
fun) <- Text
-> Map Text ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)
-> Maybe ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
h Map Text ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)
primFuns
    [PrimValue] -> Maybe PrimValue
fun [PrimValue]
args'

evalBad :: (Pretty a, Pretty b, MonadFail m) => a -> b -> m c
evalBad :: forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad a
op b
arg =
  String -> m c
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m c) -> String -> m c
forall a b. (a -> b) -> a -> b
$
    String
"evalPrimExp: Type error when applying "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
prettyString a
op
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Pretty a => a -> String
prettyString b
arg

-- | The type of values returned by a 'PrimExp'.  This function
-- returning does not imply that the 'PrimExp' is type-correct.
primExpType :: PrimExp v -> PrimType
primExpType :: forall v. PrimExp v -> PrimType
primExpType (LeafExp v
_ PrimType
t) = PrimType
t
primExpType (ValueExp PrimValue
v) = PrimValue -> PrimType
primValueType PrimValue
v
primExpType (BinOpExp BinOp
op PrimExp v
_ PrimExp v
_) = BinOp -> PrimType
binOpType BinOp
op
primExpType CmpOpExp {} = PrimType
Bool
primExpType (UnOpExp UnOp
op PrimExp v
_) = UnOp -> PrimType
unOpType UnOp
op
primExpType (ConvOpExp ConvOp
op PrimExp v
_) = (PrimType, PrimType) -> PrimType
forall a b. (a, b) -> b
snd ((PrimType, PrimType) -> PrimType)
-> (PrimType, PrimType) -> PrimType
forall a b. (a -> b) -> a -> b
$ ConvOp -> (PrimType, PrimType)
convOpType ConvOp
op
primExpType (FunExp Text
_ [PrimExp v]
_ PrimType
t) = PrimType
t

-- | Is the expression a constant zero of some sort?
zeroIshExp :: PrimExp v -> Bool
zeroIshExp :: forall a. PrimExp a -> Bool
zeroIshExp (ValueExp PrimValue
v) = PrimValue -> Bool
zeroIsh PrimValue
v
zeroIshExp PrimExp v
_ = Bool
False

-- | Is the expression a constant one of some sort?
oneIshExp :: PrimExp v -> Bool
oneIshExp :: forall a. PrimExp a -> Bool
oneIshExp (ValueExp PrimValue
v) = PrimValue -> Bool
oneIsh PrimValue
v
oneIshExp PrimExp v
_ = Bool
False

-- | Is the expression a constant negative of some sort?
negativeIshExp :: PrimExp v -> Bool
negativeIshExp :: forall a. PrimExp a -> Bool
negativeIshExp (ValueExp PrimValue
v) = PrimValue -> Bool
negativeIsh PrimValue
v
negativeIshExp PrimExp v
_ = Bool
False

sameIshExp :: PrimExp v -> PrimExp v -> Bool
sameIshExp :: forall v. PrimExp v -> PrimExp v -> Bool
sameIshExp (ValueExp PrimValue
v1) (ValueExp PrimValue
v2) = PrimValue
v1 PrimValue -> PrimValue -> Bool
forall a. Eq a => a -> a -> Bool
== PrimValue
v2
sameIshExp PrimExp v
_ PrimExp v
_ = Bool
False

-- | If the given 'PrimExp' is a constant of the wrong integer type,
-- coerce it to the given integer type.  This is a workaround for an
-- issue in the 'Num' instance.
coerceIntPrimExp :: IntType -> PrimExp v -> PrimExp v
coerceIntPrimExp :: forall v. IntType -> PrimExp v -> PrimExp v
coerceIntPrimExp IntType
t (ValueExp (IntValue IntValue
v)) = PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
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
t
coerceIntPrimExp IntType
_ PrimExp v
e = PrimExp v
e

primExpIntType :: PrimExp v -> IntType
primExpIntType :: forall v. PrimExp v -> IntType
primExpIntType PrimExp v
e = case PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
e of
  IntType IntType
t -> IntType
t
  PrimType
_ -> IntType
Int64

-- | Boolean-valued PrimExps.
true, false :: TPrimExp Bool v
true :: forall v. TPrimExp Bool v
true = PrimExp v -> TPrimExp Bool v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Bool v) -> PrimExp v -> TPrimExp Bool v
forall a b. (a -> b) -> a -> b
$ PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue Bool
True
false :: forall v. TPrimExp Bool v
false = PrimExp v -> TPrimExp Bool v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Bool v) -> PrimExp v -> TPrimExp Bool v
forall a b. (a -> b) -> a -> b
$ PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue Bool
False

-- | Conversion from Bool to 'TPrimExp'
fromBool :: Bool -> TPrimExp Bool v
fromBool :: forall v. Bool -> TPrimExp Bool v
fromBool Bool
b = if Bool
b then TPrimExp Bool v
forall v. TPrimExp Bool v
true else TPrimExp Bool v
forall v. TPrimExp Bool v
false

-- | Boolean negation smart constructor.
bNot :: TPrimExp Bool v -> TPrimExp Bool v
bNot :: forall v. TPrimExp Bool v -> TPrimExp Bool v
bNot = PrimExp v -> TPrimExp Bool v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Bool v)
-> (TPrimExp Bool v -> PrimExp v)
-> TPrimExp Bool v
-> TPrimExp Bool v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UnOp -> PrimExp v -> PrimExp v
forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp (PrimType -> UnOp
Neg PrimType
Bool) (PrimExp v -> PrimExp v)
-> (TPrimExp Bool v -> PrimExp v) -> TPrimExp Bool v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

-- | SMax on 32-bit integers.
sMax32 :: TPrimExp Int32 v -> TPrimExp Int32 v -> TPrimExp Int32 v
sMax32 :: forall v. TPrimExp Int32 v -> TPrimExp Int32 v -> TPrimExp Int32 v
sMax32 TPrimExp Int32 v
x TPrimExp Int32 v
y = PrimExp v -> TPrimExp Int32 v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Int32 v) -> PrimExp v -> TPrimExp Int32 v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMax IntType
Int32) (TPrimExp Int32 v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int32 v
x) (TPrimExp Int32 v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int32 v
y)

-- | SMin on 32-bit integers.
sMin32 :: TPrimExp Int32 v -> TPrimExp Int32 v -> TPrimExp Int32 v
sMin32 :: forall v. TPrimExp Int32 v -> TPrimExp Int32 v -> TPrimExp Int32 v
sMin32 TPrimExp Int32 v
x TPrimExp Int32 v
y = PrimExp v -> TPrimExp Int32 v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Int32 v) -> PrimExp v -> TPrimExp Int32 v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMin IntType
Int32) (TPrimExp Int32 v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int32 v
x) (TPrimExp Int32 v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int32 v
y)

-- | SMax on 64-bit integers.
sMax64 :: TPrimExp Int64 v -> TPrimExp Int64 v -> TPrimExp Int64 v
sMax64 :: forall v. TPrimExp Int64 v -> TPrimExp Int64 v -> TPrimExp Int64 v
sMax64 TPrimExp Int64 v
x TPrimExp Int64 v
y = PrimExp v -> TPrimExp Int64 v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Int64 v) -> PrimExp v -> TPrimExp Int64 v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMax IntType
Int64) (TPrimExp Int64 v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int64 v
x) (TPrimExp Int64 v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int64 v
y)

-- | SMin on 64-bit integers.
sMin64 :: TPrimExp Int64 v -> TPrimExp Int64 v -> TPrimExp Int64 v
sMin64 :: forall v. TPrimExp Int64 v -> TPrimExp Int64 v -> TPrimExp Int64 v
sMin64 TPrimExp Int64 v
x TPrimExp Int64 v
y = PrimExp v -> TPrimExp Int64 v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Int64 v) -> PrimExp v -> TPrimExp Int64 v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMin IntType
Int64) (TPrimExp Int64 v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int64 v
x) (TPrimExp Int64 v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int64 v
y)

-- | Sign-extend to 32 bit integer.
sExt32 :: (IntExp t) => TPrimExp t v -> TPrimExp Int32 v
sExt32 :: forall {k} (t :: k) v. IntExp t => TPrimExp t v -> TPrimExp Int32 v
sExt32 = PrimExp v -> TPrimExp Int32 v
forall v. PrimExp v -> TPrimExp Int32 v
isInt32 (PrimExp v -> TPrimExp Int32 v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> TPrimExp Int32 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntType -> PrimExp v -> PrimExp v
forall v. IntType -> PrimExp v -> PrimExp v
sExt IntType
Int32 (PrimExp v -> PrimExp v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp t v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

-- | Sign-extend to 64 bit integer.
sExt64 :: (IntExp t) => TPrimExp t v -> TPrimExp Int64 v
sExt64 :: forall {k} (t :: k) v. IntExp t => TPrimExp t v -> TPrimExp Int64 v
sExt64 = PrimExp v -> TPrimExp Int64 v
forall v. PrimExp v -> TPrimExp Int64 v
isInt64 (PrimExp v -> TPrimExp Int64 v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> TPrimExp Int64 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntType -> PrimExp v -> PrimExp v
forall v. IntType -> PrimExp v -> PrimExp v
sExt IntType
Int64 (PrimExp v -> PrimExp v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp t v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

-- | Zero-extend to 32 bit integer.
zExt32 :: (IntExp t) => TPrimExp t v -> TPrimExp Int32 v
zExt32 :: forall {k} (t :: k) v. IntExp t => TPrimExp t v -> TPrimExp Int32 v
zExt32 = PrimExp v -> TPrimExp Int32 v
forall v. PrimExp v -> TPrimExp Int32 v
isInt32 (PrimExp v -> TPrimExp Int32 v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> TPrimExp Int32 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntType -> PrimExp v -> PrimExp v
forall v. IntType -> PrimExp v -> PrimExp v
zExt IntType
Int32 (PrimExp v -> PrimExp v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp t v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

-- | Zero-extend to 64 bit integer.
zExt64 :: (IntExp t) => TPrimExp t v -> TPrimExp Int64 v
zExt64 :: forall {k} (t :: k) v. IntExp t => TPrimExp t v -> TPrimExp Int64 v
zExt64 = PrimExp v -> TPrimExp Int64 v
forall v. PrimExp v -> TPrimExp Int64 v
isInt64 (PrimExp v -> TPrimExp Int64 v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> TPrimExp Int64 v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntType -> PrimExp v -> PrimExp v
forall v. IntType -> PrimExp v -> PrimExp v
zExt IntType
Int64 (PrimExp v -> PrimExp v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> PrimExp v
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp t v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

-- | 16-bit float minimum.
fMin16 :: TPrimExp Half v -> TPrimExp Half v -> TPrimExp Half v
fMin16 :: forall v. TPrimExp Half v -> TPrimExp Half v -> TPrimExp Half v
fMin16 TPrimExp Half v
x TPrimExp Half v
y = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMin FloatType
Float16) (TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x) (TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
y)

-- | 32-bit float minimum.
fMin32 :: TPrimExp Float v -> TPrimExp Float v -> TPrimExp Float v
fMin32 :: forall v. TPrimExp Float v -> TPrimExp Float v -> TPrimExp Float v
fMin32 TPrimExp Float v
x TPrimExp Float v
y = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMin FloatType
Float32) (TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x) (TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
y)

-- | 64-bit float minimum.
fMin64 :: TPrimExp Double v -> TPrimExp Double v -> TPrimExp Double v
fMin64 :: forall v.
TPrimExp Double v -> TPrimExp Double v -> TPrimExp Double v
fMin64 TPrimExp Double v
x TPrimExp Double v
y = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMin FloatType
Float64) (TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x) (TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
y)

-- | 16-bit float maximum.
fMax16 :: TPrimExp Half v -> TPrimExp Half v -> TPrimExp Half v
fMax16 :: forall v. TPrimExp Half v -> TPrimExp Half v -> TPrimExp Half v
fMax16 TPrimExp Half v
x TPrimExp Half v
y = PrimExp v -> TPrimExp Half v
forall v. PrimExp v -> TPrimExp Half v
isF16 (PrimExp v -> TPrimExp Half v) -> PrimExp v -> TPrimExp Half v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMax FloatType
Float16) (TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x) (TPrimExp Half v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
y)

-- | 32-bit float maximum.
fMax32 :: TPrimExp Float v -> TPrimExp Float v -> TPrimExp Float v
fMax32 :: forall v. TPrimExp Float v -> TPrimExp Float v -> TPrimExp Float v
fMax32 TPrimExp Float v
x TPrimExp Float v
y = PrimExp v -> TPrimExp Float v
forall v. PrimExp v -> TPrimExp Float v
isF32 (PrimExp v -> TPrimExp Float v) -> PrimExp v -> TPrimExp Float v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMax FloatType
Float32) (TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x) (TPrimExp Float v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
y)

-- | 64-bit float maximum.
fMax64 :: TPrimExp Double v -> TPrimExp Double v -> TPrimExp Double v
fMax64 :: forall v.
TPrimExp Double v -> TPrimExp Double v -> TPrimExp Double v
fMax64 TPrimExp Double v
x TPrimExp Double v
y = PrimExp v -> TPrimExp Double v
forall v. PrimExp v -> TPrimExp Double v
isF64 (PrimExp v -> TPrimExp Double v) -> PrimExp v -> TPrimExp Double v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMax FloatType
Float64) (TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x) (TPrimExp Double v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
y)

-- | Conditional expression.
condExp :: TPrimExp Bool v -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
condExp :: forall {k} v (t :: k).
TPrimExp Bool v -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
condExp TPrimExp Bool v
x TPrimExp t v
y TPrimExp t v
z =
  PrimExp v -> TPrimExp t v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$
    Text -> [PrimExp v] -> PrimType -> PrimExp v
forall v. Text -> [PrimExp v] -> PrimType -> PrimExp v
FunExp
      (PrimType -> Text
condFun PrimType
t)
      [TPrimExp Bool v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Bool v
x, TPrimExp t v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp t v
y, TPrimExp t v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp t v
z]
      PrimType
t
  where
    t :: PrimType
t = PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType (PrimExp v -> PrimType) -> PrimExp v -> PrimType
forall a b. (a -> b) -> a -> b
$ TPrimExp t v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp t v
y

-- | Convert result of some integer expression to have the same type
-- as another, using sign extension.
sExtAs ::
  (IntExp to, IntExp from) =>
  TPrimExp from v ->
  TPrimExp to v ->
  TPrimExp to v
sExtAs :: forall {k} {k} (to :: k) (from :: k) v.
(IntExp to, IntExp from) =>
TPrimExp from v -> TPrimExp to v -> TPrimExp to v
sExtAs TPrimExp from v
from TPrimExp to v
to = PrimExp v -> TPrimExp to v
forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp to v) -> PrimExp v -> TPrimExp to v
forall a b. (a -> b) -> a -> b
$ IntType -> PrimExp v -> PrimExp v
forall v. IntType -> PrimExp v -> PrimExp v
sExt (TPrimExp to v -> IntType
forall v. TPrimExp to v -> IntType
forall {k} (t :: k) v. IntExp t => TPrimExp t v -> IntType
expIntType TPrimExp to v
to) (TPrimExp from v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp from v
from)

-- Prettyprinting instances

instance (Pretty v) => Pretty (PrimExp v) where
  pretty :: forall ann. PrimExp v -> Doc ann
pretty (LeafExp v
v PrimType
_) = v -> Doc ann
forall ann. v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty v
v
  pretty (ValueExp PrimValue
v) = PrimValue -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimValue -> Doc ann
pretty PrimValue
v
  pretty (BinOpExp BinOp
op PrimExp v
x PrimExp v
y) = BinOp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. BinOp -> Doc ann
pretty BinOp
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (PrimExp v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimExp v -> Doc ann
pretty PrimExp v
x) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (PrimExp v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimExp v -> Doc ann
pretty PrimExp v
y)
  pretty (CmpOpExp CmpOp
op PrimExp v
x PrimExp v
y) = CmpOp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. CmpOp -> Doc ann
pretty CmpOp
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (PrimExp v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimExp v -> Doc ann
pretty PrimExp v
x) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (PrimExp v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimExp v -> Doc ann
pretty PrimExp v
y)
  pretty (ConvOpExp ConvOp
op PrimExp v
x) = ConvOp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. ConvOp -> Doc ann
pretty ConvOp
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (PrimExp v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimExp v -> Doc ann
pretty PrimExp v
x)
  pretty (UnOpExp UnOp
op PrimExp v
x) = UnOp -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. UnOp -> Doc ann
pretty UnOp
op Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens (PrimExp v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimExp v -> Doc ann
pretty PrimExp v
x)
  pretty (FunExp Text
h [PrimExp v]
args PrimType
_) = Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
h Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([Doc ann] -> Doc ann
forall a. [Doc a] -> Doc a
commasep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ (PrimExp v -> Doc ann) -> [PrimExp v] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map PrimExp v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimExp v -> Doc ann
pretty [PrimExp v]
args)

instance (Pretty v) => Pretty (TPrimExp t v) where
  pretty :: forall ann. TPrimExp t v -> Doc ann
pretty = PrimExp v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. PrimExp v -> Doc ann
pretty (PrimExp v -> Doc ann)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp t v -> PrimExp v
forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

-- | Produce a mapping from the leaves of the 'PrimExp' to their
-- designated types.
leafExpTypes :: (Ord a) => PrimExp a -> S.Set (a, PrimType)
leafExpTypes :: forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes (LeafExp a
x PrimType
ptp) = (a, PrimType) -> Set (a, PrimType)
forall a. a -> Set a
S.singleton (a
x, PrimType
ptp)
leafExpTypes (ValueExp PrimValue
_) = Set (a, PrimType)
forall a. Set a
S.empty
leafExpTypes (UnOpExp UnOp
_ PrimExp a
e) = PrimExp a -> Set (a, PrimType)
forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e
leafExpTypes (ConvOpExp ConvOp
_ PrimExp a
e) = PrimExp a -> Set (a, PrimType)
forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e
leafExpTypes (BinOpExp BinOp
_ PrimExp a
e1 PrimExp a
e2) =
  Set (a, PrimType) -> Set (a, PrimType) -> Set (a, PrimType)
forall a. Ord a => Set a -> Set a -> Set a
S.union (PrimExp a -> Set (a, PrimType)
forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e1) (PrimExp a -> Set (a, PrimType)
forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e2)
leafExpTypes (CmpOpExp CmpOp
_ PrimExp a
e1 PrimExp a
e2) =
  Set (a, PrimType) -> Set (a, PrimType) -> Set (a, PrimType)
forall a. Ord a => Set a -> Set a -> Set a
S.union (PrimExp a -> Set (a, PrimType)
forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e1) (PrimExp a -> Set (a, PrimType)
forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e2)
leafExpTypes (FunExp Text
_ [PrimExp a]
pes PrimType
_) =
  [Set (a, PrimType)] -> Set (a, PrimType)
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set (a, PrimType)] -> Set (a, PrimType))
-> [Set (a, PrimType)] -> Set (a, PrimType)
forall a b. (a -> b) -> a -> b
$ (PrimExp a -> Set (a, PrimType))
-> [PrimExp a] -> [Set (a, PrimType)]
forall a b. (a -> b) -> [a] -> [b]
map PrimExp a -> Set (a, PrimType)
forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes [PrimExp a]
pes

-- | Multiplication of untyped 'PrimExp's, which must have the same
-- type.  Uses 'OverflowWrap' for integer operations.
(~*~) :: PrimExp v -> PrimExp v -> PrimExp v
PrimExp v
x ~*~ :: forall v. PrimExp v -> PrimExp v -> PrimExp v
~*~ PrimExp v
y = BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x
    op :: BinOp
op = case PrimType
t of
      IntType IntType
it -> IntType -> Overflow -> BinOp
Mul IntType
it Overflow
OverflowWrap
      FloatType FloatType
ft -> FloatType -> BinOp
FMul FloatType
ft
      PrimType
Bool -> BinOp
LogAnd
      PrimType
Unit -> BinOp
LogAnd

-- | Division of untyped 'PrimExp's, which must have the same
-- type.  For integers, this is unsafe signed division.
(~/~) :: PrimExp v -> PrimExp v -> PrimExp v
PrimExp v
x ~/~ :: forall v. PrimExp v -> PrimExp v -> PrimExp v
~/~ PrimExp v
y = BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x
    op :: BinOp
op = case PrimType
t of
      IntType IntType
it -> IntType -> Safety -> BinOp
SDiv IntType
it Safety
Unsafe
      FloatType FloatType
ft -> FloatType -> BinOp
FDiv FloatType
ft
      PrimType
Bool -> BinOp
LogAnd
      PrimType
Unit -> BinOp
LogAnd

-- | Addition of untyped 'PrimExp's, which must have the same type.
-- Uses 'OverflowWrap' for integer operations.
(~+~) :: PrimExp v -> PrimExp v -> PrimExp v
PrimExp v
x ~+~ :: forall v. PrimExp v -> PrimExp v -> PrimExp v
~+~ PrimExp v
y = BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x
    op :: BinOp
op = case PrimType
t of
      IntType IntType
it -> IntType -> Overflow -> BinOp
Add IntType
it Overflow
OverflowWrap
      FloatType FloatType
ft -> FloatType -> BinOp
FAdd FloatType
ft
      PrimType
Bool -> BinOp
LogOr
      PrimType
Unit -> BinOp
LogOr

-- | Subtraction of untyped 'PrimExp's, which must have the same type.
-- Uses 'OverflowWrap' for integer operations.
(~-~) :: PrimExp v -> PrimExp v -> PrimExp v
PrimExp v
x ~-~ :: forall v. PrimExp v -> PrimExp v -> PrimExp v
~-~ PrimExp v
y = BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x
    op :: BinOp
op = case PrimType
t of
      IntType IntType
it -> IntType -> Overflow -> BinOp
Sub IntType
it Overflow
OverflowWrap
      FloatType FloatType
ft -> FloatType -> BinOp
FSub FloatType
ft
      PrimType
Bool -> BinOp
LogOr
      PrimType
Unit -> BinOp
LogOr

-- | Equality of untyped 'PrimExp's, which must have the same type.
(~==~) :: PrimExp v -> PrimExp v -> PrimExp v
PrimExp v
x ~==~ :: forall v. PrimExp v -> PrimExp v -> PrimExp v
~==~ PrimExp v
y = CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
CmpOpExp (PrimType -> CmpOp
CmpEq PrimType
t) PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = PrimExp v -> PrimType
forall v. PrimExp v -> PrimType
primExpType PrimExp v
x

infix 7 ~*~, ~/~

infix 6 ~+~, ~-~

infix 4 ~==~