{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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,
    isF32,
    isF64,
    evalPrimExp,
    primExpType,
    primExpSizeAtLeast,
    coerceIntPrimExp,
    leafExpTypes,
    true,
    false,
    constFoldPrimExp,

    -- * Construction
    module Futhark.IR.Primitive,
    NumExp (..),
    IntExp,
    FloatExp (..),
    sExt,
    zExt,
    (.&&.),
    (.||.),
    (.<.),
    (.<=.),
    (.>.),
    (.>=.),
    (.==.),
    (.&.),
    (.|.),
    (.^.),
    (.>>.),
    (.<<.),
    bNot,
    sMax32,
    sMin32,
    sMax64,
    sMin64,
    sExt32,
    sExt64,
    zExt32,
    zExt64,
    fMin64,
    fMax64,
  )
where

import Control.Category
import Control.Monad
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Traversable
import Futhark.IR.Primitive
import Futhark.IR.Prop.Names
import Futhark.Util.IntegralExp
import Futhark.Util.Pretty
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
(PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> Bool) -> Eq (PrimExp v)
forall v. Eq v => PrimExp v -> PrimExp v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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, Eq (PrimExp v)
Eq (PrimExp v)
-> (PrimExp v -> PrimExp v -> Ordering)
-> (PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> Bool)
-> (PrimExp v -> PrimExp v -> PrimExp v)
-> (PrimExp v -> PrimExp v -> PrimExp v)
-> Ord (PrimExp v)
PrimExp v -> PrimExp v -> Bool
PrimExp v -> PrimExp v -> Ordering
PrimExp v -> PrimExp v -> PrimExp v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall v. Ord v => Eq (PrimExp v)
forall v. Ord v => PrimExp v -> PrimExp v -> Bool
forall v. Ord v => PrimExp v -> PrimExp v -> Ordering
forall v. Ord v => PrimExp v -> PrimExp v -> PrimExp v
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
$cp1Ord :: forall v. Ord v => Eq (PrimExp v)
Ord, Int -> PrimExp v -> ShowS
[PrimExp v] -> ShowS
PrimExp v -> String
(Int -> PrimExp v -> ShowS)
-> (PrimExp v -> String)
-> ([PrimExp v] -> ShowS)
-> Show (PrimExp v)
forall v. Show v => Int -> PrimExp v -> ShowS
forall v. Show v => [PrimExp v] -> ShowS
forall v. Show v => PrimExp v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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 :: (a -> b) -> PrimExp a -> PrimExp b
fmap = (a -> b) -> PrimExp a -> PrimExp b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
fmapDefault

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

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

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

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

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

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

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

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

-- | This expression is of type t'Int8'.
isInt8 :: PrimExp v -> TPrimExp Int8 v
isInt8 :: PrimExp v -> TPrimExp Int8 v
isInt8 = PrimExp v -> TPrimExp Int8 v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Int16'.
isInt16 :: PrimExp v -> TPrimExp Int16 v
isInt16 :: PrimExp v -> TPrimExp Int16 v
isInt16 = PrimExp v -> TPrimExp Int16 v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Int32'.
isInt32 :: PrimExp v -> TPrimExp Int32 v
isInt32 :: PrimExp v -> TPrimExp Int32 v
isInt32 = PrimExp v -> TPrimExp Int32 v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Int64'.
isInt64 :: PrimExp v -> TPrimExp Int64 v
isInt64 :: PrimExp v -> TPrimExp Int64 v
isInt64 = PrimExp v -> TPrimExp Int64 v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This is a boolean expression.
isBool :: PrimExp v -> TPrimExp Bool v
isBool :: PrimExp v -> TPrimExp Bool v
isBool = PrimExp v -> TPrimExp Bool v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Float'.
isF32 :: PrimExp v -> TPrimExp Float v
isF32 :: PrimExp v -> TPrimExp Float v
isF32 = PrimExp v -> TPrimExp Float v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp

-- | This expression is of type t'Double'.
isF64 :: PrimExp v -> TPrimExp Double v
isF64 :: PrimExp v -> TPrimExp Double v
isF64 = PrimExp v -> TPrimExp Double v
forall t 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 :: Int -> PrimExp v -> Bool
primExpSizeAtLeast Int
k = Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k) (Maybe Int -> Bool)
-> (PrimExp v -> Maybe Int) -> PrimExp v -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> PrimExp v -> Maybe Int
forall v. Int -> PrimExp v -> Maybe Int
descend Int
0
  where
    descend :: Int -> PrimExp v -> Maybe Int
descend Int
i PrimExp v
_
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k = Maybe Int
forall a. Maybe a
Nothing
    descend Int
i LeafExp {} = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    descend Int
i ValueExp {} = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    descend Int
i (BinOpExp BinOp
_ PrimExp v
x PrimExp v
y) = do
      Int
x' <- Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PrimExp v
x
      Int -> PrimExp v -> Maybe Int
descend Int
x' PrimExp v
y
    descend Int
i (CmpOpExp CmpOp
_ PrimExp v
x PrimExp v
y) = do
      Int
x' <- Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PrimExp v
x
      Int -> PrimExp v -> Maybe Int
descend Int
x' PrimExp v
y
    descend Int
i (ConvOpExp ConvOp
_ PrimExp v
x) = Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PrimExp v
x
    descend Int
i (UnOpExp UnOp
_ PrimExp v
x) = Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) PrimExp v
x
    descend Int
i (FunExp String
_ [PrimExp v]
args PrimType
_) = (Int -> PrimExp v -> Maybe Int) -> Int -> [PrimExp v] -> Maybe Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Int -> PrimExp v -> Maybe Int
descend (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [PrimExp v]
args

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

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

instance IntExp Int8

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

instance IntExp Int16

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

instance IntExp Int32

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

instance IntExp 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

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

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

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

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

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

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

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

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

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

  fromInteger :: Integer -> TPrimExp t v
fromInteger = Integer -> TPrimExp t v
forall t v. NumExp t => Integer -> TPrimExp t v
fromInteger'

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

  fromRational :: Rational -> TPrimExp t v
fromRational = Rational -> TPrimExp t v
forall t v. FloatExp t => Rational -> TPrimExp t v
fromRational'

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

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

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

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

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

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

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

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

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

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

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

-- | Lifted bitwise operators.  The right-shift is logical, *not* arithmetic.
(.&.), (.|.), (.^.), (.>>.), (.<<.) :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp :: (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp :: (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
op (TPrimExp PrimExp v
x) (TPrimExp PrimExp v
y) =
  PrimExp v -> TPrimExp t v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp t v) -> PrimExp v -> TPrimExp t v
forall a b. (a -> b) -> a -> b
$
    PrimExp v -> PrimExp v
forall v. PrimExp v -> PrimExp v
constFoldPrimExp (PrimExp v -> PrimExp v) -> PrimExp v -> PrimExp v
forall a b. (a -> b) -> a -> b
$
      BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
op (IntType -> BinOp) -> IntType -> BinOp
forall a b. (a -> b) -> a -> b
$ PrimExp v -> IntType
forall v. PrimExp v -> IntType
primExpIntType PrimExp v
x) PrimExp v
x PrimExp v
y
.&. :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.&.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall t v.
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
And
.|. :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.|.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall t v.
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
Or
.^. :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.^.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall t v.
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
Xor
.>>. :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.>>.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall t v.
(IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
bitPrimExp IntType -> BinOp
LShr
.<<. :: TPrimExp t v -> TPrimExp t v -> TPrimExp t v
(.<<.) = (IntType -> BinOp) -> TPrimExp t v -> TPrimExp t v -> TPrimExp t v
forall t 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 :: IntType -> PrimExp v -> PrimExp v
sExt IntType
it (ValueExp (IntValue IntValue
v)) = PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntType -> IntValue
doSExt IntValue
v IntType
it
sExt IntType
it PrimExp v
e
  | PrimExp v -> IntType
forall v. PrimExp v -> IntType
primExpIntType PrimExp v
e IntType -> IntType -> Bool
forall a. Eq a => a -> a -> Bool
== IntType
it = PrimExp v
e
  | Bool
otherwise = ConvOp -> PrimExp v -> PrimExp v
forall v. ConvOp -> PrimExp v -> PrimExp v
ConvOpExp (IntType -> IntType -> ConvOp
SExt (PrimExp v -> IntType
forall v. PrimExp v -> IntType
primExpIntType PrimExp v
e) IntType
it) PrimExp v
e

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

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

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

numBad :: Pretty a => String -> a -> b
numBad :: String -> a -> b
numBad String
s a
x =
  String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"Invalid argument to PrimExp method " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
pretty 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 :: (v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f (LeafExp v
v PrimType
_) = v -> m PrimValue
f v
v
evalPrimExp v -> m PrimValue
_ (ValueExp PrimValue
v) = PrimValue -> m PrimValue
forall (m :: * -> *) a. Monad m => a -> m a
return PrimValue
v
evalPrimExp v -> m PrimValue
f (BinOpExp BinOp
op PrimExp v
x PrimExp v
y) = do
  PrimValue
x' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  PrimValue
y' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
y
  m PrimValue
-> (PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BinOp -> (PrimExp v, PrimExp v) -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad BinOp
op (PrimExp v
x, PrimExp v
y)) PrimValue -> m PrimValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimValue -> PrimValue -> Maybe PrimValue
doBinOp BinOp
op PrimValue
x' PrimValue
y'
evalPrimExp v -> m PrimValue
f (CmpOpExp CmpOp
op PrimExp v
x PrimExp v
y) = do
  PrimValue
x' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  PrimValue
y' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
y
  m PrimValue -> (Bool -> m PrimValue) -> Maybe Bool -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CmpOp -> (PrimExp v, PrimExp v) -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad CmpOp
op (PrimExp v
x, PrimExp v
y)) (PrimValue -> m PrimValue
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimValue -> m PrimValue)
-> (Bool -> PrimValue) -> Bool -> m PrimValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bool -> PrimValue
BoolValue) (Maybe Bool -> m PrimValue) -> Maybe Bool -> m PrimValue
forall a b. (a -> b) -> a -> b
$ CmpOp -> PrimValue -> PrimValue -> Maybe Bool
doCmpOp CmpOp
op PrimValue
x' PrimValue
y'
evalPrimExp v -> m PrimValue
f (UnOpExp UnOp
op PrimExp v
x) = do
  PrimValue
x' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  m PrimValue
-> (PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UnOp -> PrimExp v -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad UnOp
op PrimExp v
x) PrimValue -> m PrimValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall a b. (a -> b) -> a -> b
$ UnOp -> PrimValue -> Maybe PrimValue
doUnOp UnOp
op PrimValue
x'
evalPrimExp v -> m PrimValue
f (ConvOpExp ConvOp
op PrimExp v
x) = do
  PrimValue
x' <- (v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f PrimExp v
x
  m PrimValue
-> (PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConvOp -> PrimExp v -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad ConvOp
op PrimExp v
x) PrimValue -> m PrimValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall a b. (a -> b) -> a -> b
$ ConvOp -> PrimValue -> Maybe PrimValue
doConvOp ConvOp
op PrimValue
x'
evalPrimExp v -> m PrimValue
f (FunExp String
h [PrimExp v]
args PrimType
_) = do
  [PrimValue]
args' <- (PrimExp v -> m PrimValue) -> [PrimExp v] -> m [PrimValue]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((v -> m PrimValue) -> PrimExp v -> m PrimValue
forall v (m :: * -> *).
(Pretty v, MonadFail m) =>
(v -> m PrimValue) -> PrimExp v -> m PrimValue
evalPrimExp v -> m PrimValue
f) [PrimExp v]
args
  m PrimValue
-> (PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> [PrimExp v] -> m PrimValue
forall a b (m :: * -> *) c.
(Pretty a, Pretty b, MonadFail m) =>
a -> b -> m c
evalBad String
h [PrimExp v]
args) PrimValue -> m PrimValue
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PrimValue -> m PrimValue) -> Maybe PrimValue -> m PrimValue
forall a b. (a -> b) -> a -> b
$ do
    ([PrimType]
_, PrimType
_, [PrimValue] -> Maybe PrimValue
fun) <- String
-> Map
     String ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)
-> Maybe ([PrimType], PrimType, [PrimValue] -> Maybe PrimValue)
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 :: a -> b -> m c
evalBad a
op b
arg =
  String -> m c
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m c) -> String -> m c
forall a b. (a -> b) -> a -> b
$
    String
"evalPrimExp: Type error when applying "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Pretty a => a -> String
pretty a
op
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to "
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ b -> String
forall a. Pretty a => a -> String
pretty 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 :: PrimExp v -> PrimType
primExpType (LeafExp v
_ PrimType
t) = PrimType
t
primExpType (ValueExp PrimValue
v) = PrimValue -> PrimType
primValueType PrimValue
v
primExpType (BinOpExp BinOp
op PrimExp v
_ PrimExp v
_) = BinOp -> PrimType
binOpType BinOp
op
primExpType CmpOpExp {} = PrimType
Bool
primExpType (UnOpExp UnOp
op PrimExp v
_) = UnOp -> PrimType
unOpType UnOp
op
primExpType (ConvOpExp ConvOp
op PrimExp v
_) = (PrimType, PrimType) -> PrimType
forall a b. (a, b) -> b
snd ((PrimType, PrimType) -> PrimType)
-> (PrimType, PrimType) -> PrimType
forall a b. (a -> b) -> a -> b
$ ConvOp -> (PrimType, PrimType)
convOpType ConvOp
op
primExpType (FunExp String
_ [PrimExp v]
_ PrimType
t) = PrimType
t

-- | Is the expression a constant zero of some sort?
zeroIshExp :: PrimExp v -> Bool
zeroIshExp :: PrimExp v -> 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 :: PrimExp v -> Bool
oneIshExp (ValueExp PrimValue
v) = PrimValue -> Bool
oneIsh PrimValue
v
oneIshExp 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 :: IntType -> PrimExp v -> PrimExp v
coerceIntPrimExp IntType
t (ValueExp (IntValue IntValue
v)) = PrimValue -> PrimExp v
forall v. PrimValue -> PrimExp v
ValueExp (PrimValue -> PrimExp v) -> PrimValue -> PrimExp v
forall a b. (a -> b) -> a -> b
$ IntValue -> PrimValue
IntValue (IntValue -> PrimValue) -> IntValue -> PrimValue
forall a b. (a -> b) -> a -> b
$ IntValue -> IntType -> IntValue
doSExt IntValue
v IntType
t
coerceIntPrimExp IntType
_ PrimExp v
e = PrimExp v
e

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

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

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

-- | SMax on 32-bit integers.
sMax32 :: TPrimExp Int32 v -> TPrimExp Int32 v -> TPrimExp Int32 v
sMax32 :: TPrimExp Int32 v -> TPrimExp Int32 v -> TPrimExp Int32 v
sMax32 TPrimExp Int32 v
x TPrimExp Int32 v
y = PrimExp v -> TPrimExp Int32 v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Int32 v) -> PrimExp v -> TPrimExp Int32 v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMax IntType
Int32) (TPrimExp Int32 v -> PrimExp v
forall t v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int32 v
x) (TPrimExp Int32 v -> PrimExp v
forall t 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 :: TPrimExp Int32 v -> TPrimExp Int32 v -> TPrimExp Int32 v
sMin32 TPrimExp Int32 v
x TPrimExp Int32 v
y = PrimExp v -> TPrimExp Int32 v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Int32 v) -> PrimExp v -> TPrimExp Int32 v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMin IntType
Int32) (TPrimExp Int32 v -> PrimExp v
forall t v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int32 v
x) (TPrimExp Int32 v -> PrimExp v
forall t 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 :: TPrimExp Int64 v -> TPrimExp Int64 v -> TPrimExp Int64 v
sMax64 TPrimExp Int64 v
x TPrimExp Int64 v
y = PrimExp v -> TPrimExp Int64 v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Int64 v) -> PrimExp v -> TPrimExp Int64 v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMax IntType
Int64) (TPrimExp Int64 v -> PrimExp v
forall t v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int64 v
x) (TPrimExp Int64 v -> PrimExp v
forall t 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 :: TPrimExp Int64 v -> TPrimExp Int64 v -> TPrimExp Int64 v
sMin64 TPrimExp Int64 v
x TPrimExp Int64 v
y = PrimExp v -> TPrimExp Int64 v
forall t v. PrimExp v -> TPrimExp t v
TPrimExp (PrimExp v -> TPrimExp Int64 v) -> PrimExp v -> TPrimExp Int64 v
forall a b. (a -> b) -> a -> b
$ BinOp -> PrimExp v -> PrimExp v -> PrimExp v
forall v. BinOp -> PrimExp v -> PrimExp v -> PrimExp v
BinOpExp (IntType -> BinOp
SMin IntType
Int64) (TPrimExp Int64 v -> PrimExp v
forall t v. TPrimExp t v -> PrimExp v
untyped TPrimExp Int64 v
x) (TPrimExp Int64 v -> PrimExp v
forall t 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 :: TPrimExp t v -> TPrimExp Int32 v
sExt32 = PrimExp v -> TPrimExp Int32 v
forall v. PrimExp v -> TPrimExp Int32 v
isInt32 (PrimExp v -> TPrimExp Int32 v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> TPrimExp Int32 v
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntType -> PrimExp v -> PrimExp v
forall v. IntType -> PrimExp v -> PrimExp v
sExt IntType
Int32 (PrimExp v -> PrimExp v)
-> (TPrimExp t v -> PrimExp v) -> TPrimExp t v -> PrimExp v
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TPrimExp t v -> PrimExp v
forall t v. TPrimExp t v -> PrimExp v
untyped

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

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

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

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

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

-- Prettyprinting instances

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

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