{-# 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,

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

import Control.Category
import Control.Monad
import Data.Map qualified as M
import Data.Set qualified as S
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 String [PrimExp v] PrimType
  deriving (PrimExp v -> PrimExp v -> Bool
forall v. Eq v => PrimExp v -> PrimExp v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrimExp v -> PrimExp v -> Bool
$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
Eq, PrimExp v -> PrimExp v -> Ordering
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
min :: PrimExp v -> PrimExp v -> PrimExp v
$cmin :: forall v. Ord v => PrimExp v -> PrimExp v -> PrimExp v
max :: PrimExp v -> PrimExp v -> PrimExp v
$cmax :: forall v. Ord v => PrimExp v -> PrimExp v -> PrimExp v
>= :: 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
$c< :: forall v. Ord v => PrimExp v -> PrimExp v -> Bool
compare :: PrimExp v -> PrimExp v -> Ordering
$ccompare :: forall v. Ord v => PrimExp v -> PrimExp v -> Ordering
Ord, Int -> PrimExp v -> ShowS
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
showList :: [PrimExp v] -> ShowS
$cshowList :: forall v. Show v => [PrimExp v] -> ShowS
show :: PrimExp v -> String
$cshow :: forall v. Show v => PrimExp v -> String
showsPrec :: Int -> PrimExp v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> PrimExp v -> ShowS
Show)

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

instance FreeIn v => FreeIn (PrimExp v) where
  freeIn' :: PrimExp v -> FV
freeIn' = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
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
$c== :: forall k (t :: k) v. Eq v => TPrimExp t v -> TPrimExp t v -> Bool
Eq, 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
min :: 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
max :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
$cmax :: forall k (t :: k) v.
Ord v =>
TPrimExp t v -> TPrimExp t v -> TPrimExp t v
>= :: 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
$c< :: forall k (t :: k) v. Ord v => TPrimExp t v -> TPrimExp t v -> Bool
compare :: TPrimExp t v -> TPrimExp t v -> Ordering
$ccompare :: forall k (t :: k) v.
Ord v =>
TPrimExp t v -> TPrimExp t v -> Ordering
Ord, Int -> TPrimExp t v -> ShowS
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
showList :: [TPrimExp t v] -> ShowS
$cshowList :: forall k (t :: k) v. Show v => [TPrimExp t v] -> ShowS
show :: TPrimExp t v -> String
$cshow :: forall k (t :: k) v. Show v => TPrimExp t v -> String
showsPrec :: Int -> TPrimExp t v -> ShowS
$cshowsPrec :: forall k (t :: k) v. Show v => Int -> TPrimExp t v -> ShowS
Show)

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

instance FreeIn v => FreeIn (TPrimExp t v) where
  freeIn' :: TPrimExp t v -> FV
freeIn' = forall a. FreeIn a => a -> FV
freeIn' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> a -> Bool
>= Int
k) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {v}. Int -> PrimExp v -> Maybe Int
descend Int
0
  where
    descend :: Int -> PrimExp v -> Maybe Int
descend Int
i PrimExp v
_
      | Int
i forall a. Ord a => a -> a -> Bool
>= Int
k = forall a. Maybe a
Nothing
    descend Int
i LeafExp {} = forall a. a -> Maybe a
Just (Int
i forall a. Num a => a -> a -> a
+ Int
1)
    descend Int
i ValueExp {} = forall a. a -> Maybe a
Just (Int
i 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 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 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 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 forall a. Num a => a -> a -> a
+ Int
1) PrimExp v
x
    descend Int
i (FunExp String
_ [PrimExp v]
args PrimType
_) = 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 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)
  | forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
x = PrimExp v
y
  | forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (BinOpExp Sub {} PrimExp v
x PrimExp v
y)
  | forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (BinOpExp Mul {} PrimExp v
x PrimExp v
y)
  | forall a. PrimExp a -> Bool
oneIshExp PrimExp v
x = PrimExp v
y
  | forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
x
  | forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
x,
    IntType IntType
it <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
y =
      forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue forall a b. (a -> b) -> a -> b
$ forall int. Integral int => IntType -> int -> IntValue
intValue IntType
it (Int
0 :: Int)
  | forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y,
    IntType IntType
it <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
x =
      forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue forall a b. (a -> b) -> a -> b
$ forall int. Integral int => IntType -> int -> IntValue
intValue IntType
it (Int
0 :: Int)
constFoldPrimExp (BinOpExp SDiv {} PrimExp v
x PrimExp v
y)
  | forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (BinOpExp SQuot {} PrimExp v
x PrimExp v
y)
  | forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (BinOpExp UDiv {} PrimExp v
x PrimExp v
y)
  | 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 =
      forall v. PrimValue -> PrimExp v
ValueExp PrimValue
z
constFoldPrimExp (BinOpExp BinOp
LogAnd PrimExp v
x PrimExp v
y)
  | forall a. PrimExp a -> Bool
oneIshExp PrimExp v
x = PrimExp v
y
  | forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
x
  | forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
x = PrimExp v
x
  | forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y = PrimExp v
y
constFoldPrimExp (BinOpExp BinOp
LogOr PrimExp v
x PrimExp v
y)
  | forall a. PrimExp a -> Bool
oneIshExp PrimExp v
x = PrimExp v
x
  | forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = PrimExp v
y
  | forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
x = PrimExp v
y
  | forall a. PrimExp a -> Bool
zeroIshExp PrimExp v
y = PrimExp v
x
constFoldPrimExp (UnOpExp Abs {} PrimExp v
x)
  | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. PrimExp a -> Bool
negativeIshExp PrimExp v
x = PrimExp v
x
constFoldPrimExp (UnOpExp Not {} (ValueExp (BoolValue Bool
x))) =
  forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not Bool
x
constFoldPrimExp (BinOpExp UMod {} PrimExp v
x PrimExp v
y)
  | forall v. PrimExp v -> PrimExp v -> Bool
sameIshExp PrimExp v
x PrimExp v
y,
    IntType IntType
it <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
x =
      forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue forall a b. (a -> b) -> a -> b
$ forall int. Integral int => IntType -> int -> IntValue
intValue IntType
it (Integer
0 :: Integer)
constFoldPrimExp (BinOpExp SMod {} PrimExp v
x PrimExp v
y)
  | forall v. PrimExp v -> PrimExp v -> Bool
sameIshExp PrimExp v
x PrimExp v
y,
    IntType IntType
it <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
x =
      forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue forall a b. (a -> b) -> a -> b
$ forall int. Integral int => IntType -> int -> IntValue
intValue IntType
it (Integer
0 :: Integer)
constFoldPrimExp (BinOpExp SRem {} PrimExp v
x PrimExp v
y)
  | forall v. PrimExp v -> PrimExp v -> Bool
sameIshExp PrimExp v
x PrimExp v
y,
    IntType IntType
it <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
x =
      forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== PrimExp v
y =
      forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped forall v. TPrimExp Bool v
true
constFoldCmpExp (CmpOpExp (CmpEq PrimType
_) (ValueExp PrimValue
x) (ValueExp PrimValue
y))
  | PrimValue
x forall a. Eq a => a -> a -> Bool
/= PrimValue
y =
      forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped forall v. TPrimExp Bool v
false
constFoldCmpExp PrimExp v
e = 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' = forall v. PrimExp v -> TPrimExp Int8 v
isInt8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. PrimValue -> PrimExp v
ValueExp 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 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => Integer -> a
fromInteger
  fromBoolExp :: forall v. TPrimExp Bool v -> TPrimExp Int8 v
fromBoolExp = forall v. PrimExp v -> TPrimExp Int8 v
isInt8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> ConvOp
BToI IntType
Int8) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

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

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

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

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

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

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

instance IntExp Int64 where
  expIntType :: forall v. TPrimExp Int64 v -> IntType
expIntType = 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' = forall v. PrimExp v -> TPrimExp Half v
isF16 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. PrimValue -> PrimExp v
ValueExp 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 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => Integer -> a
fromInteger
  fromBoolExp :: forall v. TPrimExp Bool v -> TPrimExp Half v
fromBoolExp = forall v. PrimExp v -> TPrimExp Half v
isF16 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> FloatType -> ConvOp
SIToFP IntType
Int16 FloatType
Float16) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> ConvOp
BToI IntType
Int16) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped

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

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

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

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

instance FloatExp Double where
  fromRational' :: forall v. Rational -> TPrimExp Double v
fromRational' = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. PrimValue -> PrimExp v
ValueExp 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 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Fractional a => Rational -> a
fromRational
  expFloatType :: forall v. TPrimExp Double v -> FloatType
expFloatType = 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 <-
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Overflow -> BinOp
`Add` Overflow
OverflowUndef) PrimExp v
x PrimExp v
y,
            forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FAdd PrimExp v
x PrimExp v
y
          ] =
        forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = 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 <-
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Overflow -> BinOp
`Sub` Overflow
OverflowUndef) PrimExp v
x PrimExp v
y,
            forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FSub PrimExp v
x PrimExp v
y
          ] =
        forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = 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 <-
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Overflow -> BinOp
`Mul` Overflow
OverflowUndef) PrimExp v
x PrimExp v
y,
            forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FMul PrimExp v
x PrimExp v
y
          ] =
        forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = 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 <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp forall a b. (a -> b) -> a -> b
$ forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp (IntType -> UnOp
Abs IntType
t) PrimExp v
x
    | FloatType FloatType
t <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp forall a b. (a -> b) -> a -> b
$ forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp (FloatType -> UnOp
FAbs FloatType
t) PrimExp v
x
    | Bool
otherwise = 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 <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp (IntType -> UnOp
SSignum IntType
t) PrimExp v
x
    | Bool
otherwise = forall a b. Pretty a => String -> a -> b
numBad String
"signum" PrimExp v
x

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

  fromRational :: Rational -> TPrimExp t v
fromRational = 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 = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FPow FloatType
Float16) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
y)
  pi :: TPrimExp Half v
pi = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue forall a b. (a -> b) -> a -> b
$ Half -> FloatValue
Float16Value forall a. Floating a => a
pi
  exp :: TPrimExp Half v -> TPrimExp Half v
exp TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"exp16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  log :: TPrimExp Half v -> TPrimExp Half v
log TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"log16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  sin :: TPrimExp Half v -> TPrimExp Half v
sin TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"sin16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  cos :: TPrimExp Half v -> TPrimExp Half v
cos TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"cos16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  tan :: TPrimExp Half v -> TPrimExp Half v
tan TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"tan16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  asin :: TPrimExp Half v -> TPrimExp Half v
asin TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"asin16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  acos :: TPrimExp Half v -> TPrimExp Half v
acos TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"acos16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  atan :: TPrimExp Half v -> TPrimExp Half v
atan TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"atan16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  sinh :: TPrimExp Half v -> TPrimExp Half v
sinh TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"sinh16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  cosh :: TPrimExp Half v -> TPrimExp Half v
cosh TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"cosh16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  tanh :: TPrimExp Half v -> TPrimExp Half v
tanh TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"tanh16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  asinh :: TPrimExp Half v -> TPrimExp Half v
asinh TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"asinh16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  acosh :: TPrimExp Half v -> TPrimExp Half v
acosh TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"acosh16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float16
  atanh :: TPrimExp Half v -> TPrimExp Half v
atanh TPrimExp Half v
x = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"atanh16" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x] 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 = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FPow FloatType
Float32) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
y)
  pi :: TPrimExp Float v
pi = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue forall a b. (a -> b) -> a -> b
$ Float -> FloatValue
Float32Value forall a. Floating a => a
pi
  exp :: TPrimExp Float v -> TPrimExp Float v
exp TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"exp32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  log :: TPrimExp Float v -> TPrimExp Float v
log TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"log32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  sin :: TPrimExp Float v -> TPrimExp Float v
sin TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"sin32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  cos :: TPrimExp Float v -> TPrimExp Float v
cos TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"cos32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  tan :: TPrimExp Float v -> TPrimExp Float v
tan TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"tan32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  asin :: TPrimExp Float v -> TPrimExp Float v
asin TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"asin32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  acos :: TPrimExp Float v -> TPrimExp Float v
acos TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"acos32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  atan :: TPrimExp Float v -> TPrimExp Float v
atan TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"atan32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  sinh :: TPrimExp Float v -> TPrimExp Float v
sinh TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"sinh32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  cosh :: TPrimExp Float v -> TPrimExp Float v
cosh TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"cosh32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  tanh :: TPrimExp Float v -> TPrimExp Float v
tanh TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"tanh32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  asinh :: TPrimExp Float v -> TPrimExp Float v
asinh TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"asinh32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  acosh :: TPrimExp Float v -> TPrimExp Float v
acosh TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"acosh32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float32
  atanh :: TPrimExp Float v -> TPrimExp Float v
atanh TPrimExp Float v
x = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"atanh32" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x] 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 = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FPow FloatType
Float64) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
y)
  pi :: TPrimExp Double v
pi = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ FloatValue -> PrimValue
FloatValue forall a b. (a -> b) -> a -> b
$ Double -> FloatValue
Float64Value forall a. Floating a => a
pi
  exp :: TPrimExp Double v -> TPrimExp Double v
exp TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"exp64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  log :: TPrimExp Double v -> TPrimExp Double v
log TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"log64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  sin :: TPrimExp Double v -> TPrimExp Double v
sin TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"sin64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  cos :: TPrimExp Double v -> TPrimExp Double v
cos TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"cos64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  tan :: TPrimExp Double v -> TPrimExp Double v
tan TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"tan64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  asin :: TPrimExp Double v -> TPrimExp Double v
asin TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"asin64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  acos :: TPrimExp Double v -> TPrimExp Double v
acos TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"acos64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  atan :: TPrimExp Double v -> TPrimExp Double v
atan TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"atan64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  sinh :: TPrimExp Double v -> TPrimExp Double v
sinh TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"sinh64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  cosh :: TPrimExp Double v -> TPrimExp Double v
cosh TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"cosh64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  tanh :: TPrimExp Double v -> TPrimExp Double v
tanh TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"tanh64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  asinh :: TPrimExp Double v -> TPrimExp Double v
asinh TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"asinh64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  acosh :: TPrimExp Double v -> TPrimExp Double v
acosh TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"acosh64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] forall a b. (a -> b) -> a -> b
$ FloatType -> PrimType
FloatType FloatType
Float64
  atanh :: TPrimExp Double v -> TPrimExp Double v
atanh TPrimExp Double v
x = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. String -> [PrimExp v] -> PrimType -> PrimExp v
FunExp String
"atanh64" [forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x] 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 <-
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SDiv` Safety
Unsafe) PrimExp v
x PrimExp v
y,
            forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FDiv PrimExp v
x PrimExp v
y
          ] =
        forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = 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 <- forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SMod` Safety
Unsafe) PrimExp v
x PrimExp v
y] =
        forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = 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
    | forall a. PrimExp a -> Bool
oneIshExp PrimExp v
y = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp PrimExp v
x
    | Just PrimExp v
z <- forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SQuot` Safety
Unsafe) PrimExp v
x PrimExp v
y] =
        forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = 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 <- forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SRem` Safety
Unsafe) PrimExp v
x PrimExp v
y] =
        forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = 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 <- forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp (IntType -> Safety -> BinOp
`SDivUp` Safety
Unsafe) PrimExp v
x PrimExp v
y] =
        forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = 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 <-
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
          [ forall v.
(IntType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asIntOp IntType -> BinOp
Pow PrimExp v
x PrimExp v
y,
            forall v.
(FloatType -> BinOp) -> PrimExp v -> PrimExp v -> Maybe (PrimExp v)
asFloatOp FloatType -> BinOp
FPow PrimExp v
x PrimExp v
y
          ] =
        forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp PrimExp v
z
    | Bool
otherwise = 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))) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
signum forall a b. (a -> b) -> a -> b
$ forall int. Integral int => IntValue -> int
valueIntegral IntValue
i
  sgn TPrimExp t v
_ = 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 = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp forall a b. (a -> b) -> a -> b
$ 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 = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimExp v -> PrimExp v
constFoldPrimExp forall a b. (a -> b) -> a -> b
$ 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 =
  forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. Eq v => PrimExp v -> PrimExp v
constFoldCmpExp forall a b. (a -> b) -> a -> b
$ forall v. CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
CmpOpExp CmpOp
cmp PrimExp v
x PrimExp v
y
  where
    cmp :: CmpOp
cmp = case 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 =
  forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. Eq v => PrimExp v -> PrimExp v
constFoldCmpExp forall a b. (a -> b) -> a -> b
$ forall v. CmpOp -> PrimExp v -> PrimExp v -> PrimExp v
CmpOpExp CmpOp
cmp PrimExp v
x PrimExp v
y
  where
    cmp :: CmpOp
cmp = case 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 =
  forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. Eq v => PrimExp v -> PrimExp v
constFoldCmpExp forall a b. (a -> b) -> a -> b
$ 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 = forall v. PrimExp v -> PrimType
primExpType PrimExp v
x forall a. Ord a => a -> a -> a
`min` 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 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 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) =
  forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$
    forall v. PrimExp v -> PrimExp v
constFoldPrimExp forall a b. (a -> b) -> a -> b
$
      forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
op forall a b. (a -> b) -> a -> b
$ 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
(.&.) = 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
(.|.) = 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
(.^.) = 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
(.>>.) = 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
(.<<.) = 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)) = forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue forall a b. (a -> b) -> a -> b
$ IntValue -> IntType -> IntValue
doSExt IntValue
v IntType
it
sExt IntType
it PrimExp v
e
  | forall v. PrimExp v -> IntType
primExpIntType PrimExp v
e forall a. Eq a => a -> a -> Bool
== IntType
it = PrimExp v
e
  | Bool
otherwise = forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> IntType -> ConvOp
SExt (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)) = forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue forall a b. (a -> b) -> a -> b
$ IntValue -> IntType -> IntValue
doZExt IntValue
v IntType
it
zExt IntType
it PrimExp v
e
  | forall v. PrimExp v -> IntType
primExpIntType PrimExp v
e forall a. Eq a => a -> a -> Bool
== IntType
it = PrimExp v
e
  | Bool
otherwise = forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> IntType -> ConvOp
ZExt (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 <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
f IntType
x_t) PrimExp v
x PrimExp v
y
  | Bool
otherwise = 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 <- forall v. PrimExp v -> PrimType
primExpType PrimExp v
x = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
f FloatType
t) PrimExp v
x PrimExp v
y
  | Bool
otherwise = 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 =
  forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Invalid argument to PrimExp method " forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ 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) = 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' <- forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  PrimValue
y' <- forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
y
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad BinOp
op (PrimExp v
x, PrimExp v
y)) forall (f :: * -> *) a. Applicative f => a -> f a
pure 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' <- forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  PrimValue
y' <- forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
y
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad CmpOp
op (PrimExp v
x, PrimExp v
y)) (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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) 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' <- forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad UnOp
op PrimExp v
x) forall (f :: * -> *) a. Applicative f => a -> f a
pure 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' <- forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad ConvOp
op PrimExp v
x) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ConvOp -> PrimValue -> Maybe PrimValue
doConvOp ConvOp
op PrimValue
x'
evalPrimExp v -> m PrimValue
f (FunExp String
h [PrimExp v]
args PrimType
_) = do
  [PrimValue]
args' <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f) [PrimExp v]
args
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad String
h [PrimExp v]
args) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do
    ([PrimType]
_, PrimType
_, [PrimValue] -> Maybe PrimValue
fun) <- forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
h Map String ([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 =
  forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$
    String
"evalPrimExp: Type error when applying "
      forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyString a
op
      forall a. [a] -> [a] -> [a]
++ String
" to "
      forall a. [a] -> [a] -> [a]
++ 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
_) = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ ConvOp -> (PrimType, PrimType)
convOpType ConvOp
op
primExpType (FunExp String
_ [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 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)) = forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue 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 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 = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimValue -> PrimExp v
ValueExp forall a b. (a -> b) -> a -> b
$ Bool -> PrimValue
BoolValue Bool
True
false :: forall v. TPrimExp Bool v
false = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. PrimValue -> PrimExp v
ValueExp 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 forall v. TPrimExp Bool v
true else 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 = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. UnOp -> PrimExp v -> PrimExp v
UnOpExp UnOp
Not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMax IntType
Int32) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int32 v
x) (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 = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMin IntType
Int32) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int32 v
x) (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 = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMax IntType
Int64) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int64 v
x) (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 = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMin IntType
Int64) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int64 v
x) (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 = forall v. PrimExp v -> TPrimExp Int32 v
isInt32 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. IntType -> PrimExp v -> PrimExp v
sExt IntType
Int32 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = forall v. PrimExp v -> TPrimExp Int64 v
isInt64 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. IntType -> PrimExp v -> PrimExp v
sExt IntType
Int64 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = forall v. PrimExp v -> TPrimExp Int32 v
isInt32 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. IntType -> PrimExp v -> PrimExp v
zExt IntType
Int32 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = forall v. PrimExp v -> TPrimExp Int64 v
isInt64 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. IntType -> PrimExp v -> PrimExp v
zExt IntType
Int64 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMin FloatType
Float16) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x) (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 = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMin FloatType
Float32) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x) (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 = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMin FloatType
Float64) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x) (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 = forall v. PrimExp v -> TPrimExp Half v
isF16 forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMax FloatType
Float16) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Half v
x) (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 = forall v. PrimExp v -> TPrimExp Float v
isF32 forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMax FloatType
Float32) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Float v
x) (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 = forall v. PrimExp v -> TPrimExp Double v
isF64 forall a b. (a -> b) -> a -> b
$ forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (FloatType -> BinOp
FMax FloatType
Float64) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double v
x) (forall {k} (t :: k) v. TPrimExp t v -> PrimExp v
untyped TPrimExp Double 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 = forall {k} (t :: k) v. PrimExp v -> TPrimExp t v
TPrimExp forall a b. (a -> b) -> a -> b
$ forall v. IntType -> PrimExp v -> PrimExp v
sExt (forall {k} (t :: k) v. IntExp t => TPrimExp t v -> IntType
expIntType TPrimExp to v
to) (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
_) = forall a ann. Pretty a => a -> Doc ann
pretty v
v
  pretty (ValueExp PrimValue
v) = forall a ann. Pretty a => a -> Doc ann
pretty PrimValue
v
  pretty (BinOpExp BinOp
op PrimExp v
x PrimExp v
y) = forall a ann. Pretty a => a -> Doc ann
pretty BinOp
op forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty PrimExp v
x) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty PrimExp v
y)
  pretty (CmpOpExp CmpOp
op PrimExp v
x PrimExp v
y) = forall a ann. Pretty a => a -> Doc ann
pretty CmpOp
op forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty PrimExp v
x) forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty PrimExp v
y)
  pretty (ConvOpExp ConvOp
op PrimExp v
x) = forall a ann. Pretty a => a -> Doc ann
pretty ConvOp
op forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty PrimExp v
x)
  pretty (UnOpExp UnOp
op PrimExp v
x) = forall a ann. Pretty a => a -> Doc ann
pretty UnOp
op forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a ann. Pretty a => a -> Doc ann
pretty PrimExp v
x)
  pretty (FunExp String
h [PrimExp v]
args PrimType
_) = forall a ann. Pretty a => a -> Doc ann
pretty String
h forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall ann. Doc ann -> Doc ann
parens (forall a. [Doc a] -> Doc a
commasep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a ann. Pretty a => a -> Doc ann
pretty [PrimExp v]
args)

instance Pretty v => Pretty (TPrimExp t v) where
  pretty :: forall ann. TPrimExp t v -> Doc ann
pretty = forall a ann. Pretty a => a -> Doc ann
pretty forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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) = forall a. a -> Set a
S.singleton (a
x, PrimType
ptp)
leafExpTypes (ValueExp PrimValue
_) = forall a. Set a
S.empty
leafExpTypes (UnOpExp UnOp
_ PrimExp a
e) = forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e
leafExpTypes (ConvOpExp ConvOp
_ PrimExp a
e) = forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e
leafExpTypes (BinOpExp BinOp
_ PrimExp a
e1 PrimExp a
e2) =
  forall a. Ord a => Set a -> Set a -> Set a
S.union (forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e1) (forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e2)
leafExpTypes (CmpOpExp CmpOp
_ PrimExp a
e1 PrimExp a
e2) =
  forall a. Ord a => Set a -> Set a -> Set a
S.union (forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e1) (forall a. Ord a => PrimExp a -> Set (a, PrimType)
leafExpTypes PrimExp a
e2)
leafExpTypes (FunExp String
_ [PrimExp a]
pes PrimType
_) =
  forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map 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 = forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = 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 = forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = 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 = forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = 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 = forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp BinOp
op PrimExp v
x PrimExp v
y
  where
    t :: PrimType
t = 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 = 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 = forall v. PrimExp v -> PrimType
primExpType PrimExp v
x

infix 7 ~*~, ~/~

infix 6 ~+~, ~-~

infix 4 ~==~