{-|
Module      : What4.Expr.Builder
Description : Main definitions of the What4 expression representation
Copyright   : (c) Galois Inc, 2015-2020
License     : BSD3
Maintainer  : jhendrix@galois.com

This module defines the canonical implementation of the solver interface
from "What4.Interface". Type @'ExprBuilder' t st@ is
an instance of the classes 'IsExprBuilder' and 'IsSymExprBuilder'.

Notes regarding concurrency: The expression builder datatype contains
a number of mutable storage locations.  These are designed so they
may reasonably be used in a multithreaded context.  In particular,
nonce values are generated atomically, and other IORefs used in this
module are modified or written atomically, so modifications should
propagate in the expected sequentially-consistent ways.  Of course,
threads may still clobber state others have set (e.g., the current
program location) so the potential for truly multithreaded use is
somewhat limited.  Consider the @exprBuilderFreshConfig@ or
@exprBuilderSplitConfig@ operations if this is a concern.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
module What4.Expr.Builder
  ( -- * ExprBuilder
    ExprBuilder
  , newExprBuilder
  , getSymbolVarBimap
  , sbMakeExpr
  , sbNonceExpr
  , curProgramLoc
  , unaryThreshold
  , pushMuxOps
  , cacheStartSize
  , userState
  , exprCounter
  , startCaching
  , stopCaching
  , exprBuilderSplitConfig
  , exprBuilderFreshConfig

    -- * Specialized representations
  , bvUnary
  , intSum
  , realSum
  , bvSum
  , scalarMul

    -- * configuration options
  , unaryThresholdOption
  , cacheStartSizeOption
  , pushMuxOpsOption
  , cacheTerms

    -- * Expr
  , Expr(..)
  , asApp
  , asNonceApp
  , iteSize
  , exprLoc
  , ppExpr
  , ppExprTop
  , exprMaybeId
  , asConjunction
  , asDisjunction
  , Polarity(..)
  , BM.negatePolarity
    -- ** AppExpr
  , AppExpr
  , appExprId
  , appExprLoc
  , appExprApp
    -- ** NonceAppExpr
  , NonceAppExpr
  , nonceExprId
  , nonceExprLoc
  , nonceExprApp
    -- ** Type abbreviations
  , BoolExpr
  , IntegerExpr
  , RealExpr
  , FloatExpr
  , BVExpr
  , CplxExpr
  , StringExpr

    -- * App
  , App(..)
  , traverseApp
  , appType
    -- * NonceApp
  , NonceApp(..)
  , nonceAppType

    -- * Bound Variable information
  , ExprBoundVar
  , bvarId
  , bvarLoc
  , bvarName
  , bvarType
  , bvarKind
  , bvarAbstractValue
  , VarKind(..)
  , boundVars
  , ppBoundVar
  , evalBoundVars

    -- * Symbolic Function
  , ExprSymFn(..)
  , SymFnInfo(..)
  , symFnArgTypes
  , symFnReturnType
  , SomeExprSymFn(..)
  , ExprSymFnWrapper(..)

    -- * SymbolVarBimap
  , SymbolVarBimap
  , SymbolBinding(..)
  , emptySymbolVarBimap
  , lookupBindingOfSymbol
  , lookupSymbolOfBinding

    -- * IdxCache
  , IdxCache
  , newIdxCache
  , lookupIdx
  , lookupIdxValue
  , insertIdxValue
  , deleteIdxValue
  , clearIdxCache
  , idxCacheEval
  , idxCacheEval'

    -- * Flags
  , type FloatMode
  , FloatModeRepr(..)
  , FloatIEEE
  , FloatUninterpreted
  , FloatReal
  , Flags

    -- * BV Or Set
  , BVOrSet
  , bvOrToList
  , bvOrSingleton
  , bvOrInsert
  , bvOrUnion
  , bvOrAbs
  , traverseBVOrSet

    -- * Re-exports
  , SymExpr
  , What4.Interface.bvWidth
  , What4.Interface.exprType
  , What4.Interface.IndexLit(..)
  , What4.Interface.ArrayResultWrapper(..)
  ) where

import qualified Control.Exception as Ex
import           Control.Lens hiding (asIndex, (:>), Empty)
import           Control.Monad
import           Control.Monad.Except
import           Control.Monad.Reader
import           Control.Monad.ST
import           Control.Monad.Trans.Writer.Strict (writer, runWriter)
import qualified Data.BitVector.Sized as BV
import           Data.Bimap (Bimap)
import qualified Data.Bimap as Bimap

import           Data.Hashable
import qualified Data.HashTable.Class as HC
import qualified Data.HashTable.IO as H
import           Data.IORef
import           Data.Kind
import           Data.List.NonEmpty (NonEmpty(..))
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe
import           Data.Monoid (Any(..))
import           Data.Parameterized.Classes
import           Data.Parameterized.Context as Ctx
import qualified Data.Parameterized.HashTable as PH
import qualified Data.Parameterized.Map as PM
import           Data.Parameterized.NatRepr
import           Data.Parameterized.Nonce
import           Data.Parameterized.Some
import           Data.Parameterized.TraversableFC
import           Data.Ratio (numerator, denominator)
import           Data.Set (Set)
import qualified Data.Set as Set
import           GHC.Float (castFloatToWord32, castDoubleToWord64)
import qualified LibBF as BF

import           What4.BaseTypes
import           What4.Concrete
import qualified What4.Config as CFG
import           What4.FloatMode
import           What4.Interface
import           What4.InterpretedFloatingPoint
import           What4.ProgramLoc
import qualified What4.SemiRing as SR
import qualified What4.SpecialFunctions as SFn
import           What4.Symbol

import           What4.Expr.Allocator
import           What4.Expr.App
import qualified What4.Expr.ArrayUpdateMap as AUM
import           What4.Expr.BoolMap (BoolMap, Polarity(..), BoolMapView(..))
import qualified What4.Expr.BoolMap as BM
import           What4.Expr.MATLAB
import           What4.Expr.WeightedSum (WeightedSum, SemiRingProduct)
import qualified What4.Expr.WeightedSum as WSum
import qualified What4.Expr.StringSeq as SSeq
import           What4.Expr.UnaryBV (UnaryBV)
import qualified What4.Expr.UnaryBV as UnaryBV
import qualified What4.Expr.VarIdentification as VI

import           What4.Utils.AbstractDomains
import           What4.Utils.Arithmetic
import qualified What4.Utils.BVDomain as BVD
import           What4.Utils.Complex
import           What4.Utils.FloatHelpers
import           What4.Utils.StringLiteral

------------------------------------------------------------------------
-- Utilities

toDouble :: Rational -> Double
toDouble :: Rational -> Double
toDouble = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational

cachedEval :: (HashableF k, TestEquality k, MonadIO m)
           => PH.HashTable RealWorld k a
           -> k tp
           -> m (a tp)
           -> m (a tp)
cachedEval :: forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
       (tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval HashTable RealWorld k a
tbl k tp
k m (a tp)
action = do
  Maybe (a tp)
mr <- IO (Maybe (a tp)) -> m (Maybe (a tp))
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (a tp)) -> m (Maybe (a tp)))
-> IO (Maybe (a tp)) -> m (Maybe (a tp))
forall a b. (a -> b) -> a -> b
$ ST RealWorld (Maybe (a tp)) -> IO (Maybe (a tp))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Maybe (a tp)) -> IO (Maybe (a tp)))
-> ST RealWorld (Maybe (a tp)) -> IO (Maybe (a tp))
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld k a -> k tp -> ST RealWorld (Maybe (a tp))
forall {k} (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> ST s (Maybe (val tp))
PH.lookup HashTable RealWorld k a
tbl k tp
k
  case Maybe (a tp)
mr of
    Just a tp
r -> a tp -> m (a tp)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a tp
r
    Maybe (a tp)
Nothing -> do
      a tp
r <- m (a tp)
action
      a tp -> m (a tp) -> m (a tp)
forall a b. a -> b -> b
seq a tp
r (m (a tp) -> m (a tp)) -> m (a tp) -> m (a tp)
forall a b. (a -> b) -> a -> b
$ do
      IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld k a -> k tp -> a tp -> ST RealWorld ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld k a
tbl k tp
k a tp
r
      a tp -> m (a tp)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a tp
r

------------------------------------------------------------------------
-- SymbolVarBimap

-- | A bijective map between vars and their canonical name for printing
-- purposes.
-- Parameter @t@ is a phantom type brand used to track nonces.
newtype SymbolVarBimap t = SymbolVarBimap (Bimap SolverSymbol (SymbolBinding t))

-- | This describes what a given SolverSymbol is associated with.
-- Parameter @t@ is a phantom type brand used to track nonces.
data SymbolBinding t
   = forall tp . VarSymbolBinding !(ExprBoundVar t tp)
     -- ^ Solver
   | forall args ret . FnSymbolBinding  !(ExprSymFn t args ret)

instance Eq (SymbolBinding t) where
  VarSymbolBinding ExprBoundVar t tp
x == :: SymbolBinding t -> SymbolBinding t -> Bool
== VarSymbolBinding ExprBoundVar t tp
y = Maybe (tp :~: tp) -> Bool
forall a. Maybe a -> Bool
isJust (ExprBoundVar t tp -> ExprBoundVar t tp -> Maybe (tp :~: tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
ExprBoundVar t a -> ExprBoundVar t b -> Maybe (a :~: b)
testEquality ExprBoundVar t tp
x ExprBoundVar t tp
y)
  FnSymbolBinding  ExprSymFn t args ret
x == FnSymbolBinding  ExprSymFn t args ret
y = Maybe ((args ::> ret) :~: (args ::> ret)) -> Bool
forall a. Maybe a -> Bool
isJust (Nonce t (args ::> ret)
-> Nonce t (args ::> ret)
-> Maybe ((args ::> ret) :~: (args ::> ret))
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Ctx BaseType) (b :: Ctx BaseType).
Nonce t a -> Nonce t b -> Maybe (a :~: b)
testEquality (ExprSymFn t args ret -> Nonce t (args ::> ret)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
x) (ExprSymFn t args ret -> Nonce t (args ::> ret)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
y))
  SymbolBinding t
_ == SymbolBinding t
_ = Bool
False

instance Ord (SymbolBinding t) where
  compare :: SymbolBinding t -> SymbolBinding t -> Ordering
compare (VarSymbolBinding ExprBoundVar t tp
x) (VarSymbolBinding ExprBoundVar t tp
y) =
    OrderingF tp tp -> Ordering
forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (ExprBoundVar t tp -> ExprBoundVar t tp -> OrderingF tp tp
forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
forall (x :: BaseType) (y :: BaseType).
ExprBoundVar t x -> ExprBoundVar t y -> OrderingF x y
compareF ExprBoundVar t tp
x ExprBoundVar t tp
y)
  compare VarSymbolBinding{} SymbolBinding t
_ = Ordering
LT
  compare SymbolBinding t
_ VarSymbolBinding{} = Ordering
GT
  compare (FnSymbolBinding  ExprSymFn t args ret
x) (FnSymbolBinding  ExprSymFn t args ret
y) =
    OrderingF (args ::> ret) (args ::> ret) -> Ordering
forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (Nonce t (args ::> ret)
-> Nonce t (args ::> ret)
-> OrderingF (args ::> ret) (args ::> ret)
forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
forall (x :: Ctx BaseType) (y :: Ctx BaseType).
Nonce t x -> Nonce t y -> OrderingF x y
compareF (ExprSymFn t args ret -> Nonce t (args ::> ret)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
x) (ExprSymFn t args ret -> Nonce t (args ::> ret)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
y))

-- | Empty symbol var bimap
emptySymbolVarBimap :: SymbolVarBimap t
emptySymbolVarBimap :: forall t. SymbolVarBimap t
emptySymbolVarBimap = Bimap SolverSymbol (SymbolBinding t) -> SymbolVarBimap t
forall t. Bimap SolverSymbol (SymbolBinding t) -> SymbolVarBimap t
SymbolVarBimap Bimap SolverSymbol (SymbolBinding t)
forall a b. Bimap a b
Bimap.empty

lookupBindingOfSymbol :: SolverSymbol -> SymbolVarBimap t -> Maybe (SymbolBinding t)
lookupBindingOfSymbol :: forall t.
SolverSymbol -> SymbolVarBimap t -> Maybe (SymbolBinding t)
lookupBindingOfSymbol SolverSymbol
s (SymbolVarBimap Bimap SolverSymbol (SymbolBinding t)
m) = SolverSymbol
-> Bimap SolverSymbol (SymbolBinding t) -> Maybe (SymbolBinding t)
forall a b (m :: Type -> Type).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
Bimap.lookup SolverSymbol
s Bimap SolverSymbol (SymbolBinding t)
m

lookupSymbolOfBinding :: SymbolBinding t -> SymbolVarBimap t -> Maybe SolverSymbol
lookupSymbolOfBinding :: forall t. SymbolBinding t -> SymbolVarBimap t -> Maybe SolverSymbol
lookupSymbolOfBinding SymbolBinding t
b (SymbolVarBimap Bimap SolverSymbol (SymbolBinding t)
m) = SymbolBinding t
-> Bimap SolverSymbol (SymbolBinding t) -> Maybe SolverSymbol
forall a b (m :: Type -> Type).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
Bimap.lookupR SymbolBinding t
b Bimap SolverSymbol (SymbolBinding t)
m

------------------------------------------------------------------------
-- MatlabSolverFn

-- Parameter @t@ is a phantom type brand used to track nonces.
data MatlabFnWrapper t c where
   MatlabFnWrapper :: !(MatlabSolverFn (Expr t) a r) -> MatlabFnWrapper t (a::> r)

instance TestEquality (MatlabFnWrapper t) where
  testEquality :: forall (a :: Ctx BaseType) (b :: Ctx BaseType).
MatlabFnWrapper t a -> MatlabFnWrapper t b -> Maybe (a :~: b)
testEquality (MatlabFnWrapper MatlabSolverFn (Expr t) a r
f) (MatlabFnWrapper MatlabSolverFn (Expr t) a r
g) = do
    (a '::> r) :~: (a '::> r)
Refl <- MatlabSolverFn (Expr t) a r
-> MatlabSolverFn (Expr t) a r -> Maybe ((a '::> r) :~: (a '::> r))
forall (f :: BaseType -> Type) (ax :: Ctx BaseType)
       (rx :: BaseType) (ay :: Ctx BaseType) (ry :: BaseType).
TestEquality f =>
MatlabSolverFn f ax rx
-> MatlabSolverFn f ay ry -> Maybe ((ax ::> rx) :~: (ay ::> ry))
testSolverFnEq MatlabSolverFn (Expr t) a r
f MatlabSolverFn (Expr t) a r
g
    (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl


instance HashableF (MatlabFnWrapper t) where
  hashWithSaltF :: forall (tp :: Ctx BaseType). Int -> MatlabFnWrapper t tp -> Int
hashWithSaltF Int
s (MatlabFnWrapper MatlabSolverFn (Expr t) a r
f) = Int -> MatlabSolverFn (Expr t) a r -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s MatlabSolverFn (Expr t) a r
f

data ExprSymFnWrapper t c
   = forall a r . (c ~ (a ::> r)) => ExprSymFnWrapper (ExprSymFn t a r)

data SomeExprSymFn t = forall args ret . SomeExprSymFn (ExprSymFn t args ret)

instance Eq (SomeExprSymFn t) where
  (SomeExprSymFn ExprSymFn t args ret
fn1) == :: SomeExprSymFn t -> SomeExprSymFn t -> Bool
== (SomeExprSymFn ExprSymFn t args ret
fn2) =
    Maybe ((args ::> ret) :~: (args ::> ret)) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ((args ::> ret) :~: (args ::> ret)) -> Bool)
-> Maybe ((args ::> ret) :~: (args ::> ret)) -> Bool
forall a b. (a -> b) -> a -> b
$ ExprSymFn t args ret
-> ExprSymFn t args ret
-> Maybe ((args ::> ret) :~: (args ::> ret))
forall (args1 :: Ctx BaseType) (ret1 :: BaseType)
       (args2 :: Ctx BaseType) (ret2 :: BaseType).
ExprSymFn t args1 ret1
-> ExprSymFn t args2 ret2
-> Maybe ((args1 ::> ret1) :~: (args2 ::> ret2))
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args1 :: Ctx BaseType) (ret1 :: BaseType) (args2 :: Ctx BaseType)
       (ret2 :: BaseType).
IsSymFn fn =>
fn args1 ret1
-> fn args2 ret2 -> Maybe ((args1 ::> ret1) :~: (args2 ::> ret2))
fnTestEquality ExprSymFn t args ret
fn1 ExprSymFn t args ret
fn2

instance Ord (SomeExprSymFn t) where
  compare :: SomeExprSymFn t -> SomeExprSymFn t -> Ordering
compare (SomeExprSymFn ExprSymFn t args ret
fn1) (SomeExprSymFn ExprSymFn t args ret
fn2) =
    OrderingF (args ::> ret) (args ::> ret) -> Ordering
forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (OrderingF (args ::> ret) (args ::> ret) -> Ordering)
-> OrderingF (args ::> ret) (args ::> ret) -> Ordering
forall a b. (a -> b) -> a -> b
$ ExprSymFn t args ret
-> ExprSymFn t args ret -> OrderingF (args ::> ret) (args ::> ret)
forall (args1 :: Ctx BaseType) (ret1 :: BaseType)
       (args2 :: Ctx BaseType) (ret2 :: BaseType).
ExprSymFn t args1 ret1
-> ExprSymFn t args2 ret2
-> OrderingF (args1 ::> ret1) (args2 ::> ret2)
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args1 :: Ctx BaseType) (ret1 :: BaseType) (args2 :: Ctx BaseType)
       (ret2 :: BaseType).
IsSymFn fn =>
fn args1 ret1
-> fn args2 ret2 -> OrderingF (args1 ::> ret1) (args2 ::> ret2)
fnCompare ExprSymFn t args ret
fn1 ExprSymFn t args ret
fn2

instance Hashable (SomeExprSymFn t) where
  hashWithSalt :: Int -> SomeExprSymFn t -> Int
hashWithSalt Int
s (SomeExprSymFn ExprSymFn t args ret
fn) = Int -> ExprSymFn t args ret -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s ExprSymFn t args ret
fn

instance Show (SomeExprSymFn t) where
  show :: SomeExprSymFn t -> String
show (SomeExprSymFn ExprSymFn t args ret
f) = ExprSymFn t args ret -> String
forall a. Show a => a -> String
show ExprSymFn t args ret
f


------------------------------------------------------------------------
-- ExprBuilder

data Flags (fi :: FloatMode)


-- | Cache for storing dag terms.
-- Parameter @t@ is a phantom type brand used to track nonces.
data ExprBuilder t (st :: Type -> Type) (fs :: Type)
   = forall fm. (fs ~ (Flags fm)) =>
     SB { forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> BoolExpr t
sbTrue  :: !(BoolExpr t)
        , forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> BoolExpr t
sbFalse :: !(BoolExpr t)

          -- | Constant zero.
        , forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> RealExpr t
sbZero  :: !(RealExpr t)

          -- | Configuration object for this symbolic backend
        , forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Config
sbConfiguration :: !CFG.Config

          -- | Flag used to tell the backend whether to evaluate
          -- ground rational values as double precision floats when
          -- a function cannot be evaluated as a rational.
        , forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce :: !Bool

          -- | The maximum number of distinct values a term may have and use the
          -- unary representation.
        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold :: !(CFG.OptionSetting BaseIntegerType)

          -- | The starting size when building a new cache
        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize :: !(CFG.OptionSetting BaseIntegerType)

          -- | If enabled, push certain 'ExprBuilder' operations (e.g., @zext@)
          -- down to the branches of @ite@ expressions. In some (but not all)
          -- circumstances, this can result in operations that are easier for
          -- SMT solvers to reason about.
        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseBoolType
sbPushMuxOps :: !(CFG.OptionSetting BaseBoolType)

          -- | Counter to generate new unique identifiers for elements and functions.
        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter :: !(NonceGenerator IO t)

          -- | Reference to current allocator for expressions.
        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator :: !(IORef (ExprAllocator t))

          -- | Number of times an 'Expr' for a non-linear operation has been
          -- created.
        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef Integer
sbNonLinearOps :: !(IORef Integer)

          -- | The current program location
        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef ProgramLoc
sbProgramLoc :: !(IORef ProgramLoc)

          -- | User-provided state
        , forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> st t
sbUserState :: !(st t)

        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings :: !(IORef (SymbolVarBimap t))

        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> IORef
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
sbUninterpFnCache :: !(IORef (Map (SolverSymbol, Some (Ctx.Assignment BaseTypeRepr)) (SomeSymFn (ExprBuilder t st fs))))

          -- | Cache for Matlab functions
        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
sbMatlabFnCache :: !(PH.HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t))

        , forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger :: !(IORef (Maybe (SolverEvent -> IO ())))

          -- | Flag dictating how floating-point values/operations are translated
          -- when passed to the solver.
        , ()
sbFloatMode :: !(FloatModeRepr fm)
        }

type instance SymFn (ExprBuilder t st fs) = ExprSymFn t
type instance SymExpr (ExprBuilder t st fs) = Expr t
type instance BoundVar (ExprBuilder t st fs) = ExprBoundVar t
type instance SymAnnotation (ExprBuilder t st fs) = Nonce t

exprCounter :: Getter (ExprBuilder t st fs) (NonceGenerator IO t)
exprCounter :: forall t (st :: Type -> Type) fs (f :: Type -> Type).
(Contravariant f, Functor f) =>
(NonceGenerator IO t -> f (NonceGenerator IO t))
-> ExprBuilder t st fs -> f (ExprBuilder t st fs)
exprCounter = (ExprBuilder t st fs -> NonceGenerator IO t)
-> (NonceGenerator IO t -> f (NonceGenerator IO t))
-> ExprBuilder t st fs
-> f (ExprBuilder t st fs)
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter

userState :: Lens' (ExprBuilder t st fs) (st t)
userState :: forall t (st :: Type -> Type) fs (f :: Type -> Type).
Functor f =>
(st t -> f (st t))
-> ExprBuilder t st fs -> f (ExprBuilder t st fs)
userState = (ExprBuilder t st fs -> st t)
-> (ExprBuilder t st fs -> st t -> ExprBuilder t st fs)
-> Lens (ExprBuilder t st fs) (ExprBuilder t st fs) (st t) (st t)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ExprBuilder t st fs -> st t
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> st t
sbUserState (\ExprBuilder t st fs
sym st t
st -> ExprBuilder t st fs
sym{ sbUserState = st })

unaryThreshold :: Getter (ExprBuilder t st fs) (CFG.OptionSetting BaseIntegerType)
unaryThreshold :: forall t (st :: Type -> Type) fs (f :: Type -> Type).
(Contravariant f, Functor f) =>
(OptionSetting BaseIntegerType
 -> f (OptionSetting BaseIntegerType))
-> ExprBuilder t st fs -> f (ExprBuilder t st fs)
unaryThreshold = (ExprBuilder t st fs -> OptionSetting BaseIntegerType)
-> (OptionSetting BaseIntegerType
    -> f (OptionSetting BaseIntegerType))
-> ExprBuilder t st fs
-> f (ExprBuilder t st fs)
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold

cacheStartSize :: Getter (ExprBuilder t st fs) (CFG.OptionSetting BaseIntegerType)
cacheStartSize :: forall t (st :: Type -> Type) fs (f :: Type -> Type).
(Contravariant f, Functor f) =>
(OptionSetting BaseIntegerType
 -> f (OptionSetting BaseIntegerType))
-> ExprBuilder t st fs -> f (ExprBuilder t st fs)
cacheStartSize = (ExprBuilder t st fs -> OptionSetting BaseIntegerType)
-> (OptionSetting BaseIntegerType
    -> f (OptionSetting BaseIntegerType))
-> ExprBuilder t st fs
-> f (ExprBuilder t st fs)
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize

pushMuxOps :: Getter (ExprBuilder t st fs) (CFG.OptionSetting BaseBoolType)
pushMuxOps :: forall t (st :: Type -> Type) fs (f :: Type -> Type).
(Contravariant f, Functor f) =>
(OptionSetting BaseBoolType -> f (OptionSetting BaseBoolType))
-> ExprBuilder t st fs -> f (ExprBuilder t st fs)
pushMuxOps = (ExprBuilder t st fs -> OptionSetting BaseBoolType)
-> (OptionSetting BaseBoolType -> f (OptionSetting BaseBoolType))
-> ExprBuilder t st fs
-> f (ExprBuilder t st fs)
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ExprBuilder t st fs -> OptionSetting BaseBoolType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseBoolType
sbPushMuxOps

-- | Return a new expr builder where the configuration object has
--   been "split" using the @splitConfig@ operation.
--   The returned sym will share any preexisting options with the
--   input sym, but any new options added with @extendConfig@
--   will not be shared. This may be useful if the expression builder
--   needs to be shared across threads, or sequentially for
--   separate use cases.  Note, however, that hash consing settings,
--   solver loggers and the current program location will be shared.
exprBuilderSplitConfig :: ExprBuilder t st fs -> IO (ExprBuilder t st fs)
exprBuilderSplitConfig :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO (ExprBuilder t st fs)
exprBuilderSplitConfig ExprBuilder t st fs
sym =
  do Config
cfg' <- Config -> IO Config
CFG.splitConfig (ExprBuilder t st fs -> Config
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Config
sbConfiguration ExprBuilder t st fs
sym)
     ExprBuilder t st fs -> IO (ExprBuilder t st fs)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprBuilder t st fs
sym{ sbConfiguration = cfg' }


-- | Return a new expr builder where all configuration settings have
--   been isolated from the original. The @Config@ object of the
--   output expr builder will have only the default options that are
--   installed via @newExprBuilder@, and configuration changes
--   to either expr builder will not be visible to the other.
--   This includes caching settings, the current program location,
--   and installed solver loggers.
exprBuilderFreshConfig :: ExprBuilder t st fs -> IO (ExprBuilder t st fs)
exprBuilderFreshConfig :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO (ExprBuilder t st fs)
exprBuilderFreshConfig ExprBuilder t st fs
sym =
  do let gen :: NonceGenerator IO t
gen = ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sym
     ExprAllocator t
es <- NonceGenerator IO t -> IO (ExprAllocator t)
forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage NonceGenerator IO t
gen

     IORef ProgramLoc
loc_ref       <- ProgramLoc -> IO (IORef ProgramLoc)
forall a. a -> IO (IORef a)
newIORef ProgramLoc
initializationLoc
     IORef (ExprAllocator t)
storage_ref   <- ExprAllocator t -> IO (IORef (ExprAllocator t))
forall a. a -> IO (IORef a)
newIORef ExprAllocator t
es
     IORef (Maybe (SolverEvent -> IO ()))
logger_ref    <- Maybe (SolverEvent -> IO ())
-> IO (IORef (Maybe (SolverEvent -> IO ())))
forall a. a -> IO (IORef a)
newIORef Maybe (SolverEvent -> IO ())
forall a. Maybe a
Nothing
     IORef (SymbolVarBimap t)
bindings_ref  <- SymbolVarBimap t -> IO (IORef (SymbolVarBimap t))
forall a. a -> IO (IORef a)
newIORef (SymbolVarBimap t -> IO (IORef (SymbolVarBimap t)))
-> IO (SymbolVarBimap t) -> IO (IORef (SymbolVarBimap t))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (SymbolVarBimap t) -> IO (SymbolVarBimap t)
forall a. IORef a -> IO a
readIORef (ExprBuilder t st fs -> IORef (SymbolVarBimap t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings ExprBuilder t st fs
sym)

     -- Set up configuration options
     Config
cfg <- Integer -> [ConfigDesc] -> IO Config
CFG.initialConfig Integer
0
              [ ConfigDesc
unaryThresholdDesc
              , ConfigDesc
cacheStartSizeDesc
              , ConfigDesc
pushMuxOpsDesc
              ]
     OptionSetting BaseIntegerType
unarySetting       <- ConfigOption BaseIntegerType
-> Config -> IO (OptionSetting BaseIntegerType)
forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
unaryThresholdOption Config
cfg
     OptionSetting BaseIntegerType
cacheStartSetting  <- ConfigOption BaseIntegerType
-> Config -> IO (OptionSetting BaseIntegerType)
forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
cacheStartSizeOption Config
cfg
     OptionSetting BaseBoolType
pushMuxOpsSetting  <- ConfigOption BaseBoolType
-> Config -> IO (OptionSetting BaseBoolType)
forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseBoolType
pushMuxOpsOption Config
cfg
     [ConfigDesc] -> Config -> IO ()
CFG.extendConfig [NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> ConfigDesc
forall t.
NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> ConfigDesc
cacheOptDesc NonceGenerator IO t
gen IORef (ExprAllocator t)
storage_ref OptionSetting BaseIntegerType
cacheStartSetting] Config
cfg
     IORef Integer
nonLinearOps <- Integer -> IO (IORef Integer)
forall a. a -> IO (IORef a)
newIORef Integer
0

     ExprBuilder t st fs -> IO (ExprBuilder t st fs)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprBuilder t st fs
sym { sbConfiguration = cfg
                , sbFloatReduce = True
                , sbUnaryThreshold = unarySetting
                , sbCacheStartSize = cacheStartSetting
                , sbPushMuxOps = pushMuxOpsSetting
                , sbProgramLoc = loc_ref
                , sbCurAllocator = storage_ref
                , sbNonLinearOps = nonLinearOps
                , sbVarBindings = bindings_ref
                , sbSolverLogger = logger_ref
                }

------------------------------------------------------------------------
-- IdxCache

-- | An IdxCache is used to map expressions with type @Expr t tp@ to
-- values with a corresponding type @f tp@. It is a mutable map using
-- an 'IO' hash table. Parameter @t@ is a phantom type brand used to
-- track nonces.
newtype IdxCache t (f :: BaseType -> Type)
      = IdxCache { forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap :: IORef (PM.MapF (Nonce t) f) }

-- | Create a new IdxCache
newIdxCache :: MonadIO m => m (IdxCache t f)
newIdxCache :: forall (m :: Type -> Type) t (f :: BaseType -> Type).
MonadIO m =>
m (IdxCache t f)
newIdxCache = IO (IdxCache t f) -> m (IdxCache t f)
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (IdxCache t f) -> m (IdxCache t f))
-> IO (IdxCache t f) -> m (IdxCache t f)
forall a b. (a -> b) -> a -> b
$ IORef (MapF (Nonce t) f) -> IdxCache t f
forall t (f :: BaseType -> Type).
IORef (MapF (Nonce t) f) -> IdxCache t f
IdxCache (IORef (MapF (Nonce t) f) -> IdxCache t f)
-> IO (IORef (MapF (Nonce t) f)) -> IO (IdxCache t f)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> MapF (Nonce t) f -> IO (IORef (MapF (Nonce t) f))
forall a. a -> IO (IORef a)
newIORef MapF (Nonce t) f
forall {v} (k :: v -> Type) (a :: v -> Type). MapF k a
PM.empty

{-# INLINE lookupIdxValue #-}
-- | Return the value associated to the expr in the index.
lookupIdxValue :: MonadIO m => IdxCache t f -> Expr t tp -> m (Maybe (f tp))
lookupIdxValue :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Expr t tp -> m (Maybe (f tp))
lookupIdxValue IdxCache t f
_ SemiRingLiteral{} = Maybe (f tp) -> m (Maybe (f tp))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (f tp)
forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
_ StringExpr{} = Maybe (f tp) -> m (Maybe (f tp))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (f tp)
forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
_ BoolExpr{} = Maybe (f tp) -> m (Maybe (f tp))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (f tp)
forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
_ FloatExpr{} = Maybe (f tp) -> m (Maybe (f tp))
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Maybe (f tp)
forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
c (NonceAppExpr NonceAppExpr t tp
e) = IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c (NonceAppExpr t tp -> Nonce t tp
forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t tp
e)
lookupIdxValue IdxCache t f
c (AppExpr AppExpr t tp
e)  = IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c (AppExpr t tp -> Nonce t tp
forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t tp
e)
lookupIdxValue IdxCache t f
c (BoundVarExpr ExprBoundVar t tp
i) = IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c (ExprBoundVar t tp -> Nonce t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
i)

{-# INLINE lookupIdx #-}
lookupIdx :: (MonadIO m) => IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c Nonce t tp
n = IO (Maybe (f tp)) -> m (Maybe (f tp))
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (f tp)) -> m (Maybe (f tp)))
-> IO (Maybe (f tp)) -> m (Maybe (f tp))
forall a b. (a -> b) -> a -> b
$ Nonce t tp -> MapF (Nonce t) f -> Maybe (f tp)
forall {v} (k :: v -> Type) (tp :: v) (a :: v -> Type).
OrdF k =>
k tp -> MapF k a -> Maybe (a tp)
PM.lookup Nonce t tp
n (MapF (Nonce t) f -> Maybe (f tp))
-> IO (MapF (Nonce t) f) -> IO (Maybe (f tp))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (MapF (Nonce t) f) -> IO (MapF (Nonce t) f)
forall a. IORef a -> IO a
readIORef (IdxCache t f -> IORef (MapF (Nonce t) f)
forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c)

{-# INLINE insertIdxValue #-}
-- | Bind the value to the given expr in the index.
insertIdxValue :: MonadIO m => IdxCache t f -> Nonce t tp -> f tp -> m ()
insertIdxValue :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> f tp -> m ()
insertIdxValue IdxCache t f
c Nonce t tp
e f tp
v = f tp -> m () -> m ()
forall a b. a -> b -> b
seq f tp
v (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (MapF (Nonce t) f)
-> (MapF (Nonce t) f -> (MapF (Nonce t) f, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (IdxCache t f -> IORef (MapF (Nonce t) f)
forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c) ((MapF (Nonce t) f -> (MapF (Nonce t) f, ())) -> IO ())
-> (MapF (Nonce t) f -> (MapF (Nonce t) f, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ (\MapF (Nonce t) f
m -> (Nonce t tp -> f tp -> MapF (Nonce t) f -> MapF (Nonce t) f
forall {v} (k :: v -> Type) (tp :: v) (a :: v -> Type).
OrdF k =>
k tp -> a tp -> MapF k a -> MapF k a
PM.insert Nonce t tp
e f tp
v MapF (Nonce t) f
m, ()))

{-# INLINE deleteIdxValue #-}
-- | Remove a value from the IdxCache
deleteIdxValue :: MonadIO m => IdxCache t f -> Nonce t (tp :: BaseType) -> m ()
deleteIdxValue :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m ()
deleteIdxValue IdxCache t f
c Nonce t tp
e = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (MapF (Nonce t) f)
-> (MapF (Nonce t) f -> (MapF (Nonce t) f, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (IdxCache t f -> IORef (MapF (Nonce t) f)
forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c) ((MapF (Nonce t) f -> (MapF (Nonce t) f, ())) -> IO ())
-> (MapF (Nonce t) f -> (MapF (Nonce t) f, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ (\MapF (Nonce t) f
m -> (Nonce t tp -> MapF (Nonce t) f -> MapF (Nonce t) f
forall {v} (k :: v -> Type) (tp :: v) (a :: v -> Type).
OrdF k =>
k tp -> MapF k a -> MapF k a
PM.delete Nonce t tp
e MapF (Nonce t) f
m, ()))

-- | Remove all values from the IdxCache
clearIdxCache :: MonadIO m => IdxCache t f -> m ()
clearIdxCache :: forall (m :: Type -> Type) t (f :: BaseType -> Type).
MonadIO m =>
IdxCache t f -> m ()
clearIdxCache IdxCache t f
c = IO () -> m ()
forall a. IO a -> m a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (MapF (Nonce t) f) -> MapF (Nonce t) f -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef (IdxCache t f -> IORef (MapF (Nonce t) f)
forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c) MapF (Nonce t) f
forall {v} (k :: v -> Type) (a :: v -> Type). MapF k a
PM.empty

exprMaybeId :: Expr t tp -> Maybe (Nonce t tp)
exprMaybeId :: forall t (tp :: BaseType). Expr t tp -> Maybe (Nonce t tp)
exprMaybeId SemiRingLiteral{} = Maybe (Nonce t tp)
forall a. Maybe a
Nothing
exprMaybeId StringExpr{} = Maybe (Nonce t tp)
forall a. Maybe a
Nothing
exprMaybeId BoolExpr{} = Maybe (Nonce t tp)
forall a. Maybe a
Nothing
exprMaybeId FloatExpr{} = Maybe (Nonce t tp)
forall a. Maybe a
Nothing
exprMaybeId (NonceAppExpr NonceAppExpr t tp
e) = Nonce t tp -> Maybe (Nonce t tp)
forall a. a -> Maybe a
Just (Nonce t tp -> Maybe (Nonce t tp))
-> Nonce t tp -> Maybe (Nonce t tp)
forall a b. (a -> b) -> a -> b
$! NonceAppExpr t tp -> Nonce t tp
forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t tp
e
exprMaybeId (AppExpr  AppExpr t tp
e) = Nonce t tp -> Maybe (Nonce t tp)
forall a. a -> Maybe a
Just (Nonce t tp -> Maybe (Nonce t tp))
-> Nonce t tp -> Maybe (Nonce t tp)
forall a b. (a -> b) -> a -> b
$! AppExpr t tp -> Nonce t tp
forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t tp
e
exprMaybeId (BoundVarExpr ExprBoundVar t tp
e) = Nonce t tp -> Maybe (Nonce t tp)
forall a. a -> Maybe a
Just (Nonce t tp -> Maybe (Nonce t tp))
-> Nonce t tp -> Maybe (Nonce t tp)
forall a b. (a -> b) -> a -> b
$! ExprBoundVar t tp -> Nonce t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
e

-- | Implements a cached evaluated using the given element.  Given an element
-- this function returns the value of the element if bound, and otherwise
-- calls the evaluation function, stores the result in the cache, and
-- returns the value.
{-# INLINE idxCacheEval #-}
idxCacheEval :: (MonadIO m)
             => IdxCache t f
             -> Expr t tp
             -> m (f tp)
             -> m (f tp)
idxCacheEval :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Expr t tp -> m (f tp) -> m (f tp)
idxCacheEval IdxCache t f
c Expr t tp
e m (f tp)
m = do
  case Expr t tp -> Maybe (Nonce t tp)
forall t (tp :: BaseType). Expr t tp -> Maybe (Nonce t tp)
exprMaybeId Expr t tp
e of
    Maybe (Nonce t tp)
Nothing -> m (f tp)
m
    Just Nonce t tp
n -> IdxCache t f -> Nonce t tp -> m (f tp) -> m (f tp)
forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (f tp) -> m (f tp)
idxCacheEval' IdxCache t f
c Nonce t tp
n m (f tp)
m

-- | Implements a cached evaluated using the given element.  Given an element
-- this function returns the value of the element if bound, and otherwise
-- calls the evaluation function, stores the result in the cache, and
-- returns the value.
{-# INLINE idxCacheEval' #-}
idxCacheEval' :: (MonadIO m)
              => IdxCache t f
              -> Nonce t tp
              -> m (f tp)
              -> m (f tp)
idxCacheEval' :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (f tp) -> m (f tp)
idxCacheEval' IdxCache t f
c Nonce t tp
n m (f tp)
m = do
  Maybe (f tp)
mr <- IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c Nonce t tp
n
  case Maybe (f tp)
mr of
    Just f tp
r -> f tp -> m (f tp)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return f tp
r
    Maybe (f tp)
Nothing -> do
      f tp
r <- m (f tp)
m
      IdxCache t f -> Nonce t tp -> f tp -> m ()
forall (m :: Type -> Type) t (f :: BaseType -> Type)
       (tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> f tp -> m ()
insertIdxValue IdxCache t f
c Nonce t tp
n f tp
r
      f tp -> m (f tp)
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return f tp
r

------------------------------------------------------------------------
-- ExprBuilder operations

curProgramLoc :: ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym = IORef ProgramLoc -> IO ProgramLoc
forall a. IORef a -> IO a
readIORef (ExprBuilder t st fs -> IORef ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef ProgramLoc
sbProgramLoc ExprBuilder t st fs
sym)

-- | Create an element from a nonce app.
sbNonceExpr :: ExprBuilder t st fs
           -> NonceApp t (Expr t) tp
           -> IO (Expr t tp)
sbNonceExpr :: forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym NonceApp t (Expr t) tp
a = do
  ExprAllocator t
s <- IORef (ExprAllocator t) -> IO (ExprAllocator t)
forall a. IORef a -> IO a
readIORef (ExprBuilder t st fs -> IORef (ExprAllocator t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sym)
  ProgramLoc
pc <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
  ExprAllocator t
-> forall (tp :: BaseType).
   ProgramLoc
   -> NonceApp t (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
forall t.
ExprAllocator t
-> forall (tp :: BaseType).
   ProgramLoc
   -> NonceApp t (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
nonceExpr ExprAllocator t
s ProgramLoc
pc NonceApp t (Expr t) tp
a ((forall (u :: BaseType). Expr t u -> AbstractValue u)
-> NonceApp t (Expr t) tp -> AbstractValue tp
forall (e :: BaseType -> Type) t (tp :: BaseType).
IsExpr e =>
(forall (u :: BaseType). e u -> AbstractValue u)
-> NonceApp t e tp -> AbstractValue tp
quantAbsEval Expr t u -> AbstractValue u
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
forall (u :: BaseType). Expr t u -> AbstractValue u
exprAbsValue NonceApp t (Expr t) tp
a)

semiRingLit :: ExprBuilder t st fs
            -> SR.SemiRingRepr sr
            -> SR.Coefficient sr
            -> IO (Expr t (SR.SemiRingBase sr))
semiRingLit :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sb SemiRingRepr sr
sr Coefficient sr
x = do
  ProgramLoc
l <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sb
  Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr)))
-> Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a b. (a -> b) -> a -> b
$! SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr sr
sr Coefficient sr
x ProgramLoc
l

sbMakeExpr :: ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr :: forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym App (Expr t) tp
a = do
  ExprAllocator t
s <- IORef (ExprAllocator t) -> IO (ExprAllocator t)
forall a. IORef a -> IO a
readIORef (ExprBuilder t st fs -> IORef (ExprAllocator t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sym)
  ProgramLoc
pc <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
  let v :: AbstractValue tp
v = (forall (u :: BaseType). Expr t u -> AbstractValue u)
-> App (Expr t) tp -> AbstractValue tp
forall (e :: BaseType -> Type) (tp :: BaseType).
(IsExpr e, HashableF e, OrdF e) =>
(forall (u :: BaseType). e u -> AbstractValue u)
-> App e tp -> AbstractValue tp
abstractEval Expr t u -> AbstractValue u
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
forall (u :: BaseType). Expr t u -> AbstractValue u
exprAbsValue App (Expr t) tp
a
  Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (App (Expr t) tp -> Bool
forall (e :: BaseType -> Type) (tp :: BaseType). App e tp -> Bool
isNonLinearApp App (Expr t) tp
a) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IORef Integer -> (Integer -> (Integer, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (ExprBuilder t st fs -> IORef Integer
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef Integer
sbNonLinearOps ExprBuilder t st fs
sym) (\Integer
n -> (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1,()))
  case App (Expr t) tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
App e tp -> BaseTypeRepr tp
appType App (Expr t) tp
a of
    -- Check if abstract interpretation concludes this is a constant.
    BaseTypeRepr tp
BaseBoolRepr | Just Bool
b <- AbstractValue tp
v -> Expr t tp -> IO (Expr t tp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t tp -> IO (Expr t tp)) -> Expr t tp -> IO (Expr t tp)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
    BaseTypeRepr tp
BaseIntegerRepr | Just Integer
c <- ValueRange Integer -> Maybe Integer
forall tp. ValueRange tp -> Maybe tp
asSingleRange AbstractValue tp
ValueRange Integer
v -> ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
c
    BaseTypeRepr tp
BaseRealRepr | Just Rational
c <- ValueRange Rational -> Maybe Rational
forall tp. ValueRange tp -> Maybe tp
asSingleRange (RealAbstractValue -> ValueRange Rational
ravRange AbstractValue tp
RealAbstractValue
v) -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
c
    BaseBVRepr NatRepr w
w | Just Integer
x <- BVDomain w -> Maybe Integer
forall (w :: Natural). BVDomain w -> Maybe Integer
BVD.asSingleton BVDomain w
AbstractValue tp
v -> ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
x)
    BaseTypeRepr tp
_ -> ExprAllocator t
-> forall (tp :: BaseType).
   ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
forall t.
ExprAllocator t
-> forall (tp :: BaseType).
   ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
appExpr ExprAllocator t
s ProgramLoc
pc App (Expr t) tp
a AbstractValue tp
v

-- | Update the binding to point to the current variable.
updateVarBinding :: ExprBuilder t st fs
                 -> SolverSymbol
                 -> SymbolBinding t
                 -> IO ()
updateVarBinding :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm SymbolBinding t
v
  | SolverSymbol
nm SolverSymbol -> SolverSymbol -> Bool
forall a. Eq a => a -> a -> Bool
== SolverSymbol
emptySymbol = () -> IO ()
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
  | Bool
otherwise =
    IORef (SymbolVarBimap t)
-> (SymbolVarBimap t -> (SymbolVarBimap t, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (ExprBuilder t st fs -> IORef (SymbolVarBimap t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings ExprBuilder t st fs
sym) ((SymbolVarBimap t -> (SymbolVarBimap t, ())) -> IO ())
-> (SymbolVarBimap t -> (SymbolVarBimap t, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ (\SymbolVarBimap t
x -> SymbolBinding t
v SymbolBinding t -> (SymbolVarBimap t, ()) -> (SymbolVarBimap t, ())
forall a b. a -> b -> b
`seq` (SolverSymbol
-> SymbolBinding t -> SymbolVarBimap t -> SymbolVarBimap t
forall {t}.
SolverSymbol
-> SymbolBinding t -> SymbolVarBimap t -> SymbolVarBimap t
ins SolverSymbol
nm SymbolBinding t
v SymbolVarBimap t
x, ()))
  where ins :: SolverSymbol
-> SymbolBinding t -> SymbolVarBimap t -> SymbolVarBimap t
ins SolverSymbol
n SymbolBinding t
x (SymbolVarBimap Bimap SolverSymbol (SymbolBinding t)
m) = Bimap SolverSymbol (SymbolBinding t) -> SymbolVarBimap t
forall t. Bimap SolverSymbol (SymbolBinding t) -> SymbolVarBimap t
SymbolVarBimap (SolverSymbol
-> SymbolBinding t
-> Bimap SolverSymbol (SymbolBinding t)
-> Bimap SolverSymbol (SymbolBinding t)
forall a b. (Ord a, Ord b) => a -> b -> Bimap a b -> Bimap a b
Bimap.insert SolverSymbol
n SymbolBinding t
x Bimap SolverSymbol (SymbolBinding t)
m)

-- | Creates a new bound var.
sbMakeBoundVar :: ExprBuilder t st fs
               -> SolverSymbol
               -> BaseTypeRepr tp
               -> VarKind
               -> Maybe (AbstractValue tp)
               -> IO (ExprBoundVar t tp)
sbMakeBoundVar :: forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp VarKind
k Maybe (AbstractValue tp)
absVal = do
  Nonce t tp
n  <- ExprBuilder t st fs -> IO (Nonce t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sym
  ProgramLoc
pc <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
  ExprBoundVar t tp -> IO (ExprBoundVar t tp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBoundVar t tp -> IO (ExprBoundVar t tp))
-> ExprBoundVar t tp -> IO (ExprBoundVar t tp)
forall a b. (a -> b) -> a -> b
$! BVar { bvarId :: Nonce t tp
bvarId   = Nonce t tp
n
                 , bvarLoc :: ProgramLoc
bvarLoc  = ProgramLoc
pc
                 , bvarName :: SolverSymbol
bvarName = SolverSymbol
nm
                 , bvarType :: BaseTypeRepr tp
bvarType = BaseTypeRepr tp
tp
                 , bvarKind :: VarKind
bvarKind = VarKind
k
                 , bvarAbstractValue :: Maybe (AbstractValue tp)
bvarAbstractValue = Maybe (AbstractValue tp)
absVal
                 }

-- | Create fresh index
sbFreshIndex :: ExprBuilder t st fs -> IO (Nonce t (tp::BaseType))
sbFreshIndex :: forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sb = NonceGenerator IO t -> IO (Nonce t tp)
forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce (ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)

sbFreshSymFnNonce :: ExprBuilder t st fs -> IO (Nonce t (ctx:: Ctx BaseType))
sbFreshSymFnNonce :: forall t (st :: Type -> Type) fs (ctx :: Ctx BaseType).
ExprBuilder t st fs -> IO (Nonce t ctx)
sbFreshSymFnNonce ExprBuilder t st fs
sb = NonceGenerator IO t -> IO (Nonce t ctx)
forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce (ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)

------------------------------------------------------------------------
-- Configuration option for controlling the maximum number of value a unary
-- threshold may have.

-- | Maximum number of values in unary bitvector encoding.
--
--   This option is named \"backend.unary_threshold\"
unaryThresholdOption :: CFG.ConfigOption BaseIntegerType
unaryThresholdOption :: ConfigOption BaseIntegerType
unaryThresholdOption = BaseTypeRepr BaseIntegerType
-> String -> ConfigOption BaseIntegerType
forall (tp :: BaseType).
BaseTypeRepr tp -> String -> ConfigOption tp
CFG.configOption BaseTypeRepr BaseIntegerType
BaseIntegerRepr String
"backend.unary_threshold"

-- | The configuration option for setting the maximum number of
-- values a unary threshold may have.
unaryThresholdDesc :: CFG.ConfigDesc
unaryThresholdDesc :: ConfigDesc
unaryThresholdDesc = ConfigOption BaseIntegerType
-> OptionStyle BaseIntegerType
-> Maybe (Doc Void)
-> Maybe (ConcreteVal BaseIntegerType)
-> ConfigDesc
forall (tp :: BaseType).
ConfigOption tp
-> OptionStyle tp
-> Maybe (Doc Void)
-> Maybe (ConcreteVal tp)
-> ConfigDesc
CFG.mkOpt ConfigOption BaseIntegerType
unaryThresholdOption OptionStyle BaseIntegerType
sty Maybe (Doc Void)
help (ConcreteVal BaseIntegerType -> Maybe (ConcreteVal BaseIntegerType)
forall a. a -> Maybe a
Just (Integer -> ConcreteVal BaseIntegerType
ConcreteInteger Integer
0))
  where sty :: OptionStyle BaseIntegerType
sty = Bound Integer -> OptionStyle BaseIntegerType
CFG.integerWithMinOptSty (Integer -> Bound Integer
forall r. r -> Bound r
CFG.Inclusive Integer
0)
        help :: Maybe (Doc Void)
help = Doc Void -> Maybe (Doc Void)
forall a. a -> Maybe a
Just Doc Void
"Maximum number of values in unary bitvector encoding."

------------------------------------------------------------------------
-- Configuration option for controlling whether to push certain ExprBuilder
-- operations (e.g., @zext@) down to the branches of @ite@ expressions.

-- | If this option enabled, push certain 'ExprBuilder' operations (e.g.,
-- @zext@) down to the branches of @ite@ expressions. In some (but not all)
-- circumstances, this can result in operations that are easier for SMT solvers
-- to reason about. The expressions that may be pushed down are determined on a
-- case-by-case basis in the 'IsExprBuilder' instance for 'ExprBuilder', but
-- this control applies to all such push-down checks.
--
-- This option is named \"backend.push_mux_ops\".
pushMuxOpsOption :: CFG.ConfigOption BaseBoolType
pushMuxOpsOption :: ConfigOption BaseBoolType
pushMuxOpsOption = BaseTypeRepr BaseBoolType -> String -> ConfigOption BaseBoolType
forall (tp :: BaseType).
BaseTypeRepr tp -> String -> ConfigOption tp
CFG.configOption BaseTypeRepr BaseBoolType
BaseBoolRepr String
"backend.push_mux_ops"

-- | The 'CFG.ConfigDesc' for 'pushMuxOpsOption'.
pushMuxOpsDesc :: CFG.ConfigDesc
pushMuxOpsDesc :: ConfigDesc
pushMuxOpsDesc = ConfigOption BaseBoolType
-> OptionStyle BaseBoolType
-> Maybe (Doc Void)
-> Maybe (ConcreteVal BaseBoolType)
-> ConfigDesc
forall (tp :: BaseType).
ConfigOption tp
-> OptionStyle tp
-> Maybe (Doc Void)
-> Maybe (ConcreteVal tp)
-> ConfigDesc
CFG.mkOpt ConfigOption BaseBoolType
pushMuxOpsOption OptionStyle BaseBoolType
sty Maybe (Doc Void)
help (ConcreteVal BaseBoolType -> Maybe (ConcreteVal BaseBoolType)
forall a. a -> Maybe a
Just (Bool -> ConcreteVal BaseBoolType
ConcreteBool Bool
False))
  where sty :: OptionStyle BaseBoolType
sty = OptionStyle BaseBoolType
CFG.boolOptSty
        help :: Maybe (Doc Void)
help = Doc Void -> Maybe (Doc Void)
forall a. a -> Maybe a
Just (Doc Void -> Maybe (Doc Void)) -> Doc Void -> Maybe (Doc Void)
forall a b. (a -> b) -> a -> b
$
          Doc Void
"If this option enabled, push certain ExprBuilder operations " Doc Void -> Doc Void -> Doc Void
forall a. Semigroup a => a -> a -> a
<>
          Doc Void
"(e.g., zext) down to the branches of ite expressions."

newExprBuilder ::
  FloatModeRepr fm
  -- ^ Float interpretation mode (i.e., how are floats translated for the solver).
  -> st t
  -- ^ Initial state for the expression builder
  -> NonceGenerator IO t
  -- ^ Nonce generator for names
  ->  IO (ExprBuilder t st (Flags fm))
newExprBuilder :: forall (fm :: FloatMode) (st :: Type -> Type) t.
FloatModeRepr fm
-> st t -> NonceGenerator IO t -> IO (ExprBuilder t st (Flags fm))
newExprBuilder FloatModeRepr fm
floatMode st t
st NonceGenerator IO t
gen = do
  ExprAllocator t
es <- NonceGenerator IO t -> IO (ExprAllocator t)
forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage NonceGenerator IO t
gen

  let t :: Expr t BaseBoolType
t = Bool -> ProgramLoc -> Expr t BaseBoolType
forall t. Bool -> ProgramLoc -> Expr t BaseBoolType
BoolExpr Bool
True ProgramLoc
initializationLoc
  let f :: Expr t BaseBoolType
f = Bool -> ProgramLoc -> Expr t BaseBoolType
forall t. Bool -> ProgramLoc -> Expr t BaseBoolType
BoolExpr Bool
False ProgramLoc
initializationLoc
  let z :: Expr t (SemiRingBase 'SemiRingReal)
z = SemiRingRepr 'SemiRingReal
-> Coefficient 'SemiRingReal
-> ProgramLoc
-> Expr t (SemiRingBase 'SemiRingReal)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr Rational
Coefficient 'SemiRingReal
0 ProgramLoc
initializationLoc

  IORef ProgramLoc
loc_ref       <- ProgramLoc -> IO (IORef ProgramLoc)
forall a. a -> IO (IORef a)
newIORef ProgramLoc
initializationLoc
  IORef (ExprAllocator t)
storage_ref   <- ExprAllocator t -> IO (IORef (ExprAllocator t))
forall a. a -> IO (IORef a)
newIORef ExprAllocator t
es
  IORef (SymbolVarBimap t)
bindings_ref  <- SymbolVarBimap t -> IO (IORef (SymbolVarBimap t))
forall a. a -> IO (IORef a)
newIORef SymbolVarBimap t
forall t. SymbolVarBimap t
emptySymbolVarBimap
  IORef
  (Map
     (SolverSymbol, Some (Assignment BaseTypeRepr))
     (SomeSymFn (ExprBuilder t st (Flags fm))))
uninterp_fn_cache_ref <- Map
  (SolverSymbol, Some (Assignment BaseTypeRepr))
  (SomeSymFn (ExprBuilder t st (Flags fm)))
-> IO
     (IORef
        (Map
           (SolverSymbol, Some (Assignment BaseTypeRepr))
           (SomeSymFn (ExprBuilder t st (Flags fm)))))
forall a. a -> IO (IORef a)
newIORef Map
  (SolverSymbol, Some (Assignment BaseTypeRepr))
  (SomeSymFn (ExprBuilder t st (Flags fm)))
forall k a. Map k a
Map.empty
  HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
matlabFnCache <- ST
  RealWorld
  (HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t))
-> IO
     (HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t))
forall a. ST RealWorld a -> IO a
stToIO (ST
   RealWorld
   (HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t))
 -> IO
      (HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)))
-> ST
     RealWorld
     (HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t))
-> IO
     (HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t))
forall a b. (a -> b) -> a -> b
$ ST
  RealWorld
  (HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t))
forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
  IORef (Maybe (SolverEvent -> IO ()))
loggerRef     <- Maybe (SolverEvent -> IO ())
-> IO (IORef (Maybe (SolverEvent -> IO ())))
forall a. a -> IO (IORef a)
newIORef Maybe (SolverEvent -> IO ())
forall a. Maybe a
Nothing

  -- Set up configuration options
  Config
cfg <- Integer -> [ConfigDesc] -> IO Config
CFG.initialConfig Integer
0
           [ ConfigDesc
unaryThresholdDesc
           , ConfigDesc
cacheStartSizeDesc
           , ConfigDesc
pushMuxOpsDesc
           ]
  OptionSetting BaseIntegerType
unarySetting       <- ConfigOption BaseIntegerType
-> Config -> IO (OptionSetting BaseIntegerType)
forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
unaryThresholdOption Config
cfg
  OptionSetting BaseIntegerType
cacheStartSetting  <- ConfigOption BaseIntegerType
-> Config -> IO (OptionSetting BaseIntegerType)
forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
cacheStartSizeOption Config
cfg
  OptionSetting BaseBoolType
pushMuxOpsSetting  <- ConfigOption BaseBoolType
-> Config -> IO (OptionSetting BaseBoolType)
forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseBoolType
pushMuxOpsOption Config
cfg
  [ConfigDesc] -> Config -> IO ()
CFG.extendConfig [NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> ConfigDesc
forall t.
NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> ConfigDesc
cacheOptDesc NonceGenerator IO t
gen IORef (ExprAllocator t)
storage_ref OptionSetting BaseIntegerType
cacheStartSetting] Config
cfg
  IORef Integer
nonLinearOps <- Integer -> IO (IORef Integer)
forall a. a -> IO (IORef a)
newIORef Integer
0

  ExprBuilder t st (Flags fm) -> IO (ExprBuilder t st (Flags fm))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st (Flags fm) -> IO (ExprBuilder t st (Flags fm)))
-> ExprBuilder t st (Flags fm) -> IO (ExprBuilder t st (Flags fm))
forall a b. (a -> b) -> a -> b
$! SB { sbTrue :: BoolExpr t
sbTrue  = BoolExpr t
forall {t}. Expr t BaseBoolType
t
               , sbFalse :: BoolExpr t
sbFalse = BoolExpr t
forall {t}. Expr t BaseBoolType
f
               , sbZero :: RealExpr t
sbZero = RealExpr t
forall {t}. Expr t BaseRealType
z
               , sbConfiguration :: Config
sbConfiguration = Config
cfg
               , sbFloatReduce :: Bool
sbFloatReduce = Bool
True
               , sbUnaryThreshold :: OptionSetting BaseIntegerType
sbUnaryThreshold = OptionSetting BaseIntegerType
unarySetting
               , sbCacheStartSize :: OptionSetting BaseIntegerType
sbCacheStartSize = OptionSetting BaseIntegerType
cacheStartSetting
               , sbPushMuxOps :: OptionSetting BaseBoolType
sbPushMuxOps = OptionSetting BaseBoolType
pushMuxOpsSetting
               , sbProgramLoc :: IORef ProgramLoc
sbProgramLoc = IORef ProgramLoc
loc_ref
               , sbExprCounter :: NonceGenerator IO t
sbExprCounter = NonceGenerator IO t
gen
               , sbCurAllocator :: IORef (ExprAllocator t)
sbCurAllocator = IORef (ExprAllocator t)
storage_ref
               , sbNonLinearOps :: IORef Integer
sbNonLinearOps = IORef Integer
nonLinearOps
               , sbUserState :: st t
sbUserState = st t
st
               , sbVarBindings :: IORef (SymbolVarBimap t)
sbVarBindings = IORef (SymbolVarBimap t)
bindings_ref
               , sbUninterpFnCache :: IORef
  (Map
     (SolverSymbol, Some (Assignment BaseTypeRepr))
     (SomeSymFn (ExprBuilder t st (Flags fm))))
sbUninterpFnCache = IORef
  (Map
     (SolverSymbol, Some (Assignment BaseTypeRepr))
     (SomeSymFn (ExprBuilder t st (Flags fm))))
uninterp_fn_cache_ref
               , sbMatlabFnCache :: HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
sbMatlabFnCache = HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
matlabFnCache
               , sbSolverLogger :: IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger = IORef (Maybe (SolverEvent -> IO ()))
loggerRef
               , sbFloatMode :: FloatModeRepr fm
sbFloatMode = FloatModeRepr fm
floatMode
               }

-- | Get current variable bindings.
getSymbolVarBimap :: ExprBuilder t st fs -> IO (SymbolVarBimap t)
getSymbolVarBimap :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO (SymbolVarBimap t)
getSymbolVarBimap ExprBuilder t st fs
sym = IORef (SymbolVarBimap t) -> IO (SymbolVarBimap t)
forall a. IORef a -> IO a
readIORef (ExprBuilder t st fs -> IORef (SymbolVarBimap t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings ExprBuilder t st fs
sym)

-- | Stop caching applications in backend.
stopCaching :: ExprBuilder t st fs -> IO ()
stopCaching :: forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> IO ()
stopCaching ExprBuilder t st fs
sb = do
  ExprAllocator t
s <- NonceGenerator IO t -> IO (ExprAllocator t)
forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage (ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)
  IORef (ExprAllocator t) -> ExprAllocator t -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef (ExprBuilder t st fs -> IORef (ExprAllocator t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sb) ExprAllocator t
s

-- | Restart caching applications in backend (clears cache if it is currently caching).
startCaching :: ExprBuilder t st fs -> IO ()
startCaching :: forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> IO ()
startCaching ExprBuilder t st fs
sb = do
  Integer
sz <- OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize ExprBuilder t st fs
sb)
  ExprAllocator t
s <- NonceGenerator IO t -> Int -> IO (ExprAllocator t)
forall t. NonceGenerator IO t -> Int -> IO (ExprAllocator t)
newCachedStorage (ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
sz)
  IORef (ExprAllocator t) -> ExprAllocator t -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef (ExprBuilder t st fs -> IORef (ExprAllocator t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sb) ExprAllocator t
s

bvBinDivOp :: (1 <= w)
            => (NatRepr w -> BV.BV w -> BV.BV w -> BV.BV w)
            -> (NatRepr w -> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
            -> ExprBuilder t st fs
            -> BVExpr t w
            -> BVExpr t w
            -> IO (BVExpr t w)
bvBinDivOp :: forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp NatRepr w -> BV w -> BV w -> BV w
f NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w)
c ExprBuilder t st fs
sb BVExpr t w
x BVExpr t w
y = do
  let w :: NatRepr w
w = BVExpr t w -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth BVExpr t w
x
  case (BVExpr t w -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV BVExpr t w
x, BVExpr t w -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV BVExpr t w
y) of
    (Just BV w
i, Just BV w
j) | BV w
j BV w -> BV w -> Bool
forall a. Eq a => a -> a -> Bool
/= NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w -> ExprBuilder t st fs
-> NatRepr w
-> BV w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr w
w (BV w -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w)))
-> BV w -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> BV w -> BV w
f NatRepr w
w BV w
i BV w
j
    (Maybe (BV w), Maybe (BV w))
_ -> ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (BVExpr t w)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (App (Expr t) (BaseBVType w) -> IO (BVExpr t w))
-> App (Expr t) (BaseBVType w) -> IO (BVExpr t w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w)
c NatRepr w
w BVExpr t w
x BVExpr t w
y

asConcreteIndices :: IsExpr e
                  => Ctx.Assignment e ctx
                  -> Maybe (Ctx.Assignment IndexLit ctx)
asConcreteIndices :: forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
IsExpr e =>
Assignment e ctx -> Maybe (Assignment IndexLit ctx)
asConcreteIndices = (forall (x :: BaseType). e x -> Maybe (IndexLit x))
-> forall (x :: Ctx BaseType).
   Assignment e x -> Maybe (Assignment IndexLit x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC e x -> Maybe (IndexLit x)
forall (x :: BaseType). e x -> Maybe (IndexLit x)
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> Maybe (IndexLit tp)
f
  where f :: IsExpr e => e tp -> Maybe (IndexLit tp)
        f :: forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> Maybe (IndexLit tp)
f e tp
x =
          case e tp -> BaseTypeRepr tp
forall (tp :: BaseType). e tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e tp
x of
            BaseTypeRepr tp
BaseIntegerRepr  -> Integer -> IndexLit tp
Integer -> IndexLit BaseIntegerType
IntIndexLit (Integer -> IndexLit tp) -> Maybe Integer -> Maybe (IndexLit tp)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> e BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger e tp
e BaseIntegerType
x
            BaseBVRepr NatRepr w
w -> NatRepr w -> BV w -> IndexLit ('BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> IndexLit ('BaseBVType w)
BVIndexLit NatRepr w
w (BV w -> IndexLit tp) -> Maybe (BV w) -> Maybe (IndexLit tp)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> e ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). e (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV e tp
e ('BaseBVType w)
x
            BaseTypeRepr tp
_ -> Maybe (IndexLit tp)
forall a. Maybe a
Nothing

symbolicIndices :: forall sym ctx
                 . IsExprBuilder sym
                => sym
                -> Ctx.Assignment IndexLit ctx
                -> IO (Ctx.Assignment (SymExpr sym) ctx)
symbolicIndices :: forall sym (ctx :: Ctx BaseType).
IsExprBuilder sym =>
sym -> Assignment IndexLit ctx -> IO (Assignment (SymExpr sym) ctx)
symbolicIndices sym
sym = (forall (x :: BaseType). IndexLit x -> IO (SymExpr sym x))
-> forall (x :: Ctx BaseType).
   Assignment IndexLit x -> IO (Assignment (SymExpr sym) x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC IndexLit x -> IO (SymExpr sym x)
forall (x :: BaseType). IndexLit x -> IO (SymExpr sym x)
f
  where f :: IndexLit tp -> IO (SymExpr sym tp)
        f :: forall (x :: BaseType). IndexLit x -> IO (SymExpr sym x)
f (IntIndexLit Integer
n)  = sym -> Integer -> IO (SymInteger sym)
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym Integer
n
        f (BVIndexLit NatRepr w
w BV w
i) = sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall (w :: Natural).
(1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
w BV w
i

-- | This evaluate a symbolic function against a set of arguments.
betaReduce :: ExprBuilder t st fs
           -> ExprSymFn t args ret
           -> Ctx.Assignment (Expr t) args
           -> IO (Expr t ret)
betaReduce :: forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym ExprSymFn t args ret
f Assignment (Expr t) args
args =
  case ExprSymFn t args ret -> SymFnInfo t args ret
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args ret
f of
    UninterpFnInfo{} ->
      ExprBuilder t st fs -> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) ret -> IO (Expr t ret))
-> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$! ExprSymFn t args ret
-> Assignment (Expr t) args -> NonceApp t (Expr t) ret
forall t (args :: Ctx BaseType) (tp :: BaseType)
       (e :: BaseType -> Type).
ExprSymFn t args tp -> Assignment e args -> NonceApp t e tp
FnApp ExprSymFn t args ret
f Assignment (Expr t) args
args
    DefinedFnInfo Assignment (ExprBoundVar t) args
bound_vars Expr t ret
e UnfoldPolicy
_ -> do
      ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
forall t (st :: Type -> Type) fs (ret :: BaseType)
       (args :: Ctx BaseType).
ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
evalBoundVars ExprBuilder t st fs
sym Expr t ret
e Assignment (ExprBoundVar t) args
bound_vars Assignment (Expr t) args
args
    MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
fn_id Assignment (ExprBoundVar t) args
_ Expr t ret
_ -> do
      MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
-> ExprBuilder t st fs
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsExprBuilder sym =>
MatlabSolverFn (SymExpr sym) args ret
-> sym -> Assignment (SymExpr sym) args -> IO (SymExpr sym ret)
evalMatlabSolverFn MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
MatlabSolverFn (Expr t) args ret
fn_id ExprBuilder t st fs
sym Assignment (SymExpr (ExprBuilder t st fs)) args
Assignment (Expr t) args
args

-- | This runs one action, and if it returns a value different from the input,
-- then it runs the second.  Otherwise it returns the result value passed in.
--
-- It is used when an action may modify a value, and we only want to run a
-- second action if the value changed.
runIfChanged :: (Eq e, Monad m)
             => e
             -> (e -> m e) -- ^ First action to run
             -> r           -- ^ Result if no change.
             -> (e -> m r) -- ^ Second action to run
             -> m r
runIfChanged :: forall e (m :: Type -> Type) r.
(Eq e, Monad m) =>
e -> (e -> m e) -> r -> (e -> m r) -> m r
runIfChanged e
x e -> m e
f r
unChanged e -> m r
onChange = do
  e
y <- e -> m e
f e
x
  if e
x e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
y then
    r -> m r
forall a. a -> m a
forall (m :: Type -> Type) a. Monad m => a -> m a
return r
unChanged
   else
    e -> m r
onChange e
y

-- | This adds a binding from the variable to itself in the hashtable
-- to ensure it can't be rebound.
recordBoundVar :: PH.HashTable RealWorld (Expr t) (Expr t)
                  -> ExprBoundVar t tp
                  -> IO ()
recordBoundVar :: forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar HashTable RealWorld (Expr t) (Expr t)
tbl ExprBoundVar t tp
v = do
  let e :: Expr t tp
e = ExprBoundVar t tp -> Expr t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t tp
v
  Maybe (Expr t tp)
mr <- ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp)))
-> ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp))
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (Expr t) (Expr t)
-> Expr t tp -> ST RealWorld (Maybe (Expr t tp))
forall {k} (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> ST s (Maybe (val tp))
PH.lookup HashTable RealWorld (Expr t) (Expr t)
tbl Expr t tp
e
  case Maybe (Expr t tp)
mr of
    Just Expr t tp
r -> do
      Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Expr t tp
r Expr t tp -> Expr t tp -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr t tp
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Simulator internal error; do not support rebinding variables."
    Maybe (Expr t tp)
Nothing -> do
      -- Bind variable to itself to ensure we catch when it is used again.
      ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (Expr t) (Expr t)
-> Expr t tp -> Expr t tp -> ST RealWorld ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld (Expr t) (Expr t)
tbl Expr t tp
e Expr t tp
e


-- | The CachedSymFn is used during evaluation to store the results of reducing
-- the definitions of symbolic functions.
--
-- For each function it stores a pair containing a 'Bool' that is true if the
-- function changed as a result of evaluating it, and the reduced function
-- after evaluation.
--
-- The second arguments contains the arguments with the return type appended.
data CachedSymFn t c
  = forall a r
    . (c ~ (a ::> r))
    => CachedSymFn Bool (ExprSymFn t a r)

-- | Data structure used for caching evaluation.
data EvalHashTables t
   = EvalHashTables { forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable :: !(PH.HashTable RealWorld (Expr t) (Expr t))
                    , forall t.
EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable  :: !(PH.HashTable RealWorld (Nonce t) (CachedSymFn t))
                    }

-- | Evaluate a simple function.
--
-- This returns whether the function changed as a Boolean and the function itself.
evalSimpleFn :: EvalHashTables t
             -> ExprBuilder t st fs
             -> ExprSymFn t idx ret
             -> IO (Bool,ExprSymFn t idx ret)
evalSimpleFn :: forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
       (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbl ExprBuilder t st fs
sym ExprSymFn t idx ret
f = do
  let n :: Nonce t (idx ::> ret)
n = ExprSymFn t idx ret -> Nonce t (idx ::> ret)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t idx ret
f
  case ExprSymFn t idx ret -> SymFnInfo t idx ret
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t idx ret
f of
    UninterpFnInfo{} -> do
      CachedSymFn Bool
changed ExprSymFn t a r
f' <- HashTable RealWorld (Nonce t) (CachedSymFn t)
-> Nonce t (idx ::> ret)
-> IO (CachedSymFn t (idx ::> ret))
-> IO (CachedSymFn t (idx ::> ret))
forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
       (tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
forall t.
EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable EvalHashTables t
tbl) Nonce t (idx ::> ret)
n (IO (CachedSymFn t (idx ::> ret))
 -> IO (CachedSymFn t (idx ::> ret)))
-> IO (CachedSymFn t (idx ::> ret))
-> IO (CachedSymFn t (idx ::> ret))
forall a b. (a -> b) -> a -> b
$
        CachedSymFn t (idx ::> ret) -> IO (CachedSymFn t (idx ::> ret))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (CachedSymFn t (idx ::> ret) -> IO (CachedSymFn t (idx ::> ret)))
-> CachedSymFn t (idx ::> ret) -> IO (CachedSymFn t (idx ::> ret))
forall a b. (a -> b) -> a -> b
$! Bool -> ExprSymFn t idx ret -> CachedSymFn t (idx ::> ret)
forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
False ExprSymFn t idx ret
f
      (Bool, ExprSymFn t idx ret) -> IO (Bool, ExprSymFn t idx ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
changed, ExprSymFn t idx ret
ExprSymFn t a r
f')
    DefinedFnInfo Assignment (ExprBoundVar t) idx
vars Expr t ret
e UnfoldPolicy
evalFn -> do
      let nm :: SolverSymbol
nm = ExprSymFn t idx ret -> SolverSymbol
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName ExprSymFn t idx ret
f
      CachedSymFn Bool
changed ExprSymFn t a r
f' <-
        HashTable RealWorld (Nonce t) (CachedSymFn t)
-> Nonce t (idx ::> ret)
-> IO (CachedSymFn t (idx ::> ret))
-> IO (CachedSymFn t (idx ::> ret))
forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
       (tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
forall t.
EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable EvalHashTables t
tbl) Nonce t (idx ::> ret)
n (IO (CachedSymFn t (idx ::> ret))
 -> IO (CachedSymFn t (idx ::> ret)))
-> IO (CachedSymFn t (idx ::> ret))
-> IO (CachedSymFn t (idx ::> ret))
forall a b. (a -> b) -> a -> b
$ do
          (forall (x :: BaseType). ExprBoundVar t x -> IO ())
-> forall (x :: Ctx BaseType).
   Assignment (ExprBoundVar t) x -> IO ()
forall {k} {l} (t :: (k -> Type) -> l -> Type) (m :: Type -> Type)
       (f :: k -> Type) a.
(FoldableFC t, Applicative m) =>
(forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
traverseFC_ (HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t x -> IO ()
forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbl)) Assignment (ExprBoundVar t) idx
vars
          Expr t ret
e' <- EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbl ExprBuilder t st fs
sym Expr t ret
e
          if Expr t ret
e Expr t ret -> Expr t ret -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t ret
e' then
            CachedSymFn t (idx ::> ret) -> IO (CachedSymFn t (idx ::> ret))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (CachedSymFn t (idx ::> ret) -> IO (CachedSymFn t (idx ::> ret)))
-> CachedSymFn t (idx ::> ret) -> IO (CachedSymFn t (idx ::> ret))
forall a b. (a -> b) -> a -> b
$! Bool -> ExprSymFn t idx ret -> CachedSymFn t (idx ::> ret)
forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
False ExprSymFn t idx ret
f
           else
            Bool -> ExprSymFn t idx ret -> CachedSymFn t (idx ::> ret)
forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
True (ExprSymFn t idx ret -> CachedSymFn t (idx ::> ret))
-> IO (ExprSymFn t idx ret) -> IO (CachedSymFn t (idx ::> ret))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> SolverSymbol
-> Assignment (BoundVar (ExprBuilder t st fs)) idx
-> SymExpr (ExprBuilder t st fs) ret
-> UnfoldPolicy
-> IO (SymFn (ExprBuilder t st fs) idx ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment (BoundVar sym) args
-> SymExpr sym ret
-> UnfoldPolicy
-> IO (SymFn sym args ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> Assignment (BoundVar (ExprBuilder t st fs)) args
-> SymExpr (ExprBuilder t st fs) ret
-> UnfoldPolicy
-> IO (SymFn (ExprBuilder t st fs) args ret)
definedFn ExprBuilder t st fs
sym SolverSymbol
nm Assignment (BoundVar (ExprBuilder t st fs)) idx
Assignment (ExprBoundVar t) idx
vars SymExpr (ExprBuilder t st fs) ret
Expr t ret
e' UnfoldPolicy
evalFn
      (Bool, ExprSymFn t idx ret) -> IO (Bool, ExprSymFn t idx ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
changed, ExprSymFn t idx ret
ExprSymFn t a r
f')
    MatlabSolverFnInfo{} -> (Bool, ExprSymFn t idx ret) -> IO (Bool, ExprSymFn t idx ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
False, ExprSymFn t idx ret
f)

evalBoundVars' :: forall t st fs ret
               .  EvalHashTables t
               -> ExprBuilder t st fs
               -> Expr t ret
               -> IO (Expr t ret)
evalBoundVars' :: forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t ret
e0 =
  case Expr t ret
e0 of
    SemiRingLiteral{} -> Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    StringExpr{} -> Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    BoolExpr{} -> Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    FloatExpr{} -> Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    AppExpr AppExpr t ret
ae -> HashTable RealWorld (Expr t) (Expr t)
-> Expr t ret -> IO (Expr t ret) -> IO (Expr t ret)
forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
       (tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 (IO (Expr t ret) -> IO (Expr t ret))
-> IO (Expr t ret) -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$ do
      let a :: App (Expr t) ret
a = AppExpr t ret -> App (Expr t) ret
forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t ret
ae
      App (Expr t) ret
a' <- (forall (tp :: BaseType). Expr t tp -> IO (Expr t tp))
-> App (Expr t) ret -> IO (App (Expr t) ret)
forall (m :: Type -> Type) (f :: BaseType -> Type)
       (e :: BaseType -> Type) (utp :: BaseType).
(Applicative m, OrdF f, Eq (f BaseBoolType), HashableF f,
 HasAbsValue f) =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> App e utp -> m (App f utp)
traverseApp (EvalHashTables t
-> ExprBuilder t st fs -> Expr t tp -> IO (Expr t tp)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) App (Expr t) ret
a
      if App (Expr t) ret
a App (Expr t) ret -> App (Expr t) ret -> Bool
forall a. Eq a => a -> a -> Bool
== App (Expr t) ret
a' then
        Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
       else
        ExprBuilder t st fs
-> (forall (w :: Natural).
    (1 <= w) =>
    ExprBuilder t st fs
    -> UnaryBV (Pred (ExprBuilder t st fs)) w
    -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w)))
-> App (SymExpr (ExprBuilder t st fs)) ret
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> (forall (w :: Natural).
    (1 <= w) =>
    sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w)))
-> App (SymExpr sym) tp
-> IO (SymExpr sym tp)
reduceApp ExprBuilder t st fs
sym ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (SymExpr (ExprBuilder t st fs) ('BaseBVType w))
ExprBuilder t st fs
-> UnaryBV (Expr t BaseBoolType) w -> IO (BVExpr t w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary App (SymExpr (ExprBuilder t st fs)) ret
App (Expr t) ret
a'
    NonceAppExpr NonceAppExpr t ret
ae -> HashTable RealWorld (Expr t) (Expr t)
-> Expr t ret -> IO (Expr t ret) -> IO (Expr t ret)
forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
       (tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 (IO (Expr t ret) -> IO (Expr t ret))
-> IO (Expr t ret) -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$ do
      case NonceAppExpr t ret -> NonceApp t (Expr t) ret
forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp NonceAppExpr t ret
ae of
        Annotation BaseTypeRepr ret
tpr Nonce t ret
n Expr t ret
a -> do
          Expr t ret
a' <- EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t ret
a
          if Expr t ret
a Expr t ret -> Expr t ret -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t ret
a' then
            Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
          else
            ExprBuilder t st fs -> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) ret -> IO (Expr t ret))
-> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr ret
-> Nonce t ret -> Expr t ret -> NonceApp t (Expr t) ret
forall (tp :: BaseType) t (e :: BaseType -> Type).
BaseTypeRepr tp -> Nonce t tp -> e tp -> NonceApp t e tp
Annotation BaseTypeRepr ret
tpr Nonce t ret
n Expr t ret
a'
        Forall ExprBoundVar t tp1
v Expr t BaseBoolType
e -> do
          HashTable RealWorld (Expr t) (Expr t)
-> ExprBoundVar t tp1 -> IO ()
forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) ExprBoundVar t tp1
v
          -- Regenerate forallPred if e is changed by evaluation.
          Expr t BaseBoolType
-> (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> Expr t ret
-> (Expr t BaseBoolType -> IO (Expr t ret))
-> IO (Expr t ret)
forall e (m :: Type -> Type) r.
(Eq e, Monad m) =>
e -> (e -> m e) -> r -> (e -> m r) -> m r
runIfChanged Expr t BaseBoolType
e (EvalHashTables t
-> ExprBuilder t st fs
-> Expr t BaseBoolType
-> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) Expr t ret
e0 (ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp1
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forallPred ExprBuilder t st fs
sym BoundVar (ExprBuilder t st fs) tp1
ExprBoundVar t tp1
v)
        Exists ExprBoundVar t tp1
v Expr t BaseBoolType
e -> do
          HashTable RealWorld (Expr t) (Expr t)
-> ExprBoundVar t tp1 -> IO ()
forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) ExprBoundVar t tp1
v
          -- Regenerate forallPred if e is changed by evaluation.
          Expr t BaseBoolType
-> (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> Expr t ret
-> (Expr t BaseBoolType -> IO (Expr t ret))
-> IO (Expr t ret)
forall e (m :: Type -> Type) r.
(Eq e, Monad m) =>
e -> (e -> m e) -> r -> (e -> m r) -> m r
runIfChanged Expr t BaseBoolType
e (EvalHashTables t
-> ExprBuilder t st fs
-> Expr t BaseBoolType
-> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) Expr t ret
e0 (ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp1
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
existsPred ExprBuilder t st fs
sym BoundVar (ExprBuilder t st fs) tp1
ExprBoundVar t tp1
v)
        ArrayFromFn ExprSymFn t (idx ::> itp) ret
f -> do
          (Bool
changed, ExprSymFn t (idx ::> itp) ret
f') <- EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t (idx ::> itp) ret
-> IO (Bool, ExprSymFn t (idx ::> itp) ret)
forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
       (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) ret
f
          if Bool -> Bool
not Bool
changed then
            Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) ret
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) ret)
forall sym (idx :: Ctx BaseType) (itp :: BaseType)
       (ret :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (idx ::> itp) ret
-> IO (SymArray sym (idx ::> itp) ret)
forall (idx :: Ctx BaseType) (itp :: BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) ret
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) ret)
arrayFromFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (idx ::> itp) ret
ExprSymFn t (idx ::> itp) ret
f'
        MapOverArrays ExprSymFn t (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args -> do
          (Bool
changed, ExprSymFn t (ctx ::> d) r
f') <- EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t (ctx ::> d) r
-> IO (Bool, ExprSymFn t (ctx ::> d) r)
forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
       (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t (ctx ::> d) r
f
          let evalWrapper :: ArrayResultWrapper (Expr t) (idx ::> itp) utp
                          -> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
              evalWrapper :: forall (idx :: Ctx BaseType) (itp :: BaseType) (utp :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) utp
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
evalWrapper (ArrayResultWrapper Expr t (BaseArrayType (idx ::> itp) utp)
a) =
                Expr t (BaseArrayType (idx ::> itp) utp)
-> ArrayResultWrapper (Expr t) (idx ::> itp) utp
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
ArrayResultWrapper (Expr t (BaseArrayType (idx ::> itp) utp)
 -> ArrayResultWrapper (Expr t) (idx ::> itp) utp)
-> IO (Expr t (BaseArrayType (idx ::> itp) utp))
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalHashTables t
-> ExprBuilder t st fs
-> Expr t (BaseArrayType (idx ::> itp) utp)
-> IO (Expr t (BaseArrayType (idx ::> itp) utp))
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t (BaseArrayType (idx ::> itp) utp)
a
          Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args' <- (forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (idx ::> itp) x
 -> IO (ArrayResultWrapper (Expr t) (idx ::> itp) x))
-> forall (x :: Ctx BaseType).
   Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) x
   -> IO (Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC ArrayResultWrapper (Expr t) (idx ::> itp) x
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) x)
forall (idx :: Ctx BaseType) (itp :: BaseType) (utp :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) utp
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
forall (x :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) x
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) x)
evalWrapper Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args
          if Bool -> Bool
not Bool
changed Bool -> Bool -> Bool
&& Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Bool
forall a. Eq a => a -> a -> Bool
== Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args' then
            Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
     (ctx ::> d)
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) r)
forall sym (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
       (idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr sym) (idx ::> itp)) (ctx ::> d)
-> IO (SymArray sym (idx ::> itp) r)
forall (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
       (idx :: Ctx BaseType) (itp :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
     (ctx ::> d)
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) r)
arrayMap ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
ExprSymFn t (ctx ::> d) r
f' Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args'
        ArrayTrueOnEntries ExprSymFn t (idx ::> itp) BaseBoolType
f Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a -> do
          (Bool
changed, ExprSymFn t (idx ::> itp) BaseBoolType
f') <- EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t (idx ::> itp) BaseBoolType
-> IO (Bool, ExprSymFn t (idx ::> itp) BaseBoolType)
forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
       (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) BaseBoolType
f
          Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a' <- EvalHashTables t
-> ExprBuilder t st fs
-> Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
-> IO (Expr t (BaseArrayType (idx ::> itp) BaseBoolType))
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a
          if Bool -> Bool
not Bool
changed Bool -> Bool -> Bool
&& Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
-> Expr t (BaseArrayType (idx ::> itp) BaseBoolType) -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a' then
            Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
-> SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
forall sym (idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (idx ::> itp) BaseBoolType
-> SymArray sym (idx ::> itp) BaseBoolType
-> IO (Pred sym)
forall (idx :: Ctx BaseType) (itp :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
-> SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
arrayTrueOnEntries ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
ExprSymFn t (idx ::> itp) BaseBoolType
f' SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a'
        FnApp ExprSymFn t args ret
f Assignment (Expr t) args
a -> do
          (Bool
changed, ExprSymFn t args ret
f') <- EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t args ret
-> IO (Bool, ExprSymFn t args ret)
forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
       (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t args ret
f
          Assignment (Expr t) args
a' <- (forall (tp :: BaseType). Expr t tp -> IO (Expr t tp))
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> IO (Assignment (Expr t) x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC (EvalHashTables t
-> ExprBuilder t st fs -> Expr t x -> IO (Expr t x)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) Assignment (Expr t) args
a
          if Bool -> Bool
not Bool
changed Bool -> Bool -> Bool
&& Assignment (Expr t) args
a Assignment (Expr t) args -> Assignment (Expr t) args -> Bool
forall a. Eq a => a -> a -> Bool
== Assignment (Expr t) args
a' then
            Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) args ret
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) args ret
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
applySymFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
f' Assignment (SymExpr (ExprBuilder t st fs)) args
Assignment (Expr t) args
a'

    BoundVarExpr{} -> HashTable RealWorld (Expr t) (Expr t)
-> Expr t ret -> IO (Expr t ret) -> IO (Expr t ret)
forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
       (tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 (IO (Expr t ret) -> IO (Expr t ret))
-> IO (Expr t ret) -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$ Expr t ret -> IO (Expr t ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0

initHashTable :: (HashableF key, TestEquality key)
              => Ctx.Assignment key args
              -> Ctx.Assignment val args
              -> ST s (PH.HashTable s key val)
initHashTable :: forall {k} (key :: k -> Type) (args :: Ctx k) (val :: k -> Type) s.
(HashableF key, TestEquality key) =>
Assignment key args
-> Assignment val args -> ST s (HashTable s key val)
initHashTable Assignment key args
keys Assignment val args
vals = do
  let sz :: Size args
sz = Assignment key args -> Size args
forall {k} (f :: k -> Type) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size Assignment key args
keys
  HashTable s key val
tbl <- Int -> ST s (HashTable s key val)
forall {k1} s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized (Size args -> Int
forall {k} (ctx :: Ctx k). Size ctx -> Int
Ctx.sizeInt Size args
sz)
  Size args
-> (forall {tp :: k}. Index args tp -> ST s ()) -> ST s ()
forall {k} (ctx :: Ctx k) (m :: Type -> Type).
Applicative m =>
Size ctx -> (forall (tp :: k). Index ctx tp -> m ()) -> m ()
Ctx.forIndexM Size args
sz ((forall {tp :: k}. Index args tp -> ST s ()) -> ST s ())
-> (forall {tp :: k}. Index args tp -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Index args tp
i -> do
    HashTable s key val -> key tp -> val tp -> ST s ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable s key val
tbl (Assignment key args
keys Assignment key args -> Index args tp -> key tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index args tp
i) (Assignment val args
vals Assignment val args -> Index args tp -> val tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index args tp
i)
  HashTable s key val -> ST s (HashTable s key val)
forall a. a -> ST s a
forall (m :: Type -> Type) a. Monad m => a -> m a
return HashTable s key val
tbl

-- | This evaluates the term with the given bound variables rebound to
-- the given arguments.
--
-- The algorithm works by traversing the subterms in the term in a bottom-up
-- fashion while using a hash-table to memoize results for shared subterms.  The
-- hash-table is pre-populated so that the bound variables map to the element,
-- so we do not need any extra map lookup when checking to see if a variable is
-- bound.
--
-- NOTE: This function assumes that variables in the substitution are not
-- themselves bound in the term (e.g. in a function definition or quantifier).
-- If this is not respected, then 'evalBoundVars' will call 'fail' with an
-- error message.
evalBoundVars :: ExprBuilder t st fs
              -> Expr t ret
              -> Ctx.Assignment (ExprBoundVar t) args
              -> Ctx.Assignment (Expr t) args
              -> IO (Expr t ret)
evalBoundVars :: forall t (st :: Type -> Type) fs (ret :: BaseType)
       (args :: Ctx BaseType).
ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
evalBoundVars ExprBuilder t st fs
sym Expr t ret
e Assignment (ExprBoundVar t) args
vars Assignment (Expr t) args
exprs = do
  HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
-> IO (HashTable RealWorld (Expr t) (Expr t))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
 -> IO (HashTable RealWorld (Expr t) (Expr t)))
-> ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
-> IO (HashTable RealWorld (Expr t) (Expr t))
forall a b. (a -> b) -> a -> b
$ Assignment (Expr t) args
-> Assignment (Expr t) args
-> ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
forall {k} (key :: k -> Type) (args :: Ctx k) (val :: k -> Type) s.
(HashableF key, TestEquality key) =>
Assignment key args
-> Assignment val args -> ST s (HashTable s key val)
initHashTable ((forall (x :: BaseType). ExprBoundVar t x -> Expr t x)
-> forall (x :: Ctx BaseType).
   Assignment (ExprBoundVar t) x -> Assignment (Expr t) x
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
fmapFC ExprBoundVar t x -> Expr t x
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
forall (x :: BaseType). ExprBoundVar t x -> Expr t x
BoundVarExpr Assignment (ExprBoundVar t) args
vars) Assignment (Expr t) args
exprs
  HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl  <- ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
-> IO (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
 -> IO (HashTable RealWorld (Nonce t) (CachedSymFn t)))
-> ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
-> IO (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall a b. (a -> b) -> a -> b
$ ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
  let tbls :: EvalHashTables t
tbls = EvalHashTables { exprTable :: HashTable RealWorld (Expr t) (Expr t)
exprTable = HashTable RealWorld (Expr t) (Expr t)
expr_tbl
                            , fnTable :: HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable  = HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl
                            }
  EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t ret
e


-- | `ExprTransformer` and the associated code implement bidirectional bitvector
-- (BV) to/from linear integer arithmetic (LIA) transformations. This is done by
-- replacing all BV operations with LIA operations, replacing all BV variables
-- with LIA variables, and by replacing all BV function symbols with LIA
-- function symbols. The reverse transformation works the same way, but in
-- reverse. This transformation is not sound, but in practice it is useful.
--
-- This is used to implement `transformPredBV2LIA` and `transformSymFnLIA2BV`,
-- which in turn are used to implement @runZ3Horn@.
--
-- This is highly experimental and may be unstable.
newtype ExprTransformer t (tp1 :: BaseType) (tp2 :: BaseType) a =
  ExprTransformer (ExceptT String (ReaderT (ExprTransformerTables t tp1 tp2) IO) a)
  deriving ((forall a b.
 (a -> b)
 -> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b)
-> (forall a b.
    a -> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a)
-> Functor (ExprTransformer t tp1 tp2)
forall a b.
a -> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a
forall a b.
(a -> b)
-> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b
forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
a -> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a
forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
(a -> b)
-> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
(a -> b)
-> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b
fmap :: forall a b.
(a -> b)
-> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b
$c<$ :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
a -> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a
<$ :: forall a b.
a -> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a
Functor, Functor (ExprTransformer t tp1 tp2)
Functor (ExprTransformer t tp1 tp2) =>
(forall a. a -> ExprTransformer t tp1 tp2 a)
-> (forall a b.
    ExprTransformer t tp1 tp2 (a -> b)
    -> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b)
-> (forall a b c.
    (a -> b -> c)
    -> ExprTransformer t tp1 tp2 a
    -> ExprTransformer t tp1 tp2 b
    -> ExprTransformer t tp1 tp2 c)
-> (forall a b.
    ExprTransformer t tp1 tp2 a
    -> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b)
-> (forall a b.
    ExprTransformer t tp1 tp2 a
    -> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a)
-> Applicative (ExprTransformer t tp1 tp2)
forall a. a -> ExprTransformer t tp1 tp2 a
forall a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a
forall a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b
forall a b.
ExprTransformer t tp1 tp2 (a -> b)
-> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b
forall a b c.
(a -> b -> c)
-> ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b
-> ExprTransformer t tp1 tp2 c
forall t (tp1 :: BaseType) (tp2 :: BaseType).
Functor (ExprTransformer t tp1 tp2)
forall t (tp1 :: BaseType) (tp2 :: BaseType) a.
a -> ExprTransformer t tp1 tp2 a
forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a
forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b
forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 (a -> b)
-> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b
forall t (tp1 :: BaseType) (tp2 :: BaseType) a b c.
(a -> b -> c)
-> ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b
-> ExprTransformer t tp1 tp2 c
forall (f :: Type -> Type).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a.
a -> ExprTransformer t tp1 tp2 a
pure :: forall a. a -> ExprTransformer t tp1 tp2 a
$c<*> :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 (a -> b)
-> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b
<*> :: forall a b.
ExprTransformer t tp1 tp2 (a -> b)
-> ExprTransformer t tp1 tp2 a -> ExprTransformer t tp1 tp2 b
$cliftA2 :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a b c.
(a -> b -> c)
-> ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b
-> ExprTransformer t tp1 tp2 c
liftA2 :: forall a b c.
(a -> b -> c)
-> ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b
-> ExprTransformer t tp1 tp2 c
$c*> :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b
*> :: forall a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b
$c<* :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a
<* :: forall a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 a
Applicative, Applicative (ExprTransformer t tp1 tp2)
Applicative (ExprTransformer t tp1 tp2) =>
(forall a b.
 ExprTransformer t tp1 tp2 a
 -> (a -> ExprTransformer t tp1 tp2 b)
 -> ExprTransformer t tp1 tp2 b)
-> (forall a b.
    ExprTransformer t tp1 tp2 a
    -> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b)
-> (forall a. a -> ExprTransformer t tp1 tp2 a)
-> Monad (ExprTransformer t tp1 tp2)
forall a. a -> ExprTransformer t tp1 tp2 a
forall a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b
forall a b.
ExprTransformer t tp1 tp2 a
-> (a -> ExprTransformer t tp1 tp2 b)
-> ExprTransformer t tp1 tp2 b
forall t (tp1 :: BaseType) (tp2 :: BaseType).
Applicative (ExprTransformer t tp1 tp2)
forall t (tp1 :: BaseType) (tp2 :: BaseType) a.
a -> ExprTransformer t tp1 tp2 a
forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b
forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 a
-> (a -> ExprTransformer t tp1 tp2 b)
-> ExprTransformer t tp1 tp2 b
forall (m :: Type -> Type).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 a
-> (a -> ExprTransformer t tp1 tp2 b)
-> ExprTransformer t tp1 tp2 b
>>= :: forall a b.
ExprTransformer t tp1 tp2 a
-> (a -> ExprTransformer t tp1 tp2 b)
-> ExprTransformer t tp1 tp2 b
$c>> :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b
>> :: forall a b.
ExprTransformer t tp1 tp2 a
-> ExprTransformer t tp1 tp2 b -> ExprTransformer t tp1 tp2 b
$creturn :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a.
a -> ExprTransformer t tp1 tp2 a
return :: forall a. a -> ExprTransformer t tp1 tp2 a
Monad, Monad (ExprTransformer t tp1 tp2)
Monad (ExprTransformer t tp1 tp2) =>
(forall a. IO a -> ExprTransformer t tp1 tp2 a)
-> MonadIO (ExprTransformer t tp1 tp2)
forall a. IO a -> ExprTransformer t tp1 tp2 a
forall t (tp1 :: BaseType) (tp2 :: BaseType).
Monad (ExprTransformer t tp1 tp2)
forall t (tp1 :: BaseType) (tp2 :: BaseType) a.
IO a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a.
IO a -> ExprTransformer t tp1 tp2 a
liftIO :: forall a. IO a -> ExprTransformer t tp1 tp2 a
MonadIO, MonadReader (ExprTransformerTables t tp1 tp2), MonadError String)

data ExprTransformerTables t (tp1 :: BaseType) (tp2 :: BaseType) = ExprTransformerTables
  { forall t (tp1 :: BaseType) (tp2 :: BaseType).
ExprTransformerTables t tp1 tp2 -> EvalHashTables t
evalTables :: !(EvalHashTables t)
  , forall t (tp1 :: BaseType) (tp2 :: BaseType).
ExprTransformerTables t tp1 tp2
-> BasicHashTable (ExprBoundVar t tp1) (ExprBoundVar t tp2)
transformerSubst :: !(H.BasicHashTable (ExprBoundVar t tp1) (ExprBoundVar t tp2))
  , forall t (tp1 :: BaseType) (tp2 :: BaseType).
ExprTransformerTables t tp1 tp2
-> BasicHashTable (SomeExprSymFn t) (SomeExprSymFn t)
transformerFnSubst :: !(H.BasicHashTable (SomeExprSymFn t) (SomeExprSymFn t))
  }

runExprTransformer :: ExprTransformer t tp1 tp2 a -> ExprTransformerTables t tp1 tp2 -> IO (Either String a)
runExprTransformer :: forall t (tp1 :: BaseType) (tp2 :: BaseType) a.
ExprTransformer t tp1 tp2 a
-> ExprTransformerTables t tp1 tp2 -> IO (Either String a)
runExprTransformer (ExprTransformer ExceptT String (ReaderT (ExprTransformerTables t tp1 tp2) IO) a
action) = ReaderT (ExprTransformerTables t tp1 tp2) IO (Either String a)
-> ExprTransformerTables t tp1 tp2 -> IO (Either String a)
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (ExceptT String (ReaderT (ExprTransformerTables t tp1 tp2) IO) a
-> ReaderT (ExprTransformerTables t tp1 tp2) IO (Either String a)
forall e (m :: Type -> Type) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT String (ReaderT (ExprTransformerTables t tp1 tp2) IO) a
action)

type BV2LIAExprTransformer t = ExprTransformer t (BaseBVType 64) BaseIntegerType
type LIA2BVExprTransformer t = ExprTransformer t BaseIntegerType (BaseBVType 64)
type HasTransformerConstraints t st fs tp1 tp2 =
  ( KnownRepr BaseTypeRepr tp1
  , KnownRepr BaseTypeRepr tp2
  , ?transformCmpTp1ToTp2 :: ExprBuilder t st fs -> Expr t BaseBoolType -> Maybe (ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
  , ?transformExprTp1ToTp2 :: ExprBuilder t st fs -> Expr t tp1 -> ExprTransformer t tp1 tp2 (Expr t tp2)
  )

transformPred ::
  forall t st fs tp1 tp2 .
  HasTransformerConstraints t st fs tp1 tp2 =>
  ExprBuilder t st fs ->
  Expr t BaseBoolType ->
  ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred :: forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym Expr t BaseBoolType
e0 = Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall t (tp :: BaseType) (tp1 :: BaseType) (tp2 :: BaseType).
Expr t tp
-> ExprTransformer t tp1 tp2 (Expr t tp)
-> ExprTransformer t tp1 tp2 (Expr t tp)
exprTransformerCachedEval Expr t BaseBoolType
e0 (ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
 -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ case Expr t BaseBoolType
e0 of
  Expr t BaseBoolType
_ | Just ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
action <- ?transformCmpTp1ToTp2::ExprBuilder t st fs
                       -> Expr t BaseBoolType
                       -> Maybe (ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
?transformCmpTp1ToTp2 ExprBuilder t st fs
sym Expr t BaseBoolType
e0 -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
action

  BoolExpr{} -> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseBoolType
e0

  AppExpr AppExpr t BaseBoolType
ae -> do
    let a :: App (Expr t) BaseBoolType
a = AppExpr t BaseBoolType -> App (Expr t) BaseBoolType
forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t BaseBoolType
ae
    App (Expr t) BaseBoolType
a' <- (forall (tp :: BaseType).
 Expr t tp -> ExprTransformer t tp1 tp2 (Expr t tp))
-> App (Expr t) BaseBoolType
-> ExprTransformer t tp1 tp2 (App (Expr t) BaseBoolType)
forall (m :: Type -> Type) (f :: BaseType -> Type)
       (e :: BaseType -> Type) (utp :: BaseType).
(Applicative m, OrdF f, Eq (f BaseBoolType), HashableF f,
 HasAbsValue f) =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> App e utp -> m (App f utp)
traverseApp
      (\Expr t tp
a'' -> case BaseTypeRepr BaseBoolType
-> BaseTypeRepr tp -> Maybe (BaseBoolType :~: tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality BaseTypeRepr BaseBoolType
BaseBoolRepr (Expr t tp -> BaseTypeRepr tp
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t tp
a'') of
        Just BaseBoolType :~: tp
Refl -> ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym Expr t tp
Expr t BaseBoolType
a''
        Maybe (BaseBoolType :~: tp)
Nothing -> String -> ExprTransformer t tp1 tp2 (Expr t tp)
forall a. String -> ExprTransformer t tp1 tp2 a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> ExprTransformer t tp1 tp2 (Expr t tp))
-> String -> ExprTransformer t tp1 tp2 (Expr t tp)
forall a b. (a -> b) -> a -> b
$ String
"transformPred: unsupported non-boolean expression " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr t tp -> String
forall a. Show a => a -> String
show Expr t tp
a'')
      App (Expr t) BaseBoolType
a
    if App (Expr t) BaseBoolType
a App (Expr t) BaseBoolType -> App (Expr t) BaseBoolType -> Bool
forall a. Eq a => a -> a -> Bool
== App (Expr t) BaseBoolType
a' then
      Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseBoolType
e0
    else
      IO (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. IO a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> (forall (w :: Natural).
    (1 <= w) =>
    ExprBuilder t st fs
    -> UnaryBV (Pred (ExprBuilder t st fs)) w
    -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w)))
-> App (SymExpr (ExprBuilder t st fs)) BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> (forall (w :: Natural).
    (1 <= w) =>
    sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w)))
-> App (SymExpr sym) tp
-> IO (SymExpr sym tp)
reduceApp ExprBuilder t st fs
sym ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (SymExpr (ExprBuilder t st fs) ('BaseBVType w))
ExprBuilder t st fs
-> UnaryBV (Expr t BaseBoolType) w -> IO (BVExpr t w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary App (SymExpr (ExprBuilder t st fs)) BaseBoolType
App (Expr t) BaseBoolType
a'

  NonceAppExpr NonceAppExpr t BaseBoolType
ae -> do
    case NonceAppExpr t BaseBoolType -> NonceApp t (Expr t) BaseBoolType
forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp NonceAppExpr t BaseBoolType
ae of
      Annotation BaseTypeRepr BaseBoolType
tpr Nonce t BaseBoolType
n Expr t BaseBoolType
a -> do
        Expr t BaseBoolType
a' <- ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym Expr t BaseBoolType
a
        if Expr t BaseBoolType
a Expr t BaseBoolType -> Expr t BaseBoolType -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t BaseBoolType
a' then
          Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseBoolType
e0
        else
          IO (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. IO a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> NonceApp t (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) BaseBoolType -> IO (Expr t BaseBoolType))
-> NonceApp t (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr BaseBoolType
-> Nonce t BaseBoolType
-> Expr t BaseBoolType
-> NonceApp t (Expr t) BaseBoolType
forall (tp :: BaseType) t (e :: BaseType -> Type).
BaseTypeRepr tp -> Nonce t tp -> e tp -> NonceApp t e tp
Annotation BaseTypeRepr BaseBoolType
tpr Nonce t BaseBoolType
n Expr t BaseBoolType
a'
      Forall ExprBoundVar t tp1
v Expr t BaseBoolType
e -> do
        Expr t BaseBoolType -> IO (Expr t BaseBoolType)
quantifier <- ExprBuilder t st fs
-> ExprBoundVar t tp1
-> (forall (tp' :: BaseType).
    ExprBoundVar t tp'
    -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> ExprTransformer
     t tp1 tp2 (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall t (st :: Type -> Type) fs (tp :: BaseType) (tp1 :: BaseType)
       (tp2 :: BaseType) a.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
ExprBuilder t st fs
-> ExprBoundVar t tp
-> (forall (tp' :: BaseType). ExprBoundVar t tp' -> a)
-> ExprTransformer t tp1 tp2 a
transformVarTp1ToTp2WithCont ExprBuilder t st fs
sym ExprBoundVar t tp1
v (ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp'
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forallPred ExprBuilder t st fs
sym)
        -- Regenerate forallPred if e is changed by evaluation.
        Expr t BaseBoolType
-> (Expr t BaseBoolType
    -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> Expr t BaseBoolType
-> (Expr t BaseBoolType
    -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall e (m :: Type -> Type) r.
(Eq e, Monad m) =>
e -> (e -> m e) -> r -> (e -> m r) -> m r
runIfChanged Expr t BaseBoolType
e (ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym) Expr t BaseBoolType
e0 ((Expr t BaseBoolType
  -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
 -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> (Expr t BaseBoolType
    -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ IO (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. IO a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr t BaseBoolType -> IO (Expr t BaseBoolType)
quantifier
      Exists ExprBoundVar t tp1
v Expr t BaseBoolType
e -> do
        Expr t BaseBoolType -> IO (Expr t BaseBoolType)
quantifier <- ExprBuilder t st fs
-> ExprBoundVar t tp1
-> (forall (tp' :: BaseType).
    ExprBoundVar t tp'
    -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> ExprTransformer
     t tp1 tp2 (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall t (st :: Type -> Type) fs (tp :: BaseType) (tp1 :: BaseType)
       (tp2 :: BaseType) a.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
ExprBuilder t st fs
-> ExprBoundVar t tp
-> (forall (tp' :: BaseType). ExprBoundVar t tp' -> a)
-> ExprTransformer t tp1 tp2 a
transformVarTp1ToTp2WithCont ExprBuilder t st fs
sym ExprBoundVar t tp1
v (ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp'
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
existsPred ExprBuilder t st fs
sym)
        -- Regenerate existsPred if e is changed by evaluation.
        Expr t BaseBoolType
-> (Expr t BaseBoolType
    -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> Expr t BaseBoolType
-> (Expr t BaseBoolType
    -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall e (m :: Type -> Type) r.
(Eq e, Monad m) =>
e -> (e -> m e) -> r -> (e -> m r) -> m r
runIfChanged Expr t BaseBoolType
e (ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym) Expr t BaseBoolType
e0 ((Expr t BaseBoolType
  -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
 -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> (Expr t BaseBoolType
    -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ IO (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. IO a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr t BaseBoolType -> IO (Expr t BaseBoolType)
quantifier
      FnApp ExprSymFn t args BaseBoolType
f Assignment (Expr t) args
a -> do
        (SomeExprSymFn ExprSymFn t args ret
f') <- ExprBuilder t st fs
-> SomeExprSymFn t -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> SomeExprSymFn t -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
transformFn ExprBuilder t st fs
sym (SomeExprSymFn t -> ExprTransformer t tp1 tp2 (SomeExprSymFn t))
-> SomeExprSymFn t -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a b. (a -> b) -> a -> b
$ ExprSymFn t args BaseBoolType -> SomeExprSymFn t
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SomeExprSymFn t
SomeExprSymFn ExprSymFn t args BaseBoolType
f
        (Some Assignment (Expr t) x
a') <- [Some (Expr t)] -> Some (Assignment (Expr t))
forall {k} (f :: k -> Type). [Some f] -> Some (Assignment f)
Ctx.fromList ([Some (Expr t)] -> Some (Assignment (Expr t)))
-> ExprTransformer t tp1 tp2 [Some (Expr t)]
-> ExprTransformer t tp1 tp2 (Some (Assignment (Expr t)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Some (Expr t) -> ExprTransformer t tp1 tp2 (Some (Expr t)))
-> [Some (Expr t)] -> ExprTransformer t tp1 tp2 [Some (Expr t)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM
          (\(Some Expr t x
a'') ->
            (Expr t tp1 -> ExprTransformer t tp1 tp2 (Expr t tp2))
-> (Expr t BaseBoolType
    -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> (forall (tp' :: BaseType). Expr t tp' -> Some (Expr t))
-> BaseTypeRepr x
-> Expr t x
-> ExprTransformer t tp1 tp2 (Some (Expr t))
forall t (tp :: BaseType) (tp1 :: BaseType) (tp2 :: BaseType)
       (e :: BaseType -> Type) a.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2,
 Show (e tp)) =>
(e tp1 -> ExprTransformer t tp1 tp2 (e tp2))
-> (e BaseBoolType -> ExprTransformer t tp1 tp2 (e BaseBoolType))
-> (forall (tp' :: BaseType). e tp' -> a)
-> BaseTypeRepr tp
-> e tp
-> ExprTransformer t tp1 tp2 a
applyTp1ToTp2FunWithCont (?transformExprTp1ToTp2::ExprBuilder t st fs
                        -> Expr t tp1 -> ExprTransformer t tp1 tp2 (Expr t tp2)
ExprBuilder t st fs
-> Expr t tp1 -> ExprTransformer t tp1 tp2 (Expr t tp2)
?transformExprTp1ToTp2 ExprBuilder t st fs
sym) (ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym) Expr t tp' -> Some (Expr t)
forall k (f :: k -> Type) (x :: k). f x -> Some f
forall (tp' :: BaseType). Expr t tp' -> Some (Expr t)
Some (Expr t x -> BaseTypeRepr x
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t x
a'') Expr t x
a'')
          ((forall (tp' :: BaseType). Expr t tp' -> Some (Expr t))
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> [Some (Expr t)]
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
forall (f :: BaseType -> Type) a.
(forall (x :: BaseType). f x -> a)
-> forall (x :: Ctx BaseType). Assignment f x -> [a]
toListFC Expr t x -> Some (Expr t)
forall k (f :: k -> Type) (x :: k). f x -> Some f
forall (tp' :: BaseType). Expr t tp' -> Some (Expr t)
Some Assignment (Expr t) args
a)
        case Assignment BaseTypeRepr (x ::> BaseBoolType)
-> Assignment BaseTypeRepr (args ::> ret)
-> Maybe ((x ::> BaseBoolType) :~: (args ::> ret))
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Ctx BaseType) (b :: Ctx BaseType).
Assignment BaseTypeRepr a
-> Assignment BaseTypeRepr b -> Maybe (a :~: b)
testEquality (((forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp)
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> Assignment BaseTypeRepr x
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
fmapFC Expr t x -> BaseTypeRepr x
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (Expr t) x
a') Assignment BaseTypeRepr x
-> BaseTypeRepr BaseBoolType
-> Assignment BaseTypeRepr (x ::> BaseBoolType)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
:> (ExprSymFn t args BaseBoolType -> BaseTypeRepr BaseBoolType
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> BaseTypeRepr ret
fnReturnType ExprSymFn t args BaseBoolType
f)) ((ExprSymFn t args ret -> Assignment BaseTypeRepr args
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Assignment BaseTypeRepr args
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> Assignment BaseTypeRepr args
fnArgTypes ExprSymFn t args ret
f') Assignment BaseTypeRepr args
-> BaseTypeRepr ret -> Assignment BaseTypeRepr (args ::> ret)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
:> (ExprSymFn t args ret -> BaseTypeRepr ret
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> BaseTypeRepr ret
fnReturnType ExprSymFn t args ret
f')) of
          Just (x ::> BaseBoolType) :~: (args ::> ret)
Refl -> IO (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. IO a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) args BaseBoolType
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (Pred (ExprBuilder t st fs))
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) args ret
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
applySymFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) args BaseBoolType
ExprSymFn t args ret
f' Assignment (SymExpr (ExprBuilder t st fs)) args
Assignment (Expr t) x
a'
          Maybe ((x ::> BaseBoolType) :~: (args ::> ret))
Nothing -> String -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. String -> ExprTransformer t tp1 tp2 a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> String -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ String
"transformPred: unsupported FnApp " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr t BaseBoolType -> String
forall a. Show a => a -> String
show Expr t BaseBoolType
e0
      NonceApp t (Expr t) BaseBoolType
_ -> String -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. String -> ExprTransformer t tp1 tp2 a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType))
-> String -> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ String
"transformPred: unsupported NonceAppExpr " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr t BaseBoolType -> String
forall a. Show a => a -> String
show Expr t BaseBoolType
e0

  BoundVarExpr{} -> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall a. a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseBoolType
e0

transformFn ::
  forall t st fs tp1 tp2 .
  HasTransformerConstraints t st fs tp1 tp2 =>
  ExprBuilder t st fs ->
  SomeExprSymFn t ->
  ExprTransformer t tp1 tp2 (SomeExprSymFn t)
transformFn :: forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> SomeExprSymFn t -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
transformFn ExprBuilder t st fs
sym (SomeExprSymFn ExprSymFn t args ret
f) = do
  HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t)
inv_subst <- (ExprTransformerTables t tp1 tp2
 -> HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t))
-> ExprTransformer
     t tp1 tp2 (HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t))
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks ExprTransformerTables t tp1 tp2
-> HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t)
ExprTransformerTables t tp1 tp2
-> BasicHashTable (SomeExprSymFn t) (SomeExprSymFn t)
forall t (tp1 :: BaseType) (tp2 :: BaseType).
ExprTransformerTables t tp1 tp2
-> BasicHashTable (SomeExprSymFn t) (SomeExprSymFn t)
transformerFnSubst
  case ExprSymFn t args ret -> SymFnInfo t args ret
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args ret
f of
    UninterpFnInfo{}
      | Just BaseBoolType :~: ret
Refl <- BaseTypeRepr BaseBoolType
-> BaseTypeRepr ret -> Maybe (BaseBoolType :~: ret)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality BaseTypeRepr BaseBoolType
BaseBoolRepr (ExprSymFn t args ret -> BaseTypeRepr ret
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> BaseTypeRepr ret
fnReturnType ExprSymFn t args ret
f) -> do
        (Some Assignment BaseTypeRepr x
tps) <- [Some BaseTypeRepr] -> Some (Assignment BaseTypeRepr)
forall {k} (f :: k -> Type). [Some f] -> Some (Assignment f)
Ctx.fromList ([Some BaseTypeRepr] -> Some (Assignment BaseTypeRepr))
-> ExprTransformer t tp1 tp2 [Some BaseTypeRepr]
-> ExprTransformer t tp1 tp2 (Some (Assignment BaseTypeRepr))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Some BaseTypeRepr
 -> ExprTransformer t tp1 tp2 (Some BaseTypeRepr))
-> [Some BaseTypeRepr]
-> ExprTransformer t tp1 tp2 [Some BaseTypeRepr]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM
          (\(Some BaseTypeRepr x
tp) -> (BaseTypeRepr tp1 -> ExprTransformer t tp1 tp2 (BaseTypeRepr tp2))
-> (BaseTypeRepr BaseBoolType
    -> ExprTransformer t tp1 tp2 (BaseTypeRepr BaseBoolType))
-> (forall (tp' :: BaseType).
    BaseTypeRepr tp' -> Some BaseTypeRepr)
-> BaseTypeRepr x
-> BaseTypeRepr x
-> ExprTransformer t tp1 tp2 (Some BaseTypeRepr)
forall t (tp :: BaseType) (tp1 :: BaseType) (tp2 :: BaseType)
       (e :: BaseType -> Type) a.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2,
 Show (e tp)) =>
(e tp1 -> ExprTransformer t tp1 tp2 (e tp2))
-> (e BaseBoolType -> ExprTransformer t tp1 tp2 (e BaseBoolType))
-> (forall (tp' :: BaseType). e tp' -> a)
-> BaseTypeRepr tp
-> e tp
-> ExprTransformer t tp1 tp2 a
applyTp1ToTp2FunWithCont (\BaseTypeRepr tp1
_ -> BaseTypeRepr tp2 -> ExprTransformer t tp1 tp2 (BaseTypeRepr tp2)
forall a. a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BaseTypeRepr tp2
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr) BaseTypeRepr BaseBoolType
-> ExprTransformer t tp1 tp2 (BaseTypeRepr BaseBoolType)
forall a. a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BaseTypeRepr tp' -> Some BaseTypeRepr
forall k (f :: k -> Type) (x :: k). f x -> Some f
forall (tp' :: BaseType). BaseTypeRepr tp' -> Some BaseTypeRepr
Some BaseTypeRepr x
tp BaseTypeRepr x
tp)
          ((forall (tp' :: BaseType). BaseTypeRepr tp' -> Some BaseTypeRepr)
-> forall (x :: Ctx BaseType).
   Assignment BaseTypeRepr x -> [Some BaseTypeRepr]
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
forall (f :: BaseType -> Type) a.
(forall (x :: BaseType). f x -> a)
-> forall (x :: Ctx BaseType). Assignment f x -> [a]
toListFC BaseTypeRepr x -> Some BaseTypeRepr
forall k (f :: k -> Type) (x :: k). f x -> Some f
forall (tp' :: BaseType). BaseTypeRepr tp' -> Some BaseTypeRepr
Some (Assignment BaseTypeRepr args -> [Some BaseTypeRepr])
-> Assignment BaseTypeRepr args -> [Some BaseTypeRepr]
forall a b. (a -> b) -> a -> b
$ ExprSymFn t args ret -> Assignment BaseTypeRepr args
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Assignment BaseTypeRepr args
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> Assignment BaseTypeRepr args
fnArgTypes ExprSymFn t args ret
f)
        IO (SomeExprSymFn t) -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a. IO a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SomeExprSymFn t)
 -> ExprTransformer t tp1 tp2 (SomeExprSymFn t))
-> IO (SomeExprSymFn t)
-> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a b. (a -> b) -> a -> b
$ BasicHashTable (SomeExprSymFn t) (SomeExprSymFn t)
-> SomeExprSymFn t -> IO (SomeExprSymFn t) -> IO (SomeExprSymFn t)
forall (h :: Type -> Type -> Type -> Type) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO v -> IO v
mutateInsertIO HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t)
BasicHashTable (SomeExprSymFn t) (SomeExprSymFn t)
inv_subst (ExprSymFn t args ret -> SomeExprSymFn t
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SomeExprSymFn t
SomeExprSymFn ExprSymFn t args ret
f) (IO (SomeExprSymFn t) -> IO (SomeExprSymFn t))
-> IO (SomeExprSymFn t) -> IO (SomeExprSymFn t)
forall a b. (a -> b) -> a -> b
$
          ExprSymFn t x BaseBoolType -> SomeExprSymFn t
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SomeExprSymFn t
SomeExprSymFn (ExprSymFn t x BaseBoolType -> SomeExprSymFn t)
-> IO (ExprSymFn t x BaseBoolType) -> IO (SomeExprSymFn t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> SolverSymbol
-> Assignment BaseTypeRepr x
-> BaseTypeRepr BaseBoolType
-> IO (SymFn (ExprBuilder t st fs) x BaseBoolType)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn (ExprBuilder t st fs) args ret)
freshTotalUninterpFn ExprBuilder t st fs
sym (ExprSymFn t args ret -> SolverSymbol
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName ExprSymFn t args ret
f) Assignment BaseTypeRepr x
tps BaseTypeRepr BaseBoolType
BaseBoolRepr
      | Bool
otherwise -> String -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a. String -> ExprTransformer t tp1 tp2 a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> ExprTransformer t tp1 tp2 (SomeExprSymFn t))
-> String -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a b. (a -> b) -> a -> b
$ String
"transformFn: unsupported UninterpFnInfo " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExprSymFn t args ret -> String
forall a. Show a => a -> String
show ExprSymFn t args ret
f

    DefinedFnInfo Assignment (ExprBoundVar t) args
vars Expr t ret
e UnfoldPolicy
eval_fn
      | Just BaseBoolType :~: ret
Refl <- BaseTypeRepr BaseBoolType
-> BaseTypeRepr ret -> Maybe (BaseBoolType :~: ret)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality BaseTypeRepr BaseBoolType
BaseBoolRepr (ExprSymFn t args ret -> BaseTypeRepr ret
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> BaseTypeRepr ret
fnReturnType ExprSymFn t args ret
f) -> do
        (Some Assignment (ExprBoundVar t) x
vars') <- [Some (ExprBoundVar t)] -> Some (Assignment (ExprBoundVar t))
forall {k} (f :: k -> Type). [Some f] -> Some (Assignment f)
Ctx.fromList ([Some (ExprBoundVar t)] -> Some (Assignment (ExprBoundVar t)))
-> ExprTransformer t tp1 tp2 [Some (ExprBoundVar t)]
-> ExprTransformer t tp1 tp2 (Some (Assignment (ExprBoundVar t)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
          (Some (ExprBoundVar t)
 -> ExprTransformer t tp1 tp2 (Some (ExprBoundVar t)))
-> [Some (ExprBoundVar t)]
-> ExprTransformer t tp1 tp2 [Some (ExprBoundVar t)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\(Some ExprBoundVar t x
v) -> ExprBuilder t st fs
-> ExprBoundVar t x
-> (forall (tp' :: BaseType).
    ExprBoundVar t tp' -> Some (ExprBoundVar t))
-> ExprTransformer t tp1 tp2 (Some (ExprBoundVar t))
forall t (st :: Type -> Type) fs (tp :: BaseType) (tp1 :: BaseType)
       (tp2 :: BaseType) a.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
ExprBuilder t st fs
-> ExprBoundVar t tp
-> (forall (tp' :: BaseType). ExprBoundVar t tp' -> a)
-> ExprTransformer t tp1 tp2 a
transformVarTp1ToTp2WithCont ExprBuilder t st fs
sym ExprBoundVar t x
v ExprBoundVar t tp' -> Some (ExprBoundVar t)
forall k (f :: k -> Type) (x :: k). f x -> Some f
forall (tp' :: BaseType).
ExprBoundVar t tp' -> Some (ExprBoundVar t)
Some) ((forall (tp' :: BaseType).
 ExprBoundVar t tp' -> Some (ExprBoundVar t))
-> forall (x :: Ctx BaseType).
   Assignment (ExprBoundVar t) x -> [Some (ExprBoundVar t)]
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) a.
FoldableFC t =>
(forall (x :: k). f x -> a) -> forall (x :: l). t f x -> [a]
forall (f :: BaseType -> Type) a.
(forall (x :: BaseType). f x -> a)
-> forall (x :: Ctx BaseType). Assignment f x -> [a]
toListFC ExprBoundVar t x -> Some (ExprBoundVar t)
forall k (f :: k -> Type) (x :: k). f x -> Some f
forall (tp' :: BaseType).
ExprBoundVar t tp' -> Some (ExprBoundVar t)
Some Assignment (ExprBoundVar t) args
vars)
        Expr t BaseBoolType
e' <- ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym Expr t ret
Expr t BaseBoolType
e
        IO (SomeExprSymFn t) -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a. IO a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (SomeExprSymFn t)
 -> ExprTransformer t tp1 tp2 (SomeExprSymFn t))
-> IO (SomeExprSymFn t)
-> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a b. (a -> b) -> a -> b
$ BasicHashTable (SomeExprSymFn t) (SomeExprSymFn t)
-> SomeExprSymFn t -> IO (SomeExprSymFn t) -> IO (SomeExprSymFn t)
forall (h :: Type -> Type -> Type -> Type) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO v -> IO v
mutateInsertIO HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t)
BasicHashTable (SomeExprSymFn t) (SomeExprSymFn t)
inv_subst (ExprSymFn t args ret -> SomeExprSymFn t
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SomeExprSymFn t
SomeExprSymFn ExprSymFn t args ret
f) (IO (SomeExprSymFn t) -> IO (SomeExprSymFn t))
-> IO (SomeExprSymFn t) -> IO (SomeExprSymFn t)
forall a b. (a -> b) -> a -> b
$
          ExprSymFn t x BaseBoolType -> SomeExprSymFn t
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SomeExprSymFn t
SomeExprSymFn (ExprSymFn t x BaseBoolType -> SomeExprSymFn t)
-> IO (ExprSymFn t x BaseBoolType) -> IO (SomeExprSymFn t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> SolverSymbol
-> Assignment (BoundVar (ExprBuilder t st fs)) x
-> SymExpr (ExprBuilder t st fs) BaseBoolType
-> UnfoldPolicy
-> IO (SymFn (ExprBuilder t st fs) x BaseBoolType)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment (BoundVar sym) args
-> SymExpr sym ret
-> UnfoldPolicy
-> IO (SymFn sym args ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> Assignment (BoundVar (ExprBuilder t st fs)) args
-> SymExpr (ExprBuilder t st fs) ret
-> UnfoldPolicy
-> IO (SymFn (ExprBuilder t st fs) args ret)
definedFn ExprBuilder t st fs
sym (ExprSymFn t args ret -> SolverSymbol
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName ExprSymFn t args ret
f) Assignment (BoundVar (ExprBuilder t st fs)) x
Assignment (ExprBoundVar t) x
vars' SymExpr (ExprBuilder t st fs) BaseBoolType
Expr t BaseBoolType
e' UnfoldPolicy
eval_fn
      | Bool
otherwise -> String -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a. String -> ExprTransformer t tp1 tp2 a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> ExprTransformer t tp1 tp2 (SomeExprSymFn t))
-> String -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a b. (a -> b) -> a -> b
$ String
"transformFn: unsupported DefinedFnInfo " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExprSymFn t args ret -> String
forall a. Show a => a -> String
show ExprSymFn t args ret
f

    MatlabSolverFnInfo{} -> String -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a. String -> ExprTransformer t tp1 tp2 a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> ExprTransformer t tp1 tp2 (SomeExprSymFn t))
-> String -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
forall a b. (a -> b) -> a -> b
$ String
"transformFn: unsupported MatlabSolverFnInfo " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ExprSymFn t args ret -> String
forall a. Show a => a -> String
show ExprSymFn t args ret
f

exprTransformerCachedEval ::
  Expr t tp -> ExprTransformer t tp1 tp2 (Expr t tp) -> ExprTransformer t tp1 tp2 (Expr t tp)
exprTransformerCachedEval :: forall t (tp :: BaseType) (tp1 :: BaseType) (tp2 :: BaseType).
Expr t tp
-> ExprTransformer t tp1 tp2 (Expr t tp)
-> ExprTransformer t tp1 tp2 (Expr t tp)
exprTransformerCachedEval Expr t tp
e ExprTransformer t tp1 tp2 (Expr t tp)
action = do
  EvalHashTables t
tbls <- (ExprTransformerTables t tp1 tp2 -> EvalHashTables t)
-> ExprTransformer t tp1 tp2 (EvalHashTables t)
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks ExprTransformerTables t tp1 tp2 -> EvalHashTables t
forall t (tp1 :: BaseType) (tp2 :: BaseType).
ExprTransformerTables t tp1 tp2 -> EvalHashTables t
evalTables
  HashTable RealWorld (Expr t) (Expr t)
-> Expr t tp
-> ExprTransformer t tp1 tp2 (Expr t tp)
-> ExprTransformer t tp1 tp2 (Expr t tp)
forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
       (tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t tp
e ExprTransformer t tp1 tp2 (Expr t tp)
action

transformCmpBV2LIA ::
  ExprBuilder t st fs ->
  Expr t BaseBoolType ->
  Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
transformCmpBV2LIA :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
transformCmpBV2LIA ExprBuilder t st fs
sym Expr t BaseBoolType
e
  | Just (BaseEq BaseTypeRepr tp1
_ Expr t tp1
x Expr t tp1
y) <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseBoolType
e
  , Just 'BaseBVType 64 :~: tp1
Refl <- BaseTypeRepr ('BaseBVType 64)
-> BaseTypeRepr tp1 -> Maybe ('BaseBVType 64 :~: tp1)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality (NatRepr 64 -> BaseTypeRepr ('BaseBVType 64)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr (NatRepr 64 -> BaseTypeRepr ('BaseBVType 64))
-> NatRepr 64 -> BaseTypeRepr ('BaseBVType 64)
forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). KnownNat n => NatRepr n
knownNat @64) (Expr t tp1 -> BaseTypeRepr tp1
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t tp1
x) = BV2LIAExprTransformer t (Expr t BaseBoolType)
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
forall a. a -> Maybe a
Just (BV2LIAExprTransformer t (Expr t BaseBoolType)
 -> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType)))
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
forall a b. (a -> b) -> a -> b
$ do
    Expr t BaseIntegerType
x' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t tp1
Expr t ('BaseBVType 64)
x
    Expr t BaseIntegerType
y' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t tp1
Expr t ('BaseBVType 64)
y
    IO (Expr t BaseBoolType)
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> BV2LIAExprTransformer t (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x' SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y'

  | Just (BVUlt Expr t (BaseBVType w)
x Expr t (BaseBVType w)
y) <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseBoolType
e
  , Just 'BaseBVType 64 :~: BaseBVType w
Refl <- BaseTypeRepr ('BaseBVType 64)
-> BaseTypeRepr (BaseBVType w)
-> Maybe ('BaseBVType 64 :~: BaseBVType w)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality (NatRepr 64 -> BaseTypeRepr ('BaseBVType 64)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr (NatRepr 64 -> BaseTypeRepr ('BaseBVType 64))
-> NatRepr 64 -> BaseTypeRepr ('BaseBVType 64)
forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). KnownNat n => NatRepr n
knownNat @64) (Expr t (BaseBVType w) -> BaseTypeRepr (BaseBVType w)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t (BaseBVType w)
x) = BV2LIAExprTransformer t (Expr t BaseBoolType)
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
forall a. a -> Maybe a
Just (BV2LIAExprTransformer t (Expr t BaseBoolType)
 -> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType)))
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
forall a b. (a -> b) -> a -> b
$ do
    Expr t BaseIntegerType
x' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t (BaseBVType w)
Expr t ('BaseBVType 64)
x
    Expr t BaseIntegerType
y' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t (BaseBVType w)
Expr t ('BaseBVType 64)
y
    IO (Expr t BaseBoolType)
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> BV2LIAExprTransformer t (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLt ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x' SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y'

  | Just (BVSlt Expr t (BaseBVType w)
x Expr t (BaseBVType w)
y) <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseBoolType
e
  , Just 'BaseBVType 64 :~: BaseBVType w
Refl <- BaseTypeRepr ('BaseBVType 64)
-> BaseTypeRepr (BaseBVType w)
-> Maybe ('BaseBVType 64 :~: BaseBVType w)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality (NatRepr 64 -> BaseTypeRepr ('BaseBVType 64)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr (NatRepr 64 -> BaseTypeRepr ('BaseBVType 64))
-> NatRepr 64 -> BaseTypeRepr ('BaseBVType 64)
forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). KnownNat n => NatRepr n
knownNat @64) (Expr t (BaseBVType w) -> BaseTypeRepr (BaseBVType w)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t (BaseBVType w)
x) = BV2LIAExprTransformer t (Expr t BaseBoolType)
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
forall a. a -> Maybe a
Just (BV2LIAExprTransformer t (Expr t BaseBoolType)
 -> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType)))
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
forall a b. (a -> b) -> a -> b
$ do
    Expr t BaseIntegerType
x' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t (BaseBVType w)
Expr t ('BaseBVType 64)
x
    Expr t BaseIntegerType
y' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t (BaseBVType w)
Expr t ('BaseBVType 64)
y
    IO (Expr t BaseBoolType)
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> BV2LIAExprTransformer t (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLt ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x' SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y'

  | Bool
otherwise = Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
forall a. Maybe a
Nothing

transformExprBV2LIA ::
  ExprBuilder t st fs ->
  Expr t (BaseBVType 64) ->
  BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType 64)
e
  | Just WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
semi_ring_sum <- SemiRingRepr ('SemiRingBV 'BVArith 64)
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
-> Maybe (WeightedSum (Expr t) ('SemiRingBV 'BVArith 64))
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum (BVFlavorRepr 'BVArith
-> NatRepr 64 -> SemiRingRepr ('SemiRingBV 'BVArith 64)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e)) Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
e =
    IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseIntegerType)
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType))
-> (WeightedSum (Expr t) 'SemiRingInteger
    -> IO (Expr t BaseIntegerType))
-> WeightedSum (Expr t) 'SemiRingInteger
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (WeightedSum (Expr t) 'SemiRingInteger
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType))
-> ExprTransformer
     t
     ('BaseBVType 64)
     BaseIntegerType
     (WeightedSum (Expr t) 'SemiRingInteger)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      SemiRingRepr 'SemiRingInteger
-> (Coefficient ('SemiRingBV 'BVArith 64)
    -> ExprTransformer
         t ('BaseBVType 64) BaseIntegerType (Coefficient 'SemiRingInteger))
-> (Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
    -> ExprTransformer
         t
         ('BaseBVType 64)
         BaseIntegerType
         (Expr t (SemiRingBase 'SemiRingInteger)))
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
-> ExprTransformer
     t
     ('BaseBVType 64)
     BaseIntegerType
     (WeightedSum (Expr t) 'SemiRingInteger)
forall (m :: Type -> Type) (g :: BaseType -> Type)
       (sr' :: SemiRing) (sr :: SemiRing) (f :: BaseType -> Type).
(Applicative m, Tm g) =>
SemiRingRepr sr'
-> (Coefficient sr -> m (Coefficient sr'))
-> (f (SemiRingBase sr) -> m (g (SemiRingBase sr')))
-> WeightedSum f sr
-> m (WeightedSum g sr')
WSum.transformSum
        SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr
        (Integer
-> ExprTransformer t ('BaseBVType 64) BaseIntegerType Integer
forall a. a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Integer
 -> ExprTransformer t ('BaseBVType 64) BaseIntegerType Integer)
-> (BV 64 -> Integer)
-> BV 64
-> ExprTransformer t ('BaseBVType 64) BaseIntegerType Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr 64 -> BV 64 -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> BV w -> Integer
BV.asSigned (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e))
        (ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym)
        WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
semi_ring_sum

  | Just SemiRingProduct (Expr t) ('SemiRingBV 'BVArith 64)
semi_ring_prod <- SemiRingRepr ('SemiRingBV 'BVArith 64)
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
-> Maybe (SemiRingProduct (Expr t) ('SemiRingBV 'BVArith 64))
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (SemiRingProduct (Expr t) sr)
asSemiRingProd (BVFlavorRepr 'BVArith
-> NatRepr 64 -> SemiRingRepr ('SemiRingBV 'BVArith 64)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e)) Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
e
  , Just Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
e' <- SemiRingProduct (Expr t) ('SemiRingBV 'BVArith 64)
-> Maybe (Expr t (SemiRingBase ('SemiRingBV 'BVArith 64)))
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Maybe (f (SemiRingBase sr))
WSum.asProdVar SemiRingProduct (Expr t) ('SemiRingBV 'BVArith 64)
semi_ring_prod =
    ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
e'

  | Just WeightedSum (Expr t) ('SemiRingBV 'BVBits 64)
semi_ring_sum <- SemiRingRepr ('SemiRingBV 'BVBits 64)
-> Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
-> Maybe (WeightedSum (Expr t) ('SemiRingBV 'BVBits 64))
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum (BVFlavorRepr 'BVBits
-> NatRepr 64 -> SemiRingRepr ('SemiRingBV 'BVBits 64)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e)) Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e
  , Just Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e' <- WeightedSum (Expr t) ('SemiRingBV 'BVBits 64)
-> Maybe (Expr t (SemiRingBase ('SemiRingBV 'BVBits 64)))
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (f (SemiRingBase sr))
WSum.asVar WeightedSum (Expr t) ('SemiRingBV 'BVBits 64)
semi_ring_sum =
    ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e'

  | Just SemiRingProduct (Expr t) ('SemiRingBV 'BVBits 64)
semi_ring_prod <- SemiRingRepr ('SemiRingBV 'BVBits 64)
-> Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
-> Maybe (SemiRingProduct (Expr t) ('SemiRingBV 'BVBits 64))
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (SemiRingProduct (Expr t) sr)
asSemiRingProd (BVFlavorRepr 'BVBits
-> NatRepr 64 -> SemiRingRepr ('SemiRingBV 'BVBits 64)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e)) Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e
  , Just Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e' <- SemiRingProduct (Expr t) ('SemiRingBV 'BVBits 64)
-> Maybe (Expr t (SemiRingBase ('SemiRingBV 'BVBits 64)))
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Maybe (f (SemiRingBase sr))
WSum.asProdVar SemiRingProduct (Expr t) ('SemiRingBV 'BVBits 64)
semi_ring_prod =
    ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e'

  | Just WeightedSum (Expr t) ('SemiRingBV 'BVBits 64)
semi_ring_sum <- SemiRingRepr ('SemiRingBV 'BVBits 64)
-> Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
-> Maybe (WeightedSum (Expr t) ('SemiRingBV 'BVBits 64))
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum (BVFlavorRepr 'BVBits
-> NatRepr 64 -> SemiRingRepr ('SemiRingBV 'BVBits 64)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e)) Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e
  , Just (Coefficient ('SemiRingBV 'BVBits 64)
c', Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e') <- WeightedSum (Expr t) ('SemiRingBV 'BVBits 64)
-> Maybe
     (Coefficient ('SemiRingBV 'BVBits 64),
      Expr t (SemiRingBase ('SemiRingBV 'BVBits 64)))
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr, f (SemiRingBase sr))
WSum.asWeightedVar WeightedSum (Expr t) ('SemiRingBV 'BVBits 64)
semi_ring_sum
  , Just WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
semi_ring_sum' <- SemiRingRepr ('SemiRingBV 'BVArith 64)
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
-> Maybe (WeightedSum (Expr t) ('SemiRingBV 'BVArith 64))
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum (BVFlavorRepr 'BVArith
-> NatRepr 64 -> SemiRingRepr ('SemiRingBV 'BVArith 64)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e')) Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
Expr t (SemiRingBase ('SemiRingBV 'BVBits 64))
e'
  , Just (Coefficient ('SemiRingBV 'BVArith 64)
c'', Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
e'') <- WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
-> Maybe
     (Coefficient ('SemiRingBV 'BVArith 64),
      Expr t (SemiRingBase ('SemiRingBV 'BVArith 64)))
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr, f (SemiRingBase sr))
WSum.asWeightedVar WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
semi_ring_sum'
  , Just (BaseIte BaseTypeRepr ('BaseBVType 64)
_ Integer
_ Expr t BaseBoolType
c Expr t ('BaseBVType 64)
a Expr t ('BaseBVType 64)
b) <- Expr t ('BaseBVType 64) -> Maybe (App (Expr t) ('BaseBVType 64))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t ('BaseBVType 64)
Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))
e''
  , Just BV 64
a_bv <- Expr t ('BaseBVType 64) -> Maybe (BV 64)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType 64)
a
  , Just BV 64
b_bv <- Expr t ('BaseBVType 64) -> Maybe (BV 64)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType 64)
b = do
    Expr t ('BaseBVType 64)
x <- IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t ('BaseBVType 64))
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64)))
-> IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> NatRepr 64 -> BV 64 -> IO (SymBV (ExprBuilder t st fs) 64)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e) (BV 64 -> IO (SymBV (ExprBuilder t st fs) 64))
-> BV 64 -> IO (SymBV (ExprBuilder t st fs) 64)
forall a b. (a -> b) -> a -> b
$ BV 64 -> BV 64 -> BV 64
forall (w :: Natural). BV w -> BV w -> BV w
BV.xor BV 64
Coefficient ('SemiRingBV 'BVBits 64)
c' (BV 64 -> BV 64) -> BV 64 -> BV 64
forall a b. (a -> b) -> a -> b
$ NatRepr 64 -> BV 64 -> BV 64 -> BV 64
forall (w :: Natural). NatRepr w -> BV w -> BV w -> BV w
BV.mul (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e) BV 64
Coefficient ('SemiRingBV 'BVArith 64)
c'' BV 64
a_bv
    Expr t ('BaseBVType 64)
y <- IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t ('BaseBVType 64))
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64)))
-> IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> NatRepr 64 -> BV 64 -> IO (SymBV (ExprBuilder t st fs) 64)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e) (BV 64 -> IO (SymBV (ExprBuilder t st fs) 64))
-> BV 64 -> IO (SymBV (ExprBuilder t st fs) 64)
forall a b. (a -> b) -> a -> b
$ BV 64 -> BV 64 -> BV 64
forall (w :: Natural). BV w -> BV w -> BV w
BV.xor BV 64
Coefficient ('SemiRingBV 'BVBits 64)
c' (BV 64 -> BV 64) -> BV 64 -> BV 64
forall a b. (a -> b) -> a -> b
$ NatRepr 64 -> BV 64 -> BV 64 -> BV 64
forall (w :: Natural). NatRepr w -> BV w -> BV w -> BV w
BV.mul (Expr t ('BaseBVType 64) -> NatRepr 64
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType 64)
e) BV 64
Coefficient ('SemiRingBV 'BVArith 64)
c'' BV 64
b_bv
    ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym (Expr t ('BaseBVType 64)
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) 64
-> SymBV (ExprBuilder t st fs) 64
-> IO (SymBV (ExprBuilder t st fs) 64)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
c SymBV (ExprBuilder t st fs) 64
Expr t ('BaseBVType 64)
x SymBV (ExprBuilder t st fs) 64
Expr t ('BaseBVType 64)
y)

  | BoundVarExpr ExprBoundVar t ('BaseBVType 64)
v <- Expr t ('BaseBVType 64)
e =
    ExprBoundVar t BaseIntegerType -> Expr t BaseIntegerType
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr (ExprBoundVar t BaseIntegerType -> Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (ExprBoundVar t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> ExprBoundVar t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (ExprBoundVar t BaseIntegerType)
forall (tp1 :: BaseType) (tp2 :: BaseType) t (st :: Type -> Type)
       fs.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
ExprBuilder t st fs
-> ExprBoundVar t tp1
-> ExprTransformer t tp1 tp2 (ExprBoundVar t tp2)
transformVarTp1ToTp2 ExprBuilder t st fs
sym ExprBoundVar t ('BaseBVType 64)
v

  | Just (BaseIte BaseTypeRepr ('BaseBVType 64)
_ Integer
_ Expr t BaseBoolType
c Expr t ('BaseBVType 64)
x Expr t ('BaseBVType 64)
y) <- Expr t ('BaseBVType 64) -> Maybe (App (Expr t) ('BaseBVType 64))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t ('BaseBVType 64)
e = do
    let ?transformCmpTp1ToTp2 = ?transformCmpTp1ToTp2::ExprBuilder t st fs
                       -> Expr t BaseBoolType
                       -> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
transformCmpBV2LIA
        ?transformExprTp1ToTp2 = ?transformExprTp1ToTp2::ExprBuilder t st fs
                        -> Expr t ('BaseBVType 64)
                        -> ExprTransformer
                             t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA
    Expr t BaseBoolType
c' <- ExprBuilder t st fs
-> Expr t BaseBoolType
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym Expr t BaseBoolType
c
    Expr t BaseIntegerType
x' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType 64)
x
    Expr t BaseIntegerType
y' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType 64)
y
    IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseIntegerType)
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym
-> Pred sym
-> SymInteger sym
-> SymInteger sym
-> IO (SymInteger sym)
intIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
c' SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x' SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y'

  | Just (BVShl NatRepr w
w Expr t ('BaseBVType w)
x Expr t ('BaseBVType w)
y) <- Expr t ('BaseBVType 64) -> Maybe (App (Expr t) ('BaseBVType 64))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t ('BaseBVType 64)
e
  , Just BV w
y_bv <- Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
y = do
    Expr t ('BaseBVType 64)
e' <- IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t ('BaseBVType 64))
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64)))
-> IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) 64
-> SymBV (ExprBuilder t st fs) 64
-> IO (SymBV (ExprBuilder t st fs) 64)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvMul ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) 64
Expr t ('BaseBVType w)
x (Expr t ('BaseBVType 64) -> IO (Expr t ('BaseBVType 64)))
-> IO (Expr t ('BaseBVType 64)) -> IO (Expr t ('BaseBVType 64))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w (Integer -> BV w) -> Integer -> BV w
forall a b. (a -> b) -> a -> b
$ Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
y_bv)
    ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType 64)
e'

  | Just (BVLshr NatRepr w
w Expr t ('BaseBVType w)
x Expr t ('BaseBVType w)
y) <- Expr t ('BaseBVType 64) -> Maybe (App (Expr t) ('BaseBVType 64))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t ('BaseBVType 64)
e
  , Just BV w
y_bv <- Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
y = do
    Expr t ('BaseBVType 64)
e' <- IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t ('BaseBVType 64))
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64)))
-> IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t ('BaseBVType 64))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) 64
-> SymBV (ExprBuilder t st fs) 64
-> IO (SymBV (ExprBuilder t st fs) 64)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUdiv ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) 64
Expr t ('BaseBVType w)
x (Expr t ('BaseBVType 64) -> IO (Expr t ('BaseBVType 64)))
-> IO (Expr t ('BaseBVType 64)) -> IO (Expr t ('BaseBVType 64))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w (Integer -> BV w) -> Integer -> BV w
forall a b. (a -> b) -> a -> b
$ Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
y_bv)
    ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType 64)
e'

  | Just (BVUdiv NatRepr w
_w Expr t ('BaseBVType w)
x Expr t ('BaseBVType w)
y) <- Expr t ('BaseBVType 64) -> Maybe (App (Expr t) ('BaseBVType 64))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t ('BaseBVType 64)
e
  , Just BV w
y_bv <- Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
y = do
    Expr t BaseIntegerType
x' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType w)
Expr t ('BaseBVType 64)
x
    Expr t BaseIntegerType
y' <- IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseIntegerType)
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer -> IO (SymInteger (ExprBuilder t st fs)))
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
y_bv
    IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseIntegerType)
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intDiv ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x' SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y'

  | Just (BVUrem NatRepr w
_w Expr t ('BaseBVType w)
x Expr t ('BaseBVType w)
y) <- Expr t ('BaseBVType 64) -> Maybe (App (Expr t) ('BaseBVType 64))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t ('BaseBVType 64)
e
  , Just BV w
y_bv <- Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
y = do
    Expr t BaseIntegerType
x' <- ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA ExprBuilder t st fs
sym Expr t ('BaseBVType w)
Expr t ('BaseBVType 64)
x
    Expr t BaseIntegerType
y' <- IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseIntegerType)
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer -> IO (SymInteger (ExprBuilder t st fs)))
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
y_bv
    IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseIntegerType)
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType)
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMod ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x' SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y'

  | Bool
otherwise = String
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a.
String -> ExprTransformer t ('BaseBVType 64) BaseIntegerType a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String
 -> ExprTransformer
      t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType))
-> String
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ String
"transformExprBV2LIA: unsupported " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr t ('BaseBVType 64) -> String
forall a. Show a => a -> String
show Expr t ('BaseBVType 64)
e

transformCmpLIA2BV ::
  ExprBuilder t st fs ->
  Expr t BaseBoolType ->
  Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
transformCmpLIA2BV :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
transformCmpLIA2BV ExprBuilder t st fs
sym Expr t BaseBoolType
e
  | Just (BaseEq BaseTypeRepr tp1
BaseIntegerRepr Expr t tp1
x Expr t tp1
y) <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseBoolType
e = LIA2BVExprTransformer t (Expr t BaseBoolType)
-> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
forall a. a -> Maybe a
Just (LIA2BVExprTransformer t (Expr t BaseBoolType)
 -> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType)))
-> LIA2BVExprTransformer t (Expr t BaseBoolType)
-> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
forall a b. (a -> b) -> a -> b
$ do
    let (WeightedSum (Expr t) 'SemiRingInteger
x_pos, WeightedSum (Expr t) 'SemiRingInteger
x_neg) = Expr t BaseIntegerType
-> (WeightedSum (Expr t) 'SemiRingInteger,
    WeightedSum (Expr t) 'SemiRingInteger)
forall t.
Expr t BaseIntegerType
-> (WeightedSum (Expr t) 'SemiRingInteger,
    WeightedSum (Expr t) 'SemiRingInteger)
asPositiveNegativeWeightedSum Expr t tp1
Expr t BaseIntegerType
x
    let (WeightedSum (Expr t) 'SemiRingInteger
y_pos, WeightedSum (Expr t) 'SemiRingInteger
y_neg) = Expr t BaseIntegerType
-> (WeightedSum (Expr t) 'SemiRingInteger,
    WeightedSum (Expr t) 'SemiRingInteger)
forall t.
Expr t BaseIntegerType
-> (WeightedSum (Expr t) 'SemiRingInteger,
    WeightedSum (Expr t) 'SemiRingInteger)
asPositiveNegativeWeightedSum Expr t tp1
Expr t BaseIntegerType
y
    Expr t BaseIntegerType
x' <- IO (Expr t BaseIntegerType)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseIntegerType)
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (WeightedSum (Expr t) 'SemiRingInteger
 -> IO (Expr t (SemiRingBase 'SemiRingInteger)))
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall a b. (a -> b) -> a -> b
$ SemiRingRepr 'SemiRingInteger
-> WeightedSum (Expr t) 'SemiRingInteger
-> WeightedSum (Expr t) 'SemiRingInteger
-> WeightedSum (Expr t) 'SemiRingInteger
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> WeightedSum f sr -> WeightedSum f sr
WSum.add SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr WeightedSum (Expr t) 'SemiRingInteger
x_pos WeightedSum (Expr t) 'SemiRingInteger
y_neg
    Expr t BaseIntegerType
y' <- IO (Expr t BaseIntegerType)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseIntegerType)
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (WeightedSum (Expr t) 'SemiRingInteger
 -> IO (Expr t (SemiRingBase 'SemiRingInteger)))
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall a b. (a -> b) -> a -> b
$ SemiRingRepr 'SemiRingInteger
-> WeightedSum (Expr t) 'SemiRingInteger
-> WeightedSum (Expr t) 'SemiRingInteger
-> WeightedSum (Expr t) 'SemiRingInteger
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> WeightedSum f sr -> WeightedSum f sr
WSum.add SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr WeightedSum (Expr t) 'SemiRingInteger
y_pos WeightedSum (Expr t) 'SemiRingInteger
x_neg
    Expr t ('BaseBVType 64)
x'' <- ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV ExprBuilder t st fs
sym Expr t BaseIntegerType
x'
    Expr t ('BaseBVType 64)
y'' <- ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV ExprBuilder t st fs
sym Expr t BaseIntegerType
y'
    IO (Expr t BaseBoolType)
-> LIA2BVExprTransformer t (Expr t BaseBoolType)
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> LIA2BVExprTransformer t (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> LIA2BVExprTransformer t (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) 64
-> SymBV (ExprBuilder t st fs) 64
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) 64
Expr t ('BaseBVType 64)
x'' SymBV (ExprBuilder t st fs) 64
Expr t ('BaseBVType 64)
y''

  | Just (SemiRingLe OrderedSemiRingRepr sr
SR.OrderedSemiRingIntegerRepr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y) <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseBoolType
e = LIA2BVExprTransformer t (Expr t BaseBoolType)
-> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
forall a. a -> Maybe a
Just (LIA2BVExprTransformer t (Expr t BaseBoolType)
 -> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType)))
-> LIA2BVExprTransformer t (Expr t BaseBoolType)
-> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
forall a b. (a -> b) -> a -> b
$ do
    Expr t BaseIntegerType
z <- IO (Expr t BaseIntegerType)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseIntegerType)
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intSub ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase sr)
x SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase sr)
y
    let (WeightedSum (Expr t) 'SemiRingInteger
z_pos, WeightedSum (Expr t) 'SemiRingInteger
z_neg) = Expr t BaseIntegerType
-> (WeightedSum (Expr t) 'SemiRingInteger,
    WeightedSum (Expr t) 'SemiRingInteger)
forall t.
Expr t BaseIntegerType
-> (WeightedSum (Expr t) 'SemiRingInteger,
    WeightedSum (Expr t) 'SemiRingInteger)
asPositiveNegativeWeightedSum Expr t BaseIntegerType
z
    Expr t (BaseBVType 72)
x' <- IO (Expr t (BaseBVType 72))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72))
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t (BaseBVType 72))
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72)))
-> (Expr t ('BaseBVType 64) -> IO (Expr t (BaseBVType 72)))
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs
-> NatRepr 72
-> Expr t ('BaseBVType 64)
-> IO (Expr t (BaseBVType 72))
forall (w :: Natural) (w' :: Natural) t (st :: Type -> Type) fs.
(1 <= w, 1 <= w', (w + 1) <= w') =>
ExprBuilder t st fs
-> NatRepr w'
-> Expr t (BaseBVType w)
-> IO (Expr t (BaseBVType w'))
bvSemiRingZext ExprBuilder t st fs
sym (NatRepr 72
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 72)
      (Expr t ('BaseBVType 64)
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72)))
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV ExprBuilder t st fs
sym
      (Expr t BaseIntegerType
 -> LIA2BVExprTransformer t (Expr t ('BaseBVType 64)))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Expr t BaseIntegerType)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingInteger
z_pos)
    Expr t (BaseBVType 72)
y' <- IO (Expr t (BaseBVType 72))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72))
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t (BaseBVType 72))
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72)))
-> (Expr t ('BaseBVType 64) -> IO (Expr t (BaseBVType 72)))
-> Expr t ('BaseBVType 64)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs
-> NatRepr 72
-> Expr t ('BaseBVType 64)
-> IO (Expr t (BaseBVType 72))
forall (w :: Natural) (w' :: Natural) t (st :: Type -> Type) fs.
(1 <= w, 1 <= w', (w + 1) <= w') =>
ExprBuilder t st fs
-> NatRepr w'
-> Expr t (BaseBVType w)
-> IO (Expr t (BaseBVType w'))
bvSemiRingZext ExprBuilder t st fs
sym (NatRepr 72
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 72)
      (Expr t ('BaseBVType 64)
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72)))
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t (BaseBVType 72))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV ExprBuilder t st fs
sym
      (Expr t BaseIntegerType
 -> LIA2BVExprTransformer t (Expr t ('BaseBVType 64)))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Expr t BaseIntegerType)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t BaseIntegerType)
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingInteger
z_neg)
    IO (Expr t BaseBoolType)
-> LIA2BVExprTransformer t (Expr t BaseBoolType)
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t BaseBoolType)
 -> LIA2BVExprTransformer t (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> LIA2BVExprTransformer t (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) 72
-> SymBV (ExprBuilder t st fs) 72
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) 72
Expr t (BaseBVType 72)
x' SymBV (ExprBuilder t st fs) 72
Expr t (BaseBVType 72)
y'

  | Bool
otherwise = Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
forall a. Maybe a
Nothing

asPositiveNegativeWeightedSum ::
  Expr t BaseIntegerType ->
  (WSum.WeightedSum (Expr t) SR.SemiRingInteger, WSum.WeightedSum (Expr t) SR.SemiRingInteger)
asPositiveNegativeWeightedSum :: forall t.
Expr t BaseIntegerType
-> (WeightedSum (Expr t) 'SemiRingInteger,
    WeightedSum (Expr t) 'SemiRingInteger)
asPositiveNegativeWeightedSum Expr t BaseIntegerType
e = do
  let semi_ring_sum :: WeightedSum (Expr t) 'SemiRingInteger
semi_ring_sum = SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> WeightedSum (Expr t) 'SemiRingInteger
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr Expr t BaseIntegerType
Expr t (SemiRingBase 'SemiRingInteger)
e
  let positive_semi_ring_sum :: WeightedSum (Expr t) 'SemiRingInteger
positive_semi_ring_sum = Identity (WeightedSum (Expr t) 'SemiRingInteger)
-> WeightedSum (Expr t) 'SemiRingInteger
forall a. Identity a -> a
runIdentity (Identity (WeightedSum (Expr t) 'SemiRingInteger)
 -> WeightedSum (Expr t) 'SemiRingInteger)
-> Identity (WeightedSum (Expr t) 'SemiRingInteger)
-> WeightedSum (Expr t) 'SemiRingInteger
forall a b. (a -> b) -> a -> b
$ (Coefficient 'SemiRingInteger
 -> Identity (Coefficient 'SemiRingInteger))
-> WeightedSum (Expr t) 'SemiRingInteger
-> Identity (WeightedSum (Expr t) 'SemiRingInteger)
forall (m :: Type -> Type) (f :: BaseType -> Type)
       (sr :: SemiRing).
(Applicative m, Tm f) =>
(Coefficient sr -> m (Coefficient sr))
-> WeightedSum f sr -> m (WeightedSum f sr)
WSum.traverseCoeffs
        (Integer -> Identity Integer
forall a. a -> Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Integer -> Identity Integer)
-> (Integer -> Integer) -> Integer -> Identity Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
0)
        WeightedSum (Expr t) 'SemiRingInteger
semi_ring_sum
  let negative_semi_ring_sum :: WeightedSum (Expr t) 'SemiRingInteger
negative_semi_ring_sum = Identity (WeightedSum (Expr t) 'SemiRingInteger)
-> WeightedSum (Expr t) 'SemiRingInteger
forall a. Identity a -> a
runIdentity (Identity (WeightedSum (Expr t) 'SemiRingInteger)
 -> WeightedSum (Expr t) 'SemiRingInteger)
-> Identity (WeightedSum (Expr t) 'SemiRingInteger)
-> WeightedSum (Expr t) 'SemiRingInteger
forall a b. (a -> b) -> a -> b
$ (Coefficient 'SemiRingInteger
 -> Identity (Coefficient 'SemiRingInteger))
-> WeightedSum (Expr t) 'SemiRingInteger
-> Identity (WeightedSum (Expr t) 'SemiRingInteger)
forall (m :: Type -> Type) (f :: BaseType -> Type)
       (sr :: SemiRing).
(Applicative m, Tm f) =>
(Coefficient sr -> m (Coefficient sr))
-> WeightedSum f sr -> m (WeightedSum f sr)
WSum.traverseCoeffs
        (Integer -> Identity Integer
forall a. a -> Identity a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Integer -> Identity Integer)
-> (Integer -> Integer) -> Integer -> Identity Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer) -> (Integer -> Integer) -> Integer -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
0)
        WeightedSum (Expr t) 'SemiRingInteger
semi_ring_sum
  (WeightedSum (Expr t) 'SemiRingInteger
positive_semi_ring_sum, WeightedSum (Expr t) 'SemiRingInteger
negative_semi_ring_sum)

transformExprLIA2BV ::
  ExprBuilder t st fs ->
  Expr t BaseIntegerType ->
  LIA2BVExprTransformer t (Expr t (BaseBVType 64))
transformExprLIA2BV :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV ExprBuilder t st fs
sym Expr t BaseIntegerType
e
  | Just WeightedSum (Expr t) 'SemiRingInteger
semi_ring_sum <- SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Maybe (WeightedSum (Expr t) 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr Expr t BaseIntegerType
Expr t (SemiRingBase 'SemiRingInteger)
e =
    IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t ('BaseBVType 64))
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64)))
-> (WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
    -> IO (Expr t ('BaseBVType 64)))
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVArith 64)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (WeightedSum (Expr t) ('SemiRingBV 'BVArith 64)
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64)))
-> ExprTransformer
     t
     BaseIntegerType
     ('BaseBVType 64)
     (WeightedSum (Expr t) ('SemiRingBV 'BVArith 64))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      SemiRingRepr ('SemiRingBV 'BVArith 64)
-> (Coefficient 'SemiRingInteger
    -> ExprTransformer
         t
         BaseIntegerType
         ('BaseBVType 64)
         (Coefficient ('SemiRingBV 'BVArith 64)))
-> (Expr t (SemiRingBase 'SemiRingInteger)
    -> ExprTransformer
         t
         BaseIntegerType
         ('BaseBVType 64)
         (Expr t (SemiRingBase ('SemiRingBV 'BVArith 64))))
-> WeightedSum (Expr t) 'SemiRingInteger
-> ExprTransformer
     t
     BaseIntegerType
     ('BaseBVType 64)
     (WeightedSum (Expr t) ('SemiRingBV 'BVArith 64))
forall (m :: Type -> Type) (g :: BaseType -> Type)
       (sr' :: SemiRing) (sr :: SemiRing) (f :: BaseType -> Type).
(Applicative m, Tm g) =>
SemiRingRepr sr'
-> (Coefficient sr -> m (Coefficient sr'))
-> (f (SemiRingBase sr) -> m (g (SemiRingBase sr')))
-> WeightedSum f sr
-> m (WeightedSum g sr')
WSum.transformSum
        (BVFlavorRepr 'BVArith
-> NatRepr 64 -> SemiRingRepr ('SemiRingBV 'BVArith 64)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr NatRepr 64
forall (n :: Natural). KnownNat n => NatRepr n
knownNat)
        (BV 64 -> ExprTransformer t BaseIntegerType ('BaseBVType 64) (BV 64)
forall a. a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BV 64
 -> ExprTransformer t BaseIntegerType ('BaseBVType 64) (BV 64))
-> (Integer -> BV 64)
-> Integer
-> ExprTransformer t BaseIntegerType ('BaseBVType 64) (BV 64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr 64 -> Integer -> BV 64
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr 64
forall (n :: Natural). KnownNat n => NatRepr n
knownNat)
        (ExprBuilder t st fs
-> Expr t BaseIntegerType
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV ExprBuilder t st fs
sym)
        WeightedSum (Expr t) 'SemiRingInteger
semi_ring_sum

  | BoundVarExpr ExprBoundVar t BaseIntegerType
v <- Expr t BaseIntegerType
e =
    ExprBoundVar t ('BaseBVType 64) -> Expr t ('BaseBVType 64)
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr (ExprBoundVar t ('BaseBVType 64) -> Expr t ('BaseBVType 64))
-> ExprTransformer
     t
     BaseIntegerType
     ('BaseBVType 64)
     (ExprBoundVar t ('BaseBVType 64))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> ExprBoundVar t BaseIntegerType
-> ExprTransformer
     t
     BaseIntegerType
     ('BaseBVType 64)
     (ExprBoundVar t ('BaseBVType 64))
forall (tp1 :: BaseType) (tp2 :: BaseType) t (st :: Type -> Type)
       fs.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
ExprBuilder t st fs
-> ExprBoundVar t tp1
-> ExprTransformer t tp1 tp2 (ExprBoundVar t tp2)
transformVarTp1ToTp2 ExprBuilder t st fs
sym ExprBoundVar t BaseIntegerType
v

  | Just (BaseIte BaseTypeRepr BaseIntegerType
_ Integer
_ Expr t BaseBoolType
c Expr t BaseIntegerType
x Expr t BaseIntegerType
y) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseIntegerType
e = do
    let ?transformCmpTp1ToTp2 = ?transformCmpTp1ToTp2::ExprBuilder t st fs
                       -> Expr t BaseBoolType
                       -> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
transformCmpLIA2BV
        ?transformExprTp1ToTp2 = ?transformExprTp1ToTp2::ExprBuilder t st fs
                        -> Expr t BaseIntegerType
                        -> ExprTransformer
                             t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV
    Expr t BaseBoolType
c' <- ExprBuilder t st fs
-> Expr t BaseBoolType
-> LIA2BVExprTransformer t (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym Expr t BaseBoolType
c
    Expr t ('BaseBVType 64)
x' <- ExprBuilder t st fs
-> Expr t BaseIntegerType
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV ExprBuilder t st fs
sym Expr t BaseIntegerType
x
    Expr t ('BaseBVType 64)
y' <- ExprBuilder t st fs
-> Expr t BaseIntegerType
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV ExprBuilder t st fs
sym Expr t BaseIntegerType
y
    IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall a.
IO a -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t ('BaseBVType 64))
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64)))
-> IO (Expr t ('BaseBVType 64))
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) 64
-> SymBV (ExprBuilder t st fs) 64
-> IO (SymBV (ExprBuilder t st fs) 64)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
c' SymBV (ExprBuilder t st fs) 64
Expr t ('BaseBVType 64)
x' SymBV (ExprBuilder t st fs) 64
Expr t ('BaseBVType 64)
y'

  | Bool
otherwise = String
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall a.
String -> ExprTransformer t BaseIntegerType ('BaseBVType 64) a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64)))
-> String
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (Expr t ('BaseBVType 64))
forall a b. (a -> b) -> a -> b
$ String
"transformExprLIA2BV: unsupported " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expr t BaseIntegerType -> String
forall a. Show a => a -> String
show Expr t BaseIntegerType
e

bvSemiRingZext :: (1 <= w, 1 <= w', w + 1 <= w')
  => ExprBuilder t st fs
  -> NatRepr w'
  -> Expr t (BaseBVType w)
  -> IO (Expr t (BaseBVType w'))
bvSemiRingZext :: forall (w :: Natural) (w' :: Natural) t (st :: Type -> Type) fs.
(1 <= w, 1 <= w', (w + 1) <= w') =>
ExprBuilder t st fs
-> NatRepr w'
-> Expr t (BaseBVType w)
-> IO (Expr t (BaseBVType w'))
bvSemiRingZext ExprBuilder t st fs
sym NatRepr w'
w' Expr t (BaseBVType w)
e
  | Just WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
semi_ring_sum <- SemiRingRepr ('SemiRingBV 'BVArith w)
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
-> Maybe (WeightedSum (Expr t) ('SemiRingBV 'BVArith w))
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum (BVFlavorRepr 'BVArith
-> NatRepr w -> SemiRingRepr ('SemiRingBV 'BVArith w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
e)) Expr t (BaseBVType w)
Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
e =
    IO (Expr t (BaseBVType w')) -> IO (Expr t (BaseBVType w'))
forall a. IO a -> IO a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (Expr t (BaseBVType w')) -> IO (Expr t (BaseBVType w')))
-> (WeightedSum (Expr t) ('SemiRingBV 'BVArith w')
    -> IO (Expr t (BaseBVType w')))
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith w')
-> IO (Expr t (BaseBVType w'))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith w')
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVArith w')))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (WeightedSum (Expr t) ('SemiRingBV 'BVArith w')
 -> IO (Expr t (BaseBVType w')))
-> IO (WeightedSum (Expr t) ('SemiRingBV 'BVArith w'))
-> IO (Expr t (BaseBVType w'))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      SemiRingRepr ('SemiRingBV 'BVArith w')
-> (Coefficient ('SemiRingBV 'BVArith w)
    -> IO (Coefficient ('SemiRingBV 'BVArith w')))
-> (Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
    -> IO (Expr t (SemiRingBase ('SemiRingBV 'BVArith w'))))
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
-> IO (WeightedSum (Expr t) ('SemiRingBV 'BVArith w'))
forall (m :: Type -> Type) (g :: BaseType -> Type)
       (sr' :: SemiRing) (sr :: SemiRing) (f :: BaseType -> Type).
(Applicative m, Tm g) =>
SemiRingRepr sr'
-> (Coefficient sr -> m (Coefficient sr'))
-> (f (SemiRingBase sr) -> m (g (SemiRingBase sr')))
-> WeightedSum f sr
-> m (WeightedSum g sr')
WSum.transformSum
        (BVFlavorRepr 'BVArith
-> NatRepr w' -> SemiRingRepr ('SemiRingBV 'BVArith w')
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr NatRepr w'
w')
        (BV w' -> IO (BV w')
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BV w' -> IO (BV w')) -> (BV w -> BV w') -> BV w -> IO (BV w')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr w' -> BV w -> BV w'
forall (w :: Natural) (w' :: Natural).
((w + 1) <= w') =>
NatRepr w' -> BV w -> BV w'
BV.zext NatRepr w'
w')
        (ExprBuilder t st fs
-> NatRepr w'
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w')
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w'
w')
        WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
semi_ring_sum
  | Bool
otherwise = ExprBuilder t st fs
-> NatRepr w'
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w')
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w'
w' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
e

transformVarTp1ToTp2WithCont ::
  forall t st fs tp tp1 tp2 a .
  (KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
  ExprBuilder t st fs ->
  ExprBoundVar t tp ->
  (forall tp' . ExprBoundVar t tp' -> a) ->
  ExprTransformer t tp1 tp2 a
transformVarTp1ToTp2WithCont :: forall t (st :: Type -> Type) fs (tp :: BaseType) (tp1 :: BaseType)
       (tp2 :: BaseType) a.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
ExprBuilder t st fs
-> ExprBoundVar t tp
-> (forall (tp' :: BaseType). ExprBoundVar t tp' -> a)
-> ExprTransformer t tp1 tp2 a
transformVarTp1ToTp2WithCont ExprBuilder t st fs
sym ExprBoundVar t tp
v forall (tp' :: BaseType). ExprBoundVar t tp' -> a
k = (ExprBoundVar t tp1
 -> ExprTransformer t tp1 tp2 (ExprBoundVar t tp2))
-> (ExprBoundVar t BaseBoolType
    -> ExprTransformer t tp1 tp2 (ExprBoundVar t BaseBoolType))
-> (forall (tp' :: BaseType). ExprBoundVar t tp' -> a)
-> BaseTypeRepr tp
-> ExprBoundVar t tp
-> ExprTransformer t tp1 tp2 a
forall t (tp :: BaseType) (tp1 :: BaseType) (tp2 :: BaseType)
       (e :: BaseType -> Type) a.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2,
 Show (e tp)) =>
(e tp1 -> ExprTransformer t tp1 tp2 (e tp2))
-> (e BaseBoolType -> ExprTransformer t tp1 tp2 (e BaseBoolType))
-> (forall (tp' :: BaseType). e tp' -> a)
-> BaseTypeRepr tp
-> e tp
-> ExprTransformer t tp1 tp2 a
applyTp1ToTp2FunWithCont (ExprBuilder t st fs
-> ExprBoundVar t tp1
-> ExprTransformer t tp1 tp2 (ExprBoundVar t tp2)
forall (tp1 :: BaseType) (tp2 :: BaseType) t (st :: Type -> Type)
       fs.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
ExprBuilder t st fs
-> ExprBoundVar t tp1
-> ExprTransformer t tp1 tp2 (ExprBoundVar t tp2)
transformVarTp1ToTp2 ExprBuilder t st fs
sym) ExprBoundVar t BaseBoolType
-> ExprTransformer t tp1 tp2 (ExprBoundVar t BaseBoolType)
forall a. a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprBoundVar t tp' -> a
forall (tp' :: BaseType). ExprBoundVar t tp' -> a
k (ExprBoundVar t tp -> BaseTypeRepr tp
forall t (tp :: BaseType). ExprBoundVar t tp -> BaseTypeRepr tp
bvarType ExprBoundVar t tp
v) ExprBoundVar t tp
v

transformVarTp1ToTp2 ::
  (KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
  ExprBuilder t st fs ->
  ExprBoundVar t tp1 ->
  ExprTransformer t tp1 tp2 (ExprBoundVar t tp2)
transformVarTp1ToTp2 :: forall (tp1 :: BaseType) (tp2 :: BaseType) t (st :: Type -> Type)
       fs.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2) =>
ExprBuilder t st fs
-> ExprBoundVar t tp1
-> ExprTransformer t tp1 tp2 (ExprBoundVar t tp2)
transformVarTp1ToTp2 ExprBuilder t st fs
sym ExprBoundVar t tp1
v = do
  HashTable RealWorld (ExprBoundVar t tp1) (ExprBoundVar t tp2)
tbl <- (ExprTransformerTables t tp1 tp2
 -> HashTable RealWorld (ExprBoundVar t tp1) (ExprBoundVar t tp2))
-> ExprTransformer
     t
     tp1
     tp2
     (HashTable RealWorld (ExprBoundVar t tp1) (ExprBoundVar t tp2))
forall r (m :: Type -> Type) a. MonadReader r m => (r -> a) -> m a
asks ExprTransformerTables t tp1 tp2
-> HashTable RealWorld (ExprBoundVar t tp1) (ExprBoundVar t tp2)
ExprTransformerTables t tp1 tp2
-> BasicHashTable (ExprBoundVar t tp1) (ExprBoundVar t tp2)
forall t (tp1 :: BaseType) (tp2 :: BaseType).
ExprTransformerTables t tp1 tp2
-> BasicHashTable (ExprBoundVar t tp1) (ExprBoundVar t tp2)
transformerSubst
  IO (ExprBoundVar t tp2)
-> ExprTransformer t tp1 tp2 (ExprBoundVar t tp2)
forall a. IO a -> ExprTransformer t tp1 tp2 a
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO (IO (ExprBoundVar t tp2)
 -> ExprTransformer t tp1 tp2 (ExprBoundVar t tp2))
-> IO (ExprBoundVar t tp2)
-> ExprTransformer t tp1 tp2 (ExprBoundVar t tp2)
forall a b. (a -> b) -> a -> b
$ BasicHashTable (ExprBoundVar t tp1) (ExprBoundVar t tp2)
-> ExprBoundVar t tp1
-> IO (ExprBoundVar t tp2)
-> IO (ExprBoundVar t tp2)
forall (h :: Type -> Type -> Type -> Type) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO v -> IO v
mutateInsertIO HashTable RealWorld (ExprBoundVar t tp1) (ExprBoundVar t tp2)
BasicHashTable (ExprBoundVar t tp1) (ExprBoundVar t tp2)
tbl ExprBoundVar t tp1
v (IO (ExprBoundVar t tp2) -> IO (ExprBoundVar t tp2))
-> IO (ExprBoundVar t tp2) -> IO (ExprBoundVar t tp2)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp2
-> VarKind
-> Maybe (AbstractValue tp2)
-> IO (ExprBoundVar t tp2)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym (ExprBoundVar t tp1 -> SolverSymbol
forall t (tp :: BaseType). ExprBoundVar t tp -> SolverSymbol
bvarName ExprBoundVar t tp1
v) BaseTypeRepr tp2
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr (ExprBoundVar t tp1 -> VarKind
forall t (tp :: BaseType). ExprBoundVar t tp -> VarKind
bvarKind ExprBoundVar t tp1
v) Maybe (AbstractValue tp2)
forall a. Maybe a
Nothing

applyTp1ToTp2FunWithCont ::
  forall t tp tp1 tp2 e a .
  (KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2, Show (e tp)) =>
  (e tp1 -> ExprTransformer t tp1 tp2 (e tp2)) ->
  (e BaseBoolType -> ExprTransformer t tp1 tp2 (e BaseBoolType)) ->
  (forall tp' . e tp' -> a) ->
  BaseTypeRepr tp ->
  e tp ->
  ExprTransformer t tp1 tp2 a
applyTp1ToTp2FunWithCont :: forall t (tp :: BaseType) (tp1 :: BaseType) (tp2 :: BaseType)
       (e :: BaseType -> Type) a.
(KnownRepr BaseTypeRepr tp1, KnownRepr BaseTypeRepr tp2,
 Show (e tp)) =>
(e tp1 -> ExprTransformer t tp1 tp2 (e tp2))
-> (e BaseBoolType -> ExprTransformer t tp1 tp2 (e BaseBoolType))
-> (forall (tp' :: BaseType). e tp' -> a)
-> BaseTypeRepr tp
-> e tp
-> ExprTransformer t tp1 tp2 a
applyTp1ToTp2FunWithCont e tp1 -> ExprTransformer t tp1 tp2 (e tp2)
f e BaseBoolType -> ExprTransformer t tp1 tp2 (e BaseBoolType)
g forall (tp' :: BaseType). e tp' -> a
k BaseTypeRepr tp
tp e tp
e
  | Just tp1 :~: tp
Refl <- BaseTypeRepr tp1 -> BaseTypeRepr tp -> Maybe (tp1 :~: tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality (BaseTypeRepr tp1
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr :: BaseTypeRepr tp1) BaseTypeRepr tp
tp =
    e tp2 -> a
forall (tp' :: BaseType). e tp' -> a
k (e tp2 -> a)
-> ExprTransformer t tp1 tp2 (e tp2) -> ExprTransformer t tp1 tp2 a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> e tp1 -> ExprTransformer t tp1 tp2 (e tp2)
f e tp
e tp1
e
  | Just BaseBoolType :~: tp
Refl <- BaseTypeRepr BaseBoolType
-> BaseTypeRepr tp -> Maybe (BaseBoolType :~: tp)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality BaseTypeRepr BaseBoolType
BaseBoolRepr BaseTypeRepr tp
tp =
    e BaseBoolType -> a
forall (tp' :: BaseType). e tp' -> a
k (e BaseBoolType -> a)
-> ExprTransformer t tp1 tp2 (e BaseBoolType)
-> ExprTransformer t tp1 tp2 a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> e BaseBoolType -> ExprTransformer t tp1 tp2 (e BaseBoolType)
g e tp
e BaseBoolType
e
  | Bool
otherwise = String -> ExprTransformer t tp1 tp2 a
forall a. String -> ExprTransformer t tp1 tp2 a
forall e (m :: Type -> Type) a. MonadError e m => e -> m a
throwError (String -> ExprTransformer t tp1 tp2 a)
-> String -> ExprTransformer t tp1 tp2 a
forall a b. (a -> b) -> a -> b
$ String
"applyTp1ToTp2FunWithCont: unsupported " String -> ShowS
forall a. [a] -> [a] -> [a]
++ e tp -> String
forall a. Show a => a -> String
show e tp
e

mutateInsertIO ::
  (HC.HashTable h, Eq k, Hashable k) =>
  H.IOHashTable h k v ->
  k ->
  IO v ->
  IO v
mutateInsertIO :: forall (h :: Type -> Type -> Type -> Type) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO v -> IO v
mutateInsertIO IOHashTable h k v
tbl k
k IO v
f = IOHashTable h k v -> k -> (Maybe v -> IO (Maybe v, v)) -> IO v
forall (h :: Type -> Type -> Type -> Type) k v a.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> (Maybe v -> IO (Maybe v, a)) -> IO a
H.mutateIO IOHashTable h k v
tbl k
k ((Maybe v -> IO (Maybe v, v)) -> IO v)
-> (Maybe v -> IO (Maybe v, v)) -> IO v
forall a b. (a -> b) -> a -> b
$ \case
  Just v
v -> (Maybe v, v) -> IO (Maybe v, v)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (v -> Maybe v
forall a. a -> Maybe a
Just v
v, v
v)
  Maybe v
Nothing -> do
    v
v <- IO v
f
    (Maybe v, v) -> IO (Maybe v, v)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (v -> Maybe v
forall a. a -> Maybe a
Just v
v, v
v)


-- | This attempts to lookup an entry in a symbolic array.
--
-- It patterns maps on the array constructor.
sbConcreteLookup :: forall t st fs d tp range
                 . ExprBuilder t st fs
                   -- ^ Simple builder for creating terms.
                 -> Expr t (BaseArrayType (d::>tp) range)
                    -- ^ Array to lookup value in.
                 -> Maybe (Ctx.Assignment IndexLit (d::>tp))
                    -- ^ A concrete index that corresponds to the index or nothing
                    -- if the index is symbolic.
                 -> Ctx.Assignment (Expr t) (d::>tp)
                    -- ^ The index to lookup.
                 -> IO (Expr t range)
sbConcreteLookup :: forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
    -- Try looking up a write to a concrete address.
  | Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
entry_map Expr t ('BaseArrayType (i ::> itp) tp1)
def) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
  , Just Assignment IndexLit (d ::> tp)
cidx <- Maybe (Assignment IndexLit (d ::> tp))
mcidx =
      case Assignment IndexLit (d ::> tp)
-> ArrayUpdateMap (Expr t) (d ::> tp) tp1 -> Maybe (Expr t tp1)
forall (ctx :: Ctx BaseType) (e :: BaseType -> Type)
       (tp :: BaseType).
Assignment IndexLit ctx -> ArrayUpdateMap e ctx tp -> Maybe (e tp)
AUM.lookup Assignment IndexLit (d ::> tp)
cidx ArrayUpdateMap (Expr t) (d ::> tp) tp1
ArrayUpdateMap (Expr t) (i ::> itp) tp1
entry_map of
        Just Expr t tp1
v -> Expr t range -> IO (Expr t range)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t range
Expr t tp1
v
        Maybe (Expr t tp1)
Nothing -> ExprBuilder t st fs
-> Expr t (BaseArrayType (i ::> itp) range)
-> Maybe (Assignment IndexLit (i ::> itp))
-> Assignment (Expr t) (i ::> itp)
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (i ::> itp) range)
Expr t ('BaseArrayType (i ::> itp) tp1)
def Maybe (Assignment IndexLit (d ::> tp))
Maybe (Assignment IndexLit (i ::> itp))
mcidx Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (i ::> itp)
idx
    -- Evaluate function arrays on ground values.
  | Just (ArrayFromFn ExprSymFn t (idx ::> itp) ret
f) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (NonceApp t (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      ExprBuilder t st fs
-> ExprSymFn t (idx ::> itp) range
-> Assignment (Expr t) (idx ::> itp)
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) range
ExprSymFn t (idx ::> itp) ret
f Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (idx ::> itp)
idx

    -- Lookups on constant arrays just return value
  | Just (ConstantArray Assignment BaseTypeRepr (i ::> tp1)
_ BaseTypeRepr b
_ Expr t b
v) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      Expr t range -> IO (Expr t range)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t range
Expr t b
v

    -- A lookup in an array update with symbolic update index is (i) the update
    -- value when the difference between the lookup index and the update index
    -- is zero, or (ii) a lookup in the update base array when the difference
    -- is a concrete non-zero number. Computing the difference instead of
    -- checking equality is more accurate because it enables the semi-rings and
    -- abstract domains simplifications (for example, `x` - `x + 1` simplifies
    -- to `1`)
  | Just (UpdateArray BaseTypeRepr b
range Assignment BaseTypeRepr (i ::> tp1)
idx_tps Expr t ('BaseArrayType (i ::> tp1) b)
arr Assignment (Expr t) (i ::> tp1)
update_idx Expr t b
v) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
  , Assignment BaseTypeRepr ctx
Ctx.Empty Ctx.:> BaseBVRepr{} <- Assignment BaseTypeRepr (i ::> tp1)
idx_tps
  , Assignment (Expr t) ctx
Ctx.Empty Ctx.:> Expr t tp
idx0 <- Assignment (Expr t) (d ::> tp)
idx
  , Assignment (Expr t) ctx
Ctx.Empty Ctx.:> Expr t tp
update_idx0 <- Assignment (Expr t) (i ::> tp1)
update_idx = do
    Expr t ('BaseBVType w)
diff <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t tp
idx0 SymBV (ExprBuilder t st fs) w
Expr t tp
update_idx0
    Expr t BaseBoolType
is_diff_zero <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
diff (Expr t ('BaseBVType w) -> IO (Expr t BaseBoolType))
-> IO (Expr t ('BaseBVType w)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> NatRepr w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero ExprBuilder t st fs
sym (Expr t ('BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType w)
diff)
    case Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Expr t BaseBoolType
is_diff_zero of
      Just Bool
True -> Expr t range -> IO (Expr t range)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t range
Expr t b
v
      Just Bool
False -> ExprBuilder t st fs
-> Expr t (BaseArrayType (i ::> tp1) range)
-> Maybe (Assignment IndexLit (i ::> tp1))
-> Assignment (Expr t) (i ::> tp1)
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (i ::> tp1) range)
Expr t ('BaseArrayType (i ::> tp1) b)
arr Maybe (Assignment IndexLit (d ::> tp))
Maybe (Assignment IndexLit (i ::> tp1))
mcidx Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (i ::> tp1)
idx
      Maybe Bool
_ -> do
        (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
sliced_idx) <- ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 Assignment (Expr t) (d ::> tp)
idx
        ExprBuilder t st fs -> App (Expr t) range -> IO (Expr t range)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (BaseTypeRepr range
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> App (Expr t) range
forall (tp :: BaseType) (e :: BaseType -> Type) (i :: Ctx BaseType)
       (tp1 :: BaseType).
BaseTypeRepr tp
-> e (BaseArrayType (i ::> tp1) tp)
-> Assignment e (i ::> tp1)
-> App e tp
SelectArray BaseTypeRepr range
BaseTypeRepr b
range Expr t (BaseArrayType (d ::> tp) range)
sliced_arr Assignment (Expr t) (d ::> tp)
sliced_idx)

    -- A lookup in an array copy is a lookup in the src array when inside the copy range
  | Just (CopyArray NatRepr w
w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_dest_arr Expr t (BaseBVType w)
dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr Expr t (BaseBVType w)
src_begin_idx Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
dest_end_idx Expr t (BaseBVType w)
_src_end_idx) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
  , Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
  , Integer
lookup_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
dest_begin_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
dest_begin_idx
  , Just Integer
dest_end_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
dest_end_idx
  , Integer
dest_begin_idx_unsigned Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned
  , Integer
lookup_idx_unsigned Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
dest_end_idx_unsigned = do
    Expr t (BaseBVType w)
new_lookup_idx <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
src_begin_idx (Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> IO (Expr t (BaseBVType w)) -> IO (Expr t (BaseBVType w))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      (ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w (Integer -> BV w) -> Integer -> BV w
forall a b. (a -> b) -> a -> b
$ Integer
lookup_idx_unsigned Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
dest_begin_idx_unsigned)
    ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range
-> Assignment
     (SymExpr (ExprBuilder t st fs)) (SingleCtx (BaseBVType w))
-> IO (SymExpr (ExprBuilder t st fs) range)
forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> IO (SymExpr sym b)
forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
-> IO (SymExpr (ExprBuilder t st fs) b)
arrayLookup ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr (Assignment
   (SymExpr (ExprBuilder t st fs)) (SingleCtx (BaseBVType w))
 -> IO (SymExpr (ExprBuilder t st fs) range))
-> Assignment
     (SymExpr (ExprBuilder t st fs)) (SingleCtx (BaseBVType w))
-> IO (SymExpr (ExprBuilder t st fs) range)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseBVType w)
-> Assignment (Expr t) (SingleCtx (BaseBVType w))
forall {k} (f :: k -> Type) (tp :: k).
f tp -> Assignment f (EmptyCtx ::> tp)
singleton Expr t (BaseBVType w)
new_lookup_idx
    -- A lookup in an array copy is a lookup in the dest array when outside the copy range
  | Just (CopyArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Expr t (BaseBVType w)
dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_src_arr Expr t (BaseBVType w)
_src_begin_idx Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
_dest_end_idx Expr t (BaseBVType w)
_src_end_idx) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
  , Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
  , Integer
lookup_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
dest_begin_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
dest_begin_idx
  , Integer
lookup_idx_unsigned Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
dest_begin_idx_unsigned =
    ExprBuilder t st fs
-> Expr t (BaseArrayType (SingleCtx (BaseBVType w)) range)
-> Maybe (Assignment IndexLit (SingleCtx (BaseBVType w)))
-> Assignment (Expr t) (SingleCtx (BaseBVType w))
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (SingleCtx (BaseBVType w)) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Maybe (Assignment IndexLit (d ::> tp))
Maybe (Assignment IndexLit (SingleCtx (BaseBVType w)))
mcidx Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (SingleCtx (BaseBVType w))
idx
    -- A lookup in an array copy is a lookup in the dest array when outside the copy range
  | Just (CopyArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Expr t (BaseBVType w)
_dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_src_arr Expr t (BaseBVType w)
_src_begin_idx Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
dest_end_idx Expr t (BaseBVType w)
_src_end_idx) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
  , Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
  , Integer
lookup_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
dest_end_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
dest_end_idx
  , Integer
dest_end_idx_unsigned Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned =
    ExprBuilder t st fs
-> Expr t (BaseArrayType (SingleCtx (BaseBVType w)) range)
-> Maybe (Assignment IndexLit (SingleCtx (BaseBVType w)))
-> Assignment (Expr t) (SingleCtx (BaseBVType w))
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (SingleCtx (BaseBVType w)) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Maybe (Assignment IndexLit (d ::> tp))
Maybe (Assignment IndexLit (SingleCtx (BaseBVType w)))
mcidx Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (SingleCtx (BaseBVType w))
idx

    -- A lookup in an array set returns the value when inside the set range
  | Just (SetArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_arr Expr t (BaseBVType w)
begin_idx Expr t a
val Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
end_idx) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
  , Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
  , Integer
lookup_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
begin_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
begin_idx
  , Just Integer
end_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
end_idx
  , Integer
begin_idx_unsigned Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned
  , Integer
lookup_idx_unsigned Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
end_idx_unsigned =
    Expr t range -> IO (Expr t range)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t range
Expr t a
val
    -- A lookup in an array set is a lookup in the inner array when outside the set range
  | Just (SetArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
begin_idx Expr t a
_val Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
_end_idx) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
  , Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
  , Integer
lookup_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
begin_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
begin_idx
  , Integer
lookup_idx_unsigned Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
begin_idx_unsigned =
    ExprBuilder t st fs
-> Expr t (BaseArrayType (SingleCtx (BaseBVType w)) range)
-> Maybe (Assignment IndexLit (SingleCtx (BaseBVType w)))
-> Assignment (Expr t) (SingleCtx (BaseBVType w))
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (SingleCtx (BaseBVType w)) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Maybe (Assignment IndexLit (d ::> tp))
Maybe (Assignment IndexLit (SingleCtx (BaseBVType w)))
mcidx Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (SingleCtx (BaseBVType w))
idx
    -- A lookup in an array set is a lookup in the inner array when outside the set range
  | Just (SetArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
_begin_idx Expr t a
_val Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
end_idx) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
  , Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
  , Integer
lookup_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
end_idx_unsigned <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
end_idx
  , Integer
end_idx_unsigned Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned =
    ExprBuilder t st fs
-> Expr t (BaseArrayType (SingleCtx (BaseBVType w)) range)
-> Maybe (Assignment IndexLit (SingleCtx (BaseBVType w)))
-> Assignment (Expr t) (SingleCtx (BaseBVType w))
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (SingleCtx (BaseBVType w)) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Maybe (Assignment IndexLit (d ::> tp))
Maybe (Assignment IndexLit (SingleCtx (BaseBVType w)))
mcidx Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (SingleCtx (BaseBVType w))
idx

  | Just (MapOverArrays ExprSymFn t (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (NonceApp t (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      let eval :: ArrayResultWrapper (Expr t) (d::>tp) utp
               -> IO (Expr t utp)
          eval :: forall (utp :: BaseType).
ArrayResultWrapper (Expr t) (d ::> tp) utp -> IO (Expr t utp)
eval ArrayResultWrapper (Expr t) (d ::> tp) utp
a = ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) utp)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t utp)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym (ArrayResultWrapper (Expr t) (d ::> tp) utp
-> Expr t (BaseArrayType (d ::> tp) utp)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) (d ::> tp) utp
a) Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
      ExprBuilder t st fs
-> ExprSymFn t (ctx ::> d) range
-> Assignment (Expr t) (ctx ::> d)
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym ExprSymFn t (ctx ::> d) range
ExprSymFn t (ctx ::> d) r
f (Assignment (Expr t) (ctx ::> d) -> IO (Expr t range))
-> IO (Assignment (Expr t) (ctx ::> d)) -> IO (Expr t range)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (idx ::> itp) x -> IO (Expr t x))
-> forall (x :: Ctx BaseType).
   Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) x
   -> IO (Assignment (Expr t) x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC ArrayResultWrapper (Expr t) (d ::> tp) x -> IO (Expr t x)
ArrayResultWrapper (Expr t) (idx ::> itp) x -> IO (Expr t x)
forall (utp :: BaseType).
ArrayResultWrapper (Expr t) (d ::> tp) utp -> IO (Expr t utp)
forall (x :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) x -> IO (Expr t x)
eval Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args
    -- Create select index.
  | Bool
otherwise = do
    case Expr t (BaseArrayType (d ::> tp) range)
-> BaseTypeRepr (BaseArrayType (d ::> tp) range)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t (BaseArrayType (d ::> tp) range)
arr0 of
      BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
range -> do
        (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
sliced_idx) <- ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 Assignment (Expr t) (d ::> tp)
idx
        ExprBuilder t st fs -> App (Expr t) range -> IO (Expr t range)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (BaseTypeRepr range
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> App (Expr t) range
forall (tp :: BaseType) (e :: BaseType -> Type) (i :: Ctx BaseType)
       (tp1 :: BaseType).
BaseTypeRepr tp
-> e (BaseArrayType (i ::> tp1) tp)
-> Assignment e (i ::> tp1)
-> App e tp
SelectArray BaseTypeRepr range
BaseTypeRepr xs
range Expr t (BaseArrayType (d ::> tp) range)
sliced_arr Assignment (Expr t) (d ::> tp)
sliced_idx)

-- | Simplify an array lookup expression by slicing the array w.r.t. the index.
--
-- Remove array update, copy and set operations at indices that are different
-- from the lookup index.
sliceArrayLookupUpdate ::
  ExprBuilder t st fs ->
  Expr t (BaseArrayType (d::>tp) range) ->
  Ctx.Assignment (Expr t) (d::>tp) ->
  IO (Expr t (BaseArrayType (d::>tp) range), Ctx.Assignment (Expr t) (d::>tp))
sliceArrayLookupUpdate :: forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 Assignment (Expr t) (d ::> tp)
lookup_idx
  | Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
entry_map Expr t ('BaseArrayType (i ::> itp) tp1)
arr) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 =
    case Assignment (Expr t) (d ::> tp)
-> Maybe (Assignment IndexLit (d ::> tp))
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
IsExpr e =>
Assignment e ctx -> Maybe (Assignment IndexLit ctx)
asConcreteIndices Assignment (Expr t) (d ::> tp)
lookup_idx of
      Just Assignment IndexLit (d ::> tp)
lookup_concrete_idx ->
        case Assignment IndexLit (d ::> tp)
-> ArrayUpdateMap (Expr t) (d ::> tp) tp1 -> Maybe (Expr t tp1)
forall (ctx :: Ctx BaseType) (e :: BaseType -> Type)
       (tp :: BaseType).
Assignment IndexLit ctx -> ArrayUpdateMap e ctx tp -> Maybe (e tp)
AUM.lookup Assignment IndexLit (d ::> tp)
lookup_concrete_idx ArrayUpdateMap (Expr t) (d ::> tp) tp1
ArrayUpdateMap (Expr t) (i ::> itp) tp1
entry_map of
          Just Expr t tp1
val -> do
            Expr t ('BaseArrayType (i ::> itp) tp1)
arr_base <- ExprBuilder t st fs
-> Expr t ('BaseArrayType (i ::> itp) tp1)
-> IO (Expr t ('BaseArrayType (i ::> itp) tp1))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t ('BaseArrayType (i ::> itp) tp1)
arr
            Expr t (BaseArrayType (d ::> tp) range)
sliced_arr <- ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (d ::> tp) range
-> Assignment (SymExpr (ExprBuilder t st fs)) (d ::> tp)
-> SymExpr (ExprBuilder t st fs) range
-> IO (SymArray (ExprBuilder t st fs) (d ::> tp) range)
forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> SymExpr sym b
-> IO (SymArray sym (idx ::> tp) b)
forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
-> SymExpr (ExprBuilder t st fs) b
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) b)
arrayUpdate ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (d ::> tp) range
Expr t ('BaseArrayType (i ::> itp) tp1)
arr_base Assignment (SymExpr (ExprBuilder t st fs)) (d ::> tp)
Assignment (Expr t) (d ::> tp)
lookup_idx SymExpr (ExprBuilder t st fs) range
Expr t tp1
val
            (Expr t (BaseArrayType (d ::> tp) range),
 Assignment (Expr t) (d ::> tp))
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
lookup_idx)
          Maybe (Expr t tp1)
Nothing -> ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (i ::> itp) tp1)
arr Assignment (Expr t) (d ::> tp)
lookup_idx
      Maybe (Assignment IndexLit (d ::> tp))
Nothing ->
        (Expr t (BaseArrayType (d ::> tp) range),
 Assignment (Expr t) (d ::> tp))
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
arr0, Assignment (Expr t) (d ::> tp)
lookup_idx)

  | Just (CopyArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Expr t (BaseBVType w)
dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr Expr t (BaseBVType w)
src_begin_idx Expr t (BaseBVType w)
len Expr t (BaseBVType w)
dest_end_idx Expr t (BaseBVType w)
_src_end_idx) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
    Expr t BaseBoolType
p0 <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
dest_begin_idx (Assignment (Expr t) (d ::> tp) -> Expr t tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx)
    Expr t BaseBoolType
p1 <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUlt ExprBuilder t st fs
sym (Assignment (Expr t) (d ::> tp) -> Expr t tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx) SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
dest_end_idx
    case (Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Expr t BaseBoolType
p0, Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Expr t BaseBoolType
p1) of
      (Just Bool
True, Just Bool
True) -> do
        Expr t tp
new_lookup_idx <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
src_begin_idx (Expr t (BaseBVType w) -> IO (Expr t tp))
-> IO (Expr t (BaseBVType w)) -> IO (Expr t tp)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym (Assignment (Expr t) (d ::> tp) -> Expr t tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx) SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
dest_begin_idx
        ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr (Assignment (Expr t) (d ::> tp)
 -> IO
      (Expr t (BaseArrayType (d ::> tp) range),
       Assignment (Expr t) (d ::> tp)))
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall a b. (a -> b) -> a -> b
$ Expr t tp -> Assignment (Expr t) (EmptyCtx ::> tp)
forall {k} (f :: k -> Type) (tp :: k).
f tp -> Assignment f (EmptyCtx ::> tp)
singleton Expr t tp
new_lookup_idx
      (Just Bool
False, Maybe Bool
_) ->
        ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Assignment (Expr t) (d ::> tp)
lookup_idx
      (Maybe Bool
_, Just Bool
False) ->
        ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Assignment (Expr t) (d ::> tp)
lookup_idx
      (Maybe Bool, Maybe Bool)
_ -> do
        (Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_dest_arr, Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_dest_idx) <- ExprBuilder t st fs
-> Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
-> Assignment (Expr t) (SingleCtx (BaseBVType w))
-> IO
     (Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a),
      Assignment (Expr t) (SingleCtx (BaseBVType w)))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (SingleCtx (BaseBVType w))
lookup_idx
        Expr t (BaseBVType w)
sliced_dest_begin_idx <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
dest_begin_idx (Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> IO (Expr t (BaseBVType w)) -> IO (Expr t (BaseBVType w))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym (Assignment (Expr t) (SingleCtx (BaseBVType w))
-> Expr t (BaseBVType w)
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_dest_idx) (Assignment (Expr t) (d ::> tp) -> Expr t tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx)
        Expr t (BaseArrayType (d ::> tp) range)
sliced_arr <- ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range
-> SymBV (ExprBuilder t st fs) w
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO
     (SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range)
forall (w :: Natural) (a :: BaseType).
(1 <= w) =>
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a)
forall sym (w :: Natural) (a :: BaseType).
(IsExprBuilder sym, 1 <= w) =>
sym
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymBV sym w
-> IO (SymArray sym (SingleCtx (BaseBVType w)) a)
arrayCopy ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_dest_arr SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
sliced_dest_begin_idx SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
src_begin_idx SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
len
        (Expr t (BaseArrayType (d ::> tp) range),
 Assignment (Expr t) (d ::> tp))
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_dest_idx)

    -- A lookup in an array set returns the value when inside the set range
  | Just (SetArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
begin_idx Expr t a
val Expr t (BaseBVType w)
len Expr t (BaseBVType w)
end_idx) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
    Expr t BaseBoolType
p0 <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
begin_idx (Assignment (Expr t) (d ::> tp) -> Expr t tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx)
    Expr t BaseBoolType
p1 <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUlt ExprBuilder t st fs
sym (Assignment (Expr t) (d ::> tp) -> Expr t tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx) SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
end_idx
    case (Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Expr t BaseBoolType
p0, Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Expr t BaseBoolType
p1) of
      (Just Bool
True, Just Bool
True) -> do
        Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr_base <- ExprBuilder t st fs
-> Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
-> IO (Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr
        Expr t (BaseArrayType (d ::> tp) range)
sliced_arr <- ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (d ::> tp) range
-> Assignment (SymExpr (ExprBuilder t st fs)) (d ::> tp)
-> SymExpr (ExprBuilder t st fs) range
-> IO (SymArray (ExprBuilder t st fs) (d ::> tp) range)
forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> SymExpr sym b
-> IO (SymArray sym (idx ::> tp) b)
forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
-> SymExpr (ExprBuilder t st fs) b
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) b)
arrayUpdate ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (d ::> tp) range
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr_base Assignment (SymExpr (ExprBuilder t st fs)) (d ::> tp)
Assignment (Expr t) (d ::> tp)
lookup_idx SymExpr (ExprBuilder t st fs) range
Expr t a
val
        (Expr t (BaseArrayType (d ::> tp) range),
 Assignment (Expr t) (d ::> tp))
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
lookup_idx)
      (Just Bool
False, Maybe Bool
_) ->
        ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Assignment (Expr t) (d ::> tp)
lookup_idx
      (Maybe Bool
_, Just Bool
False) ->
        ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Assignment (Expr t) (d ::> tp)
lookup_idx
      (Maybe Bool, Maybe Bool)
_ -> do
        (Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_arr, Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_idx) <- ExprBuilder t st fs
-> Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
-> Assignment (Expr t) (SingleCtx (BaseBVType w))
-> IO
     (Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a),
      Assignment (Expr t) (SingleCtx (BaseBVType w)))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (SingleCtx (BaseBVType w))
lookup_idx
        Expr t (BaseBVType w)
sliced_begin_idx <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
begin_idx (Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> IO (Expr t (BaseBVType w)) -> IO (Expr t (BaseBVType w))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym (Assignment (Expr t) (SingleCtx (BaseBVType w))
-> Expr t (BaseBVType w)
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_idx) (Assignment (Expr t) (d ::> tp) -> Expr t tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx)
        Expr t (BaseArrayType (d ::> tp) range)
sliced_arr' <- ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range
-> SymBV (ExprBuilder t st fs) w
-> SymExpr (ExprBuilder t st fs) range
-> SymBV (ExprBuilder t st fs) w
-> IO
     (SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range)
forall (w :: Natural) (a :: BaseType).
(1 <= w) =>
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymExpr (ExprBuilder t st fs) a
-> SymBV (ExprBuilder t st fs) w
-> IO (SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a)
forall sym (w :: Natural) (a :: BaseType).
(IsExprBuilder sym, 1 <= w) =>
sym
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymExpr sym a
-> SymBV sym w
-> IO (SymArray sym (SingleCtx (BaseBVType w)) a)
arraySet ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) range
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_arr SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
sliced_begin_idx SymExpr (ExprBuilder t st fs) range
Expr t a
val SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
len
        (Expr t (BaseArrayType (d ::> tp) range),
 Assignment (Expr t) (d ::> tp))
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr', Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_idx)

    -- Lookups on mux arrays just distribute over mux.
  | Just (BaseIte BaseTypeRepr (BaseArrayType (d ::> tp) range)
_ Integer
_ Expr t BaseBoolType
p Expr t (BaseArrayType (d ::> tp) range)
x Expr t (BaseArrayType (d ::> tp) range)
y) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      (Expr t (BaseArrayType (d ::> tp) range)
x', Assignment (Expr t) (d ::> tp)
i') <- ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
x Assignment (Expr t) (d ::> tp)
lookup_idx
      (Expr t (BaseArrayType (d ::> tp) range)
y', Assignment (Expr t) (d ::> tp)
j') <- ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
y Assignment (Expr t) (d ::> tp)
lookup_idx
      Expr t (BaseArrayType (d ::> tp) range)
sliced_arr <- ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymArray (ExprBuilder t st fs) (d ::> tp) range
-> SymArray (ExprBuilder t st fs) (d ::> tp) range
-> IO (SymArray (ExprBuilder t st fs) (d ::> tp) range)
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
forall (tp :: BaseType).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymExpr (ExprBuilder t st fs) tp
-> SymExpr (ExprBuilder t st fs) tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
baseTypeIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
p SymArray (ExprBuilder t st fs) (d ::> tp) range
Expr t (BaseArrayType (d ::> tp) range)
x' SymArray (ExprBuilder t st fs) (d ::> tp) range
Expr t (BaseArrayType (d ::> tp) range)
y'
      Assignment (Expr t) (d ::> tp)
sliced_idx <- (forall (x :: BaseType). Expr t x -> Expr t x -> IO (Expr t x))
-> Assignment (Expr t) (d ::> tp)
-> Assignment (Expr t) (d ::> tp)
-> IO (Assignment (Expr t) (d ::> tp))
forall {k} (m :: Type -> Type) (f :: k -> Type) (g :: k -> Type)
       (h :: k -> Type) (a :: Ctx k).
Applicative m =>
(forall (x :: k). f x -> g x -> m (h x))
-> Assignment f a -> Assignment g a -> m (Assignment h a)
Ctx.zipWithM (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymExpr (ExprBuilder t st fs) x
-> SymExpr (ExprBuilder t st fs) x
-> IO (SymExpr (ExprBuilder t st fs) x)
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
forall (tp :: BaseType).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymExpr (ExprBuilder t st fs) tp
-> SymExpr (ExprBuilder t st fs) tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
baseTypeIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
p) Assignment (Expr t) (d ::> tp)
i' Assignment (Expr t) (d ::> tp)
j'
      (Expr t (BaseArrayType (d ::> tp) range),
 Assignment (Expr t) (d ::> tp))
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
sliced_idx)

  | Bool
otherwise = (Expr t (BaseArrayType (d ::> tp) range),
 Assignment (Expr t) (d ::> tp))
-> IO
     (Expr t (BaseArrayType (d ::> tp) range),
      Assignment (Expr t) (d ::> tp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
arr0, Assignment (Expr t) (d ::> tp)
lookup_idx)

arrayUpdateBase ::
  ExprBuilder t st fs ->
  Expr t (BaseArrayType (d::>tp) range) ->
  IO (Expr t (BaseArrayType (d::>tp) range))
arrayUpdateBase :: forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 = case Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 of
  Just (UpdateArray BaseTypeRepr b
_ Assignment BaseTypeRepr (i ::> tp1)
_ Expr t ('BaseArrayType (i ::> tp1) b)
arr Assignment (Expr t) (i ::> tp1)
_ Expr t b
_) -> ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (i ::> tp1) b)
arr
  Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
_ Expr t ('BaseArrayType (i ::> itp) tp1)
arr) -> ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (i ::> itp) tp1)
arr
  Just (CopyArray NatRepr w
_ BaseTypeRepr a
_ Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
_ Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_ Expr t (BaseBVType w)
_ Expr t (BaseBVType w)
_ Expr t (BaseBVType w)
_ Expr t (BaseBVType w)
_) -> ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr
  Just (SetArray NatRepr w
_ BaseTypeRepr a
_ Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
_ Expr t a
_ Expr t (BaseBVType w)
_ Expr t (BaseBVType w)
_) -> ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr
  Just (BaseIte BaseTypeRepr (BaseArrayType (d ::> tp) range)
_ Integer
_ Expr t BaseBoolType
p Expr t (BaseArrayType (d ::> tp) range)
x Expr t (BaseArrayType (d ::> tp) range)
y) -> do
    Expr t (BaseArrayType (d ::> tp) range)
x' <- ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
x
    Expr t (BaseArrayType (d ::> tp) range)
y' <- ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
y
    ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymExpr (ExprBuilder t st fs) (BaseArrayType (d ::> tp) range)
-> SymExpr (ExprBuilder t st fs) (BaseArrayType (d ::> tp) range)
-> IO
     (SymExpr (ExprBuilder t st fs) (BaseArrayType (d ::> tp) range))
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
forall (tp :: BaseType).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymExpr (ExprBuilder t st fs) tp
-> SymExpr (ExprBuilder t st fs) tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
baseTypeIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
p SymExpr (ExprBuilder t st fs) (BaseArrayType (d ::> tp) range)
Expr t (BaseArrayType (d ::> tp) range)
x' SymExpr (ExprBuilder t st fs) (BaseArrayType (d ::> tp) range)
Expr t (BaseArrayType (d ::> tp) range)
y'
  Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
_ -> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseArrayType (d ::> tp) range)
arr0

----------------------------------------------------------------------
-- Expression builder instances

-- | Evaluate a weighted sum of integer values.
intSum :: ExprBuilder t st fs -> WeightedSum (Expr t) SR.SemiRingInteger -> IO (IntegerExpr t)
intSum :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger -> IO (IntegerExpr t)
intSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingInteger
s = ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingInteger
s

-- | Evaluate a weighted sum of real values.
realSum :: ExprBuilder t st fs -> WeightedSum (Expr t) SR.SemiRingReal -> IO (RealExpr t)
realSum :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingReal -> IO (RealExpr t)
realSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingReal
s = ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingReal
-> IO (Expr t (SemiRingBase 'SemiRingReal))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingReal
s

bvSum :: ExprBuilder t st fs -> WeightedSum (Expr t) (SR.SemiRingBV flv w) -> IO (BVExpr t w)
bvSum :: forall t (st :: Type -> Type) fs (flv :: BVFlavor) (w :: Natural).
ExprBuilder t st fs
-> WeightedSum (Expr t) (SemiRingBV flv w) -> IO (BVExpr t w)
bvSum ExprBuilder t st fs
sym WeightedSum (Expr t) (SemiRingBV flv w)
s = ExprBuilder t st fs
-> WeightedSum (Expr t) (SemiRingBV flv w)
-> IO (Expr t (SemiRingBase (SemiRingBV flv w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) (SemiRingBV flv w)
s

conjPred :: ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym BoolMap (Expr t)
bm =
  case BoolMap (Expr t) -> BoolMapView (Expr t)
forall (f :: BaseType -> Type). BoolMap f -> BoolMapView f
BM.viewBoolMap BoolMap (Expr t)
bm of
    BoolMapView (Expr t)
BoolMapUnit     -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
    BoolMapView (Expr t)
BoolMapDualUnit -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym
    BoolMapTerms ((BoolExpr t
x,Polarity
p):|[]) ->
      case Polarity
p of
        Polarity
Positive -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
x
        Polarity
Negative -> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
x
    BoolMapView (Expr t)
_ -> ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ BoolMap (Expr t) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type). BoolMap e -> App e BaseBoolType
ConjPred BoolMap (Expr t)
bm

bvUnary :: (1 <= w) => ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary :: forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sym UnaryBV (BoolExpr t) w
u
  -- BGS: We probably don't need to re-truncate the result, but
  -- until we refactor UnaryBV to use BV w instead of integer,
  -- that'll have to wait.
  | Just Integer
v <-  UnaryBV (BoolExpr t) w -> Maybe Integer
forall (p :: BaseType -> Type) (w :: Natural).
IsExpr p =>
UnaryBV (p BaseBoolType) w -> Maybe Integer
UnaryBV.asConstant UnaryBV (BoolExpr t) w
u = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
v)
  | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (UnaryBV (BoolExpr t) w -> App (Expr t) ('BaseBVType w)
forall (n :: Natural) (e :: BaseType -> Type).
(1 <= n) =>
UnaryBV (e BaseBoolType) n -> App e ('BaseBVType n)
BVUnaryTerm UnaryBV (BoolExpr t) w
u)
  where w :: NatRepr w
w = UnaryBV (BoolExpr t) w -> NatRepr w
forall p (n :: Natural). UnaryBV p n -> NatRepr n
UnaryBV.width UnaryBV (BoolExpr t) w
u

asUnaryBV :: (?unaryThreshold :: Int)
          => ExprBuilder t st fs
          -> BVExpr t n
          -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV :: forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym BVExpr t n
e
  | Just (BVUnaryTerm UnaryBV (Expr t BaseBoolType) n
u) <- BVExpr t n -> Maybe (App (Expr t) (BaseBVType n))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BVExpr t n
e = UnaryBV (Expr t BaseBoolType) n
-> Maybe (UnaryBV (Expr t BaseBoolType) n)
forall a. a -> Maybe a
Just UnaryBV (Expr t BaseBoolType) n
UnaryBV (Expr t BaseBoolType) n
u
  | ?unaryThreshold::Int
Int
?unaryThreshold Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe (UnaryBV (Expr t BaseBoolType) n)
forall a. Maybe a
Nothing
  | SemiRingLiteral (SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
w) Coefficient sr
v ProgramLoc
_ <- BVExpr t n
e = UnaryBV (Expr t BaseBoolType) n
-> Maybe (UnaryBV (Expr t BaseBoolType) n)
forall a. a -> Maybe a
Just (UnaryBV (Expr t BaseBoolType) n
 -> Maybe (UnaryBV (Expr t BaseBoolType) n))
-> UnaryBV (Expr t BaseBoolType) n
-> Maybe (UnaryBV (Expr t BaseBoolType) n)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> NatRepr n -> Integer -> UnaryBV (Pred (ExprBuilder t st fs)) n
forall sym (n :: Natural).
IsExprBuilder sym =>
sym -> NatRepr n -> Integer -> UnaryBV (Pred sym) n
UnaryBV.constant ExprBuilder t st fs
sym NatRepr n
NatRepr w
w (BV n -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV n
Coefficient sr
v)
  | Bool
otherwise = Maybe (UnaryBV (Expr t BaseBoolType) n)
forall a. Maybe a
Nothing

-- | This create a unary bitvector representing if the size is not too large.
sbTryUnaryTerm :: (1 <= w, ?unaryThreshold :: Int)
               => ExprBuilder t st fs
               -> Maybe (IO (UnaryBV (BoolExpr t) w))
               -> IO (BVExpr t w)
               -> IO (BVExpr t w)
sbTryUnaryTerm :: forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w, ?unaryThreshold::Int) =>
ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (BVExpr t w)
-> IO (BVExpr t w)
sbTryUnaryTerm ExprBuilder t st fs
_sym Maybe (IO (UnaryBV (BoolExpr t) w))
Nothing IO (BVExpr t w)
fallback = IO (BVExpr t w)
fallback
sbTryUnaryTerm ExprBuilder t st fs
sym (Just IO (UnaryBV (BoolExpr t) w)
mku) IO (BVExpr t w)
fallback =
  do UnaryBV (BoolExpr t) w
u <- IO (UnaryBV (BoolExpr t) w)
mku
     if UnaryBV (BoolExpr t) w -> Int
forall p (n :: Natural). UnaryBV p n -> Int
UnaryBV.size UnaryBV (BoolExpr t) w
u Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ?unaryThreshold::Int
Int
?unaryThreshold then
       ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sym UnaryBV (BoolExpr t) w
u
     else
       IO (BVExpr t w)
fallback

semiRingProd ::
  ExprBuilder t st fs ->
  SemiRingProduct (Expr t) sr ->
  IO (Expr t (SR.SemiRingBase sr))
semiRingProd :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym SemiRingProduct (Expr t) sr
pd
  | SemiRingProduct (Expr t) sr -> Bool
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Bool
WSum.nullProd SemiRingProduct (Expr t) sr
pd = ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym (SemiRingProduct (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd) (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.one (SemiRingProduct (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd))
  | Just Expr t (SemiRingBase sr)
v <- SemiRingProduct (Expr t) sr -> Maybe (Expr t (SemiRingBase sr))
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Maybe (f (SemiRingBase sr))
WSum.asProdVar SemiRingProduct (Expr t) sr
pd = Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
v
  | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr)))
-> App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a b. (a -> b) -> a -> b
$ SemiRingProduct (Expr t) sr -> App (Expr t) (SemiRingBase sr)
forall (e :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct e sr -> App e (SemiRingBase sr)
SemiRingProd SemiRingProduct (Expr t) sr
pd

semiRingSum ::
  ExprBuilder t st fs ->
  WeightedSum (Expr t) sr ->
  IO (Expr t (SR.SemiRingBase sr))
semiRingSum :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
s
    | Just Coefficient sr
c <- WeightedSum (Expr t) sr -> Maybe (Coefficient sr)
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) sr
s = ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym (WeightedSum (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s) Coefficient sr
c
    | Just Expr t (SemiRingBase sr)
r <- WeightedSum (Expr t) sr -> Maybe (Expr t (SemiRingBase sr))
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (f (SemiRingBase sr))
WSum.asVar WeightedSum (Expr t) sr
s      = Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
r
    | Bool
otherwise                   = ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym WeightedSum (Expr t) sr
s

sum' ::
  ExprBuilder t st fs ->
  WeightedSum (Expr t) sr ->
  IO (Expr t (SR.SemiRingBase sr))
sum' :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym WeightedSum (Expr t) sr
s = ExprBuilder t st fs
-> App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr)))
-> App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a b. (a -> b) -> a -> b
$ WeightedSum (Expr t) sr -> App (Expr t) (SemiRingBase sr)
forall (e :: BaseType -> Type) (sr :: SemiRing).
WeightedSum e sr -> App e (SemiRingBase sr)
SemiRingSum WeightedSum (Expr t) sr
s
{-# INLINE sum' #-}

scalarMul ::
   ExprBuilder t st fs ->
   SR.SemiRingRepr sr ->
   SR.Coefficient sr ->
   Expr t (SR.SemiRingBase sr) ->
   IO (Expr t (SR.SemiRingBase sr))
scalarMul :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c Expr t (SemiRingBase sr)
x
  | SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr) Coefficient sr
c = ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
  | SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.one SemiRingRepr sr
sr)  Coefficient sr
c = Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x
  | Just Coefficient sr
r <- SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x =
    ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (SemiRingRepr sr
-> Coefficient sr -> Coefficient sr -> Coefficient sr
forall (sr :: SemiRing).
SemiRingRepr sr
-> Coefficient sr -> Coefficient sr -> Coefficient sr
SR.mul SemiRingRepr sr
sr Coefficient sr
c Coefficient sr
r)
  | Just WeightedSum (Expr t) sr
s <- SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x =
    ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (SemiRingRepr sr
-> Coefficient sr
-> WeightedSum (Expr t) sr
-> WeightedSum (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> Coefficient sr -> WeightedSum f sr -> WeightedSum f sr
WSum.scale SemiRingRepr sr
sr Coefficient sr
c WeightedSum (Expr t) sr
s)
  | Bool
otherwise =
    ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> WeightedSum (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> Coefficient sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.scaledVar SemiRingRepr sr
sr Coefficient sr
c Expr t (SemiRingBase sr)
x)

semiRingIte ::
  ExprBuilder t st fs ->
  SR.SemiRingRepr sr ->
  Expr t BaseBoolType ->
  Expr t (SR.SemiRingBase sr) ->
  Expr t (SR.SemiRingBase sr) ->
  IO (Expr t (SR.SemiRingBase sr))
semiRingIte :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t BaseBoolType
c Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y
    -- evaluate as constants
  | Just Bool
True  <- Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Expr t BaseBoolType
c = Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x
  | Just Bool
False <- Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Expr t BaseBoolType
c = Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
y

    -- reduce negations
  | Just (NotPred Expr t BaseBoolType
c') <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseBoolType
c
  = ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t BaseBoolType
c' Expr t (SemiRingBase sr)
y Expr t (SemiRingBase sr)
x

    -- remove the ite if the then and else cases are the same
  | Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr) -> Expr t (SemiRingBase sr) -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x

    -- Try to extract common sum information.
  | (WeightedSum (Expr t) sr
z, WeightedSum (Expr t) sr
x',WeightedSum (Expr t) sr
y') <- WeightedSum (Expr t) sr
-> WeightedSum (Expr t) sr
-> (WeightedSum (Expr t) sr, WeightedSum (Expr t) sr,
    WeightedSum (Expr t) sr)
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
WeightedSum f sr
-> WeightedSum f sr
-> (WeightedSum f sr, WeightedSum f sr, WeightedSum f sr)
WSum.extractCommon (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y)
  , Bool -> Bool
not (SemiRingRepr sr -> WeightedSum (Expr t) sr -> Bool
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr sr
sr WeightedSum (Expr t) sr
z) = do
    Expr t (SemiRingBase sr)
xr <- ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
x'
    Expr t (SemiRingBase sr)
yr <- ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
y'
    let sz :: Integer
sz = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expr t (SemiRingBase sr) -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
xr Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expr t (SemiRingBase sr) -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
yr
    Expr t (SemiRingBase sr)
r <- ExprBuilder t st fs
-> App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (BaseTypeRepr (SemiRingBase sr)
-> Integer
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> App (Expr t) (SemiRingBase sr)
forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) Integer
sz Expr t BaseBoolType
c Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr)
    ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr)))
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall a b. (a -> b) -> a -> b
$! SemiRingRepr sr
-> WeightedSum (Expr t) sr
-> Expr t (SemiRingBase sr)
-> WeightedSum (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.addVar SemiRingRepr sr
sr WeightedSum (Expr t) sr
z Expr t (SemiRingBase sr)
r

    -- final fallback, create the ite term
  | Bool
otherwise =
      let sz :: Integer
sz = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expr t (SemiRingBase sr) -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expr t (SemiRingBase sr) -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
y in
      ExprBuilder t st fs
-> App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (BaseTypeRepr (SemiRingBase sr)
-> Integer
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> App (Expr t) (SemiRingBase sr)
forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) Integer
sz Expr t BaseBoolType
c Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y)


mkIte ::
  ExprBuilder t st fs ->
  Expr t BaseBoolType ->
  Expr t bt ->
  Expr t bt ->
  IO (Expr t bt)
mkIte :: forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Expr t BaseBoolType
c Expr t bt
x Expr t bt
y
    -- evaluate as constants
  | Just Bool
True  <- Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Expr t BaseBoolType
c = Expr t bt -> IO (Expr t bt)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t bt
x
  | Just Bool
False <- Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Expr t BaseBoolType
c = Expr t bt -> IO (Expr t bt)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t bt
y

    -- reduce negations
  | Just (NotPred Expr t BaseBoolType
c') <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseBoolType
c
  = ExprBuilder t st fs
-> Expr t BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Expr t BaseBoolType
c' Expr t bt
y Expr t bt
x

    -- remove the ite if the then and else cases are the same
  | Expr t bt
x Expr t bt -> Expr t bt -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t bt
y = Expr t bt -> IO (Expr t bt)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t bt
x

  | Bool
otherwise =
      let sz :: Integer
sz = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expr t bt -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t bt
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expr t bt -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t bt
y in
      ExprBuilder t st fs -> App (Expr t) bt -> IO (Expr t bt)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (BaseTypeRepr bt
-> Integer
-> Expr t BaseBoolType
-> Expr t bt
-> Expr t bt
-> App (Expr t) bt
forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (Expr t bt -> BaseTypeRepr bt
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t bt
x) Integer
sz Expr t BaseBoolType
c Expr t bt
x Expr t bt
y)

semiRingLe ::
  ExprBuilder t st fs ->
  SR.OrderedSemiRingRepr sr ->
  (Expr t (SR.SemiRingBase sr) -> Expr t (SR.SemiRingBase sr) -> IO (Expr t BaseBoolType))
      {- ^ recursive call for simplifications -} ->
  Expr t (SR.SemiRingBase sr) ->
  Expr t (SR.SemiRingBase sr) ->
  IO (Expr t BaseBoolType)
semiRingLe :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> (Expr t (SemiRingBase sr)
    -> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t BaseBoolType)
semiRingLe ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y
      -- Check for syntactic equality.
    | Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr) -> Expr t (SemiRingBase sr) -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)

      -- Strength reductions on a non-linear constraint to piecewise linear.
    | Just Coefficient sr
c <- SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x
    , SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
    , Just (SemiRingProd SemiRingProduct (Expr t) sr
pd) <- Expr t (SemiRingBase sr) -> Maybe (App (Expr t) (SemiRingBase sr))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
y
    , Just sr :~: sr
Refl <- SemiRingRepr sr -> SemiRingRepr sr -> Maybe (sr :~: sr)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: SemiRing) (b :: SemiRing).
SemiRingRepr a -> SemiRingRepr b -> Maybe (a :~: b)
testEquality SemiRingRepr sr
sr (SemiRingProduct (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd)
    = ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType)
prodNonneg ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr SemiRingProduct (Expr t) sr
SemiRingProduct (Expr t) sr
pd

      -- Another strength reduction
    | Just Coefficient sr
c <- SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y
    , SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
    , Just (SemiRingProd SemiRingProduct (Expr t) sr
pd) <- Expr t (SemiRingBase sr) -> Maybe (App (Expr t) (SemiRingBase sr))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
x
    , Just sr :~: sr
Refl <- SemiRingRepr sr -> SemiRingRepr sr -> Maybe (sr :~: sr)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: SemiRing) (b :: SemiRing).
SemiRingRepr a -> SemiRingRepr b -> Maybe (a :~: b)
testEquality SemiRingRepr sr
sr (SemiRingProduct (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd)
    = ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType)
prodNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr SemiRingProduct (Expr t) sr
SemiRingProduct (Expr t) sr
pd

      -- Push some comparisons under if/then/else
    | SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- Expr t (SemiRingBase sr)
x
    , Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t BaseBoolType
c Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- Expr t (SemiRingBase sr) -> Maybe (App (Expr t) (SemiRingBase sr))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
Expr t (SemiRingBase sr)
y
    = IO (IO (Expr t BaseBoolType)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
c (Expr t BaseBoolType
 -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
Expr t (SemiRingBase sr)
a IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (IO (Expr t BaseBoolType))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
Expr t (SemiRingBase sr)
b)

      -- Push some comparisons under if/then/else
    | Just (BaseIte BaseTypeRepr (SemiRingBase sr)
tp Integer
_ Expr t BaseBoolType
c Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- Expr t (SemiRingBase sr) -> Maybe (App (Expr t) (SemiRingBase sr))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
x
    , SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- Expr t (SemiRingBase sr)
y
    , Just SemiRingBase sr :~: SemiRingBase sr
Refl <- BaseTypeRepr (SemiRingBase sr)
-> BaseTypeRepr (SemiRingBase sr)
-> Maybe (SemiRingBase sr :~: SemiRingBase sr)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality BaseTypeRepr (SemiRingBase sr)
tp (SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr)
    = IO (IO (Expr t BaseBoolType)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
c (Expr t BaseBoolType
 -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
y IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (IO (Expr t BaseBoolType))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
b Expr t (SemiRingBase sr)
y)

      -- Try to extract common sum information.
    | (WeightedSum (Expr t) sr
z, WeightedSum (Expr t) sr
x',WeightedSum (Expr t) sr
y') <- WeightedSum (Expr t) sr
-> WeightedSum (Expr t) sr
-> (WeightedSum (Expr t) sr, WeightedSum (Expr t) sr,
    WeightedSum (Expr t) sr)
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
WeightedSum f sr
-> WeightedSum f sr
-> (WeightedSum f sr, WeightedSum f sr, WeightedSum f sr)
WSum.extractCommon (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y)
    , Bool -> Bool
not (SemiRingRepr sr -> WeightedSum (Expr t) sr -> Bool
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr sr
sr WeightedSum (Expr t) sr
z) = do
      Expr t (SemiRingBase sr)
xr <- ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
x'
      Expr t (SemiRingBase sr)
yr <- ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
y'
      Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr

      -- Default case
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType))
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> App (Expr t) BaseBoolType
forall (sr :: SemiRing) (e :: BaseType -> Type).
OrderedSemiRingRepr sr
-> e (SemiRingBase sr) -> e (SemiRingBase sr) -> App e BaseBoolType
SemiRingLe OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y

 where sr :: SemiRingRepr sr
sr = OrderedSemiRingRepr sr -> SemiRingRepr sr
forall (sr :: SemiRing). OrderedSemiRingRepr sr -> SemiRingRepr sr
SR.orderedSemiRing OrderedSemiRingRepr sr
osr


semiRingEq ::
  ExprBuilder t st fs ->
  SR.SemiRingRepr sr ->
  (Expr t (SR.SemiRingBase sr) -> Expr t (SR.SemiRingBase sr) -> IO (Expr t BaseBoolType))
    {- ^ recursive call for simplifications -} ->
  Expr t (SR.SemiRingBase sr) ->
  Expr t (SR.SemiRingBase sr) ->
  IO (Expr t BaseBoolType)
semiRingEq :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> (Expr t (SemiRingBase sr)
    -> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t BaseBoolType)
semiRingEq ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y
  -- Check for syntactic equality.
  | Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr) -> Expr t (SemiRingBase sr) -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)

    -- Push some equalities under if/then/else
  | SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- Expr t (SemiRingBase sr)
x
  , Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t BaseBoolType
c Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- Expr t (SemiRingBase sr) -> Maybe (App (Expr t) (SemiRingBase sr))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
Expr t (SemiRingBase sr)
y
  = IO (IO (Expr t BaseBoolType)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
c (Expr t BaseBoolType
 -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
Expr t (SemiRingBase sr)
a IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (IO (Expr t BaseBoolType))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
Expr t (SemiRingBase sr)
b)

    -- Push some equalities under if/then/else
  | Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t BaseBoolType
c Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- Expr t (SemiRingBase sr) -> Maybe (App (Expr t) (SemiRingBase sr))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
x
  , SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- Expr t (SemiRingBase sr)
y
  = IO (IO (Expr t BaseBoolType)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
c (Expr t BaseBoolType
 -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
y IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (IO (Expr t BaseBoolType))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
b Expr t (SemiRingBase sr)
y)

  | (WeightedSum (Expr t) sr
z, WeightedSum (Expr t) sr
x',WeightedSum (Expr t) sr
y') <- WeightedSum (Expr t) sr
-> WeightedSum (Expr t) sr
-> (WeightedSum (Expr t) sr, WeightedSum (Expr t) sr,
    WeightedSum (Expr t) sr)
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
WeightedSum f sr
-> WeightedSum f sr
-> (WeightedSum f sr, WeightedSum f sr, WeightedSum f sr)
WSum.extractCommon (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y)
  , Bool -> Bool
not (SemiRingRepr sr -> WeightedSum (Expr t) sr -> Bool
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr sr
sr WeightedSum (Expr t) sr
z) =
    case (WeightedSum (Expr t) sr -> Maybe (Coefficient sr)
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) sr
x', WeightedSum (Expr t) sr -> Maybe (Coefficient sr)
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) sr
y') of
      (Just Coefficient sr
a, Just Coefficient sr
b) -> Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
a Coefficient sr
b)
      (Maybe (Coefficient sr), Maybe (Coefficient sr))
_ -> do Expr t (SemiRingBase sr)
xr <- ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
x'
              Expr t (SemiRingBase sr)
yr <- ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
y'
              ExprBuilder t st fs
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType))
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> App (Expr t) BaseBoolType
forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e BaseBoolType
BaseEq (SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> Expr t (SemiRingBase sr)
forall a. Ord a => a -> a -> a
min Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr) (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> Expr t (SemiRingBase sr)
forall a. Ord a => a -> a -> a
max Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr)

  | Bool
otherwise =
    ExprBuilder t st fs
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType))
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> App (Expr t) BaseBoolType
forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e BaseBoolType
BaseEq (SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> Expr t (SemiRingBase sr)
forall a. Ord a => a -> a -> a
min Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y) (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> Expr t (SemiRingBase sr)
forall a. Ord a => a -> a -> a
max Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y)

semiRingAdd ::
  forall t st fs sr.
  ExprBuilder t st fs ->
  SR.SemiRingRepr sr ->
  Expr t (SR.SemiRingBase sr) ->
  Expr t (SR.SemiRingBase sr) ->
  IO (Expr t (SR.SemiRingBase sr))
semiRingAdd :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y =
    case (SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x, SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y) of
      (SR_Constant Coefficient sr
c, SemiRingView t sr
_) | SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr) -> Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
y
      (SemiRingView t sr
_, SR_Constant Coefficient sr
c) | SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr) -> Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x

      (SR_Constant Coefficient sr
xc, SR_Constant Coefficient sr
yc) ->
        ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (SemiRingRepr sr
-> Coefficient sr -> Coefficient sr -> Coefficient sr
forall (sr :: SemiRing).
SemiRingRepr sr
-> Coefficient sr -> Coefficient sr -> Coefficient sr
SR.add SemiRingRepr sr
sr Coefficient sr
xc Coefficient sr
yc)

      (SR_Constant Coefficient sr
xc, SR_Sum WeightedSum (Expr t) sr
ys) ->
        ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (SemiRingRepr sr
-> WeightedSum (Expr t) sr
-> Coefficient sr
-> WeightedSum (Expr t) sr
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
sr WeightedSum (Expr t) sr
ys Coefficient sr
xc)
      (SR_Sum WeightedSum (Expr t) sr
xs, SR_Constant Coefficient sr
yc) ->
        ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (SemiRingRepr sr
-> WeightedSum (Expr t) sr
-> Coefficient sr
-> WeightedSum (Expr t) sr
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
sr WeightedSum (Expr t) sr
xs Coefficient sr
yc)

      (SR_Constant Coefficient sr
xc, SemiRingView t sr
_)
        | Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t BaseBoolType
cond Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- Expr t (SemiRingBase sr) -> Maybe (App (Expr t) (SemiRingBase sr))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
y
        , Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr Expr t (SemiRingBase sr)
a Bool -> Bool -> Bool
|| Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr Expr t (SemiRingBase sr)
b -> do
            Expr t (SemiRingBase sr)
xa <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
a
            Expr t (SemiRingBase sr)
xb <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
b
            ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t BaseBoolType
cond Expr t (SemiRingBase sr)
xa Expr t (SemiRingBase sr)
xb
        | Bool
otherwise ->
            ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (SemiRingRepr sr
-> WeightedSum (Expr t) sr
-> Coefficient sr
-> WeightedSum (Expr t) sr
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
sr (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.var SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y) Coefficient sr
xc)

      (SemiRingView t sr
_, SR_Constant Coefficient sr
yc)
        | Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t BaseBoolType
cond Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- Expr t (SemiRingBase sr) -> Maybe (App (Expr t) (SemiRingBase sr))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
x
        , Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr Expr t (SemiRingBase sr)
a Bool -> Bool -> Bool
|| Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr Expr t (SemiRingBase sr)
b -> do
            Expr t (SemiRingBase sr)
ay <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
y
            Expr t (SemiRingBase sr)
by <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
b Expr t (SemiRingBase sr)
y
            ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t BaseBoolType
cond Expr t (SemiRingBase sr)
ay Expr t (SemiRingBase sr)
by
        | Bool
otherwise ->
            ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (SemiRingRepr sr
-> WeightedSum (Expr t) sr
-> Coefficient sr
-> WeightedSum (Expr t) sr
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
sr (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.var SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) Coefficient sr
yc)

      (SR_Sum WeightedSum (Expr t) sr
xs, SR_Sum WeightedSum (Expr t) sr
ys) -> ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (SemiRingRepr sr
-> WeightedSum (Expr t) sr
-> WeightedSum (Expr t) sr
-> WeightedSum (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> WeightedSum f sr -> WeightedSum f sr
WSum.add SemiRingRepr sr
sr WeightedSum (Expr t) sr
xs WeightedSum (Expr t) sr
ys)
      (SR_Sum WeightedSum (Expr t) sr
xs, SemiRingView t sr
_)         -> ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (SemiRingRepr sr
-> WeightedSum (Expr t) sr
-> Expr t (SemiRingBase sr)
-> WeightedSum (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.addVar SemiRingRepr sr
sr WeightedSum (Expr t) sr
xs Expr t (SemiRingBase sr)
y)
      (SemiRingView t sr
_ , SR_Sum WeightedSum (Expr t) sr
ys)        -> ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (SemiRingRepr sr
-> WeightedSum (Expr t) sr
-> Expr t (SemiRingBase sr)
-> WeightedSum (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.addVar SemiRingRepr sr
sr WeightedSum (Expr t) sr
ys Expr t (SemiRingBase sr)
x)
      (SemiRingView t sr, SemiRingView t sr)
_                      -> ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> WeightedSum (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> f (SemiRingBase sr) -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.addVars SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y)
  where isConstantSemiRingExpr :: Expr t (SR.SemiRingBase sr) -> Bool
        isConstantSemiRingExpr :: Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr (SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr -> SR_Constant Coefficient sr
_) = Bool
True
        isConstantSemiRingExpr Expr t (SemiRingBase sr)
_ = Bool
False

semiRingMul ::
  ExprBuilder t st fs ->
  SR.SemiRingRepr sr ->
  Expr t (SR.SemiRingBase sr) ->
  Expr t (SR.SemiRingBase sr) ->
  IO (Expr t (SR.SemiRingBase sr))
semiRingMul :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y =
  case (SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x, SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y) of
    (SR_Constant Coefficient sr
c, SemiRingView t sr
_) -> ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c Expr t (SemiRingBase sr)
y
    (SemiRingView t sr
_, SR_Constant Coefficient sr
c) -> ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c Expr t (SemiRingBase sr)
x

    (SR_Sum (WeightedSum (Expr t) sr
-> Maybe (Coefficient sr, Expr t (SemiRingBase sr), Coefficient sr)
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr
-> Maybe (Coefficient sr, f (SemiRingBase sr), Coefficient sr)
WSum.asAffineVar -> Just (Coefficient sr
c,Expr t (SemiRingBase sr)
x',Coefficient sr
o)), SemiRingView t sr
_) ->
      do Expr t (SemiRingBase sr)
cxy <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c (Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr)))
-> IO (Expr t (SemiRingBase sr)) -> IO (Expr t (SemiRingBase sr))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x' Expr t (SemiRingBase sr)
y
         Expr t (SemiRingBase sr)
oy  <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
o Expr t (SemiRingBase sr)
y
         ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
cxy Expr t (SemiRingBase sr)
oy

    (SemiRingView t sr
_, SR_Sum (WeightedSum (Expr t) sr
-> Maybe (Coefficient sr, Expr t (SemiRingBase sr), Coefficient sr)
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr
-> Maybe (Coefficient sr, f (SemiRingBase sr), Coefficient sr)
WSum.asAffineVar -> Just (Coefficient sr
c,Expr t (SemiRingBase sr)
y',Coefficient sr
o))) ->
      do Expr t (SemiRingBase sr)
cxy <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c (Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr)))
-> IO (Expr t (SemiRingBase sr)) -> IO (Expr t (SemiRingBase sr))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y'
         Expr t (SemiRingBase sr)
ox  <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
o Expr t (SemiRingBase sr)
x
         ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
cxy Expr t (SemiRingBase sr)
ox

    (SR_Prod SemiRingProduct (Expr t) sr
px, SR_Prod SemiRingProduct (Expr t) sr
py) -> ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym (SemiRingProduct (Expr t) sr
-> SemiRingProduct (Expr t) sr -> SemiRingProduct (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul SemiRingProduct (Expr t) sr
px SemiRingProduct (Expr t) sr
py)
    (SR_Prod SemiRingProduct (Expr t) sr
px, SemiRingView t sr
_)          -> ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym (SemiRingProduct (Expr t) sr
-> SemiRingProduct (Expr t) sr -> SemiRingProduct (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul SemiRingProduct (Expr t) sr
px (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> SemiRingProduct (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> SemiRingProduct f sr
WSum.prodVar SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y))
    (SemiRingView t sr
_, SR_Prod SemiRingProduct (Expr t) sr
py)          -> ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym (SemiRingProduct (Expr t) sr
-> SemiRingProduct (Expr t) sr -> SemiRingProduct (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> SemiRingProduct (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> SemiRingProduct f sr
WSum.prodVar SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) SemiRingProduct (Expr t) sr
py)
    (SemiRingView t sr, SemiRingView t sr)
_                        -> ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym (SemiRingProduct (Expr t) sr
-> SemiRingProduct (Expr t) sr -> SemiRingProduct (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> SemiRingProduct (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> SemiRingProduct f sr
WSum.prodVar SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) (SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> SemiRingProduct (Expr t) sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> SemiRingProduct f sr
WSum.prodVar SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y))


prodNonneg ::
  ExprBuilder t st fs ->
  SR.OrderedSemiRingRepr sr ->
  WSum.SemiRingProduct (Expr t) sr ->
  IO (Expr t BaseBoolType)
prodNonneg :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType)
prodNonneg ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr SemiRingProduct (Expr t) sr
pd =
  do let sr :: SemiRingRepr sr
sr = OrderedSemiRingRepr sr -> SemiRingRepr sr
forall (sr :: SemiRing). OrderedSemiRingRepr sr -> SemiRingRepr sr
SR.orderedSemiRing OrderedSemiRingRepr sr
osr
     Expr t (SemiRingBase sr)
zero <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
     (Expr t BaseBoolType, Expr t BaseBoolType) -> Expr t BaseBoolType
forall a b. (a, b) -> a
fst ((Expr t BaseBoolType, Expr t BaseBoolType) -> Expr t BaseBoolType)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
-> IO (Expr t BaseBoolType)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
computeNonnegNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
zero SemiRingProduct (Expr t) sr
pd

prodNonpos ::
  ExprBuilder t st fs ->
  SR.OrderedSemiRingRepr sr ->
  WSum.SemiRingProduct (Expr t) sr ->
  IO (Expr t BaseBoolType)
prodNonpos :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType)
prodNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr SemiRingProduct (Expr t) sr
pd =
  do let sr :: SemiRingRepr sr
sr = OrderedSemiRingRepr sr -> SemiRingRepr sr
forall (sr :: SemiRing). OrderedSemiRingRepr sr -> SemiRingRepr sr
SR.orderedSemiRing OrderedSemiRingRepr sr
osr
     Expr t (SemiRingBase sr)
zero <- ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
     (Expr t BaseBoolType, Expr t BaseBoolType) -> Expr t BaseBoolType
forall a b. (a, b) -> b
snd ((Expr t BaseBoolType, Expr t BaseBoolType) -> Expr t BaseBoolType)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
-> IO (Expr t BaseBoolType)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
computeNonnegNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
zero SemiRingProduct (Expr t) sr
pd

computeNonnegNonpos ::
  ExprBuilder t st fs ->
  SR.OrderedSemiRingRepr sr ->
  Expr t (SR.SemiRingBase sr) {- zero element -} ->
  WSum.SemiRingProduct (Expr t) sr ->
  IO (Expr t BaseBoolType, Expr t BaseBoolType)
computeNonnegNonpos :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> SemiRingProduct (Expr t) sr
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
computeNonnegNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
zero SemiRingProduct (Expr t) sr
pd =
   (Expr t BaseBoolType, Expr t BaseBoolType)
-> Maybe (Expr t BaseBoolType, Expr t BaseBoolType)
-> (Expr t BaseBoolType, Expr t BaseBoolType)
forall a. a -> Maybe a -> a
fromMaybe (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym, ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym) (Maybe (Expr t BaseBoolType, Expr t BaseBoolType)
 -> (Expr t BaseBoolType, Expr t BaseBoolType))
-> IO (Maybe (Expr t BaseBoolType, Expr t BaseBoolType))
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Expr t BaseBoolType, Expr t BaseBoolType)
 -> (Expr t BaseBoolType, Expr t BaseBoolType)
 -> IO (Expr t BaseBoolType, Expr t BaseBoolType))
-> (Expr t (SemiRingBase sr)
    -> IO (Expr t BaseBoolType, Expr t BaseBoolType))
-> SemiRingProduct (Expr t) sr
-> IO (Maybe (Expr t BaseBoolType, Expr t BaseBoolType))
forall (m :: Type -> Type) r (f :: BaseType -> Type)
       (sr :: SemiRing).
Monad m =>
(r -> r -> m r)
-> (f (SemiRingBase sr) -> m r)
-> SemiRingProduct f sr
-> m (Maybe r)
WSum.prodEvalM (Expr t BaseBoolType, Expr t BaseBoolType)
-> (Expr t BaseBoolType, Expr t BaseBoolType)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
merge Expr t (SemiRingBase sr)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
single SemiRingProduct (Expr t) sr
pd
 where

 single :: Expr t (SemiRingBase sr)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
single Expr t (SemiRingBase sr)
x = (,) (Expr t BaseBoolType
 -> Expr t BaseBoolType
 -> (Expr t BaseBoolType, Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO
     (Expr t BaseBoolType -> (Expr t BaseBoolType, Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> (forall (w :: Natural).
    (1 <= w) =>
    ExprBuilder t st fs
    -> UnaryBV (Pred (ExprBuilder t st fs)) w
    -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w)))
-> App (SymExpr (ExprBuilder t st fs)) BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> (forall (w :: Natural).
    (1 <= w) =>
    sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w)))
-> App (SymExpr sym) tp
-> IO (SymExpr sym tp)
reduceApp ExprBuilder t st fs
sym ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (SymExpr (ExprBuilder t st fs) ('BaseBVType w))
ExprBuilder t st fs
-> UnaryBV (Expr t BaseBoolType) w -> IO (BVExpr t w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary (OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> App (Expr t) BaseBoolType
forall (sr :: SemiRing) (e :: BaseType -> Type).
OrderedSemiRingRepr sr
-> e (SemiRingBase sr) -> e (SemiRingBase sr) -> App e BaseBoolType
SemiRingLe OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
zero Expr t (SemiRingBase sr)
x) -- nonnegative
                IO
  (Expr t BaseBoolType -> (Expr t BaseBoolType, Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> (forall (w :: Natural).
    (1 <= w) =>
    ExprBuilder t st fs
    -> UnaryBV (Pred (ExprBuilder t st fs)) w
    -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w)))
-> App (SymExpr (ExprBuilder t st fs)) BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> (forall (w :: Natural).
    (1 <= w) =>
    sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w)))
-> App (SymExpr sym) tp
-> IO (SymExpr sym tp)
reduceApp ExprBuilder t st fs
sym ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (SymExpr (ExprBuilder t st fs) ('BaseBVType w))
ExprBuilder t st fs
-> UnaryBV (Expr t BaseBoolType) w -> IO (BVExpr t w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary (OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> App (Expr t) BaseBoolType
forall (sr :: SemiRing) (e :: BaseType -> Type).
OrderedSemiRingRepr sr
-> e (SemiRingBase sr) -> e (SemiRingBase sr) -> App e BaseBoolType
SemiRingLe OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
zero) -- nonpositive

 merge :: (Expr t BaseBoolType, Expr t BaseBoolType)
-> (Expr t BaseBoolType, Expr t BaseBoolType)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
merge (Expr t BaseBoolType
nn1, Expr t BaseBoolType
np1) (Expr t BaseBoolType
nn2, Expr t BaseBoolType
np2) =
   do Expr t BaseBoolType
nn <- IO (IO (Expr t BaseBoolType)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym (Expr t BaseBoolType
 -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
nn1 Pred (ExprBuilder t st fs)
Expr t BaseBoolType
nn2 IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (IO (Expr t BaseBoolType))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
np1 Pred (ExprBuilder t st fs)
Expr t BaseBoolType
np2)
      Expr t BaseBoolType
np <- IO (IO (Expr t BaseBoolType)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym (Expr t BaseBoolType
 -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
nn1 Pred (ExprBuilder t st fs)
Expr t BaseBoolType
np2 IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (IO (Expr t BaseBoolType))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
np1 Pred (ExprBuilder t st fs)
Expr t BaseBoolType
nn2)
      (Expr t BaseBoolType, Expr t BaseBoolType)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t BaseBoolType
nn, Expr t BaseBoolType
np)



arrayResultIdxType :: BaseTypeRepr (BaseArrayType (idx ::> itp) d)
                   -> Ctx.Assignment BaseTypeRepr (idx ::> itp)
arrayResultIdxType :: forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
BaseTypeRepr (BaseArrayType (idx ::> itp) d)
-> Assignment BaseTypeRepr (idx ::> itp)
arrayResultIdxType (BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idx BaseTypeRepr xs
_) = Assignment BaseTypeRepr (idx ::> itp)
Assignment BaseTypeRepr (idx ::> tp)
idx

-- | This decomposes A ExprBuilder array expression into a set of indices that
-- have been updated, and an underlying index.
data ArrayMapView i f tp
   = ArrayMapView { forall (i :: Ctx BaseType) (f :: BaseType -> Type)
       (tp :: BaseType).
ArrayMapView i f tp -> ArrayUpdateMap f i tp
_arrayMapViewIndices :: !(AUM.ArrayUpdateMap f i tp)
                  , forall (i :: Ctx BaseType) (f :: BaseType -> Type)
       (tp :: BaseType).
ArrayMapView i f tp -> f (BaseArrayType i tp)
_arrayMapViewExpr    :: !(f (BaseArrayType i tp))
                  }

-- | Construct an 'ArrayMapView' for an element.
viewArrayMap :: Expr t (BaseArrayType i tp)
             -> ArrayMapView i (Expr t) tp
viewArrayMap :: forall t (i :: Ctx BaseType) (tp :: BaseType).
Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
viewArrayMap  Expr t (BaseArrayType i tp)
x
  | Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
m Expr t ('BaseArrayType (i ::> itp) tp1)
c) <- Expr t (BaseArrayType i tp)
-> Maybe (App (Expr t) (BaseArrayType i tp))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType i tp)
x = ArrayUpdateMap (Expr t) i tp
-> Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
forall (i :: Ctx BaseType) (f :: BaseType -> Type)
       (tp :: BaseType).
ArrayUpdateMap f i tp
-> f (BaseArrayType i tp) -> ArrayMapView i f tp
ArrayMapView ArrayUpdateMap (Expr t) i tp
ArrayUpdateMap (Expr t) (i ::> itp) tp1
m Expr t (BaseArrayType i tp)
Expr t ('BaseArrayType (i ::> itp) tp1)
c
  | Bool
otherwise = ArrayUpdateMap (Expr t) i tp
-> Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
forall (i :: Ctx BaseType) (f :: BaseType -> Type)
       (tp :: BaseType).
ArrayUpdateMap f i tp
-> f (BaseArrayType i tp) -> ArrayMapView i f tp
ArrayMapView ArrayUpdateMap (Expr t) i tp
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp
AUM.empty Expr t (BaseArrayType i tp)
x

-- | Construct an 'ArrayMapView' for an element.
underlyingArrayMapExpr :: ArrayResultWrapper (Expr t) i tp
                      -> ArrayResultWrapper (Expr t) i tp
underlyingArrayMapExpr :: forall t (i :: Ctx BaseType) (tp :: BaseType).
ArrayResultWrapper (Expr t) i tp
-> ArrayResultWrapper (Expr t) i tp
underlyingArrayMapExpr ArrayResultWrapper (Expr t) i tp
x
  | Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
_ Expr t ('BaseArrayType (i ::> itp) tp1)
c) <- Expr t (BaseArrayType i tp)
-> Maybe (App (Expr t) (BaseArrayType i tp))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp (ArrayResultWrapper (Expr t) i tp -> Expr t (BaseArrayType i tp)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) i tp
x) = Expr t (BaseArrayType i tp) -> ArrayResultWrapper (Expr t) i tp
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
ArrayResultWrapper Expr t (BaseArrayType i tp)
Expr t ('BaseArrayType (i ::> itp) tp1)
c
  | Bool
otherwise = ArrayResultWrapper (Expr t) i tp
x

-- | Return set of addresss in assignment that are written to by at least one expr
concreteArrayEntries :: forall t i ctx
                     .  Ctx.Assignment (ArrayResultWrapper (Expr t) i) ctx
                     -> Set (Ctx.Assignment IndexLit i)
concreteArrayEntries :: forall t (i :: Ctx BaseType) (ctx :: Ctx BaseType).
Assignment (ArrayResultWrapper (Expr t) i) ctx
-> Set (Assignment IndexLit i)
concreteArrayEntries = (forall (x :: BaseType).
 Set (Assignment IndexLit i)
 -> ArrayResultWrapper (Expr t) i x -> Set (Assignment IndexLit i))
-> forall (x :: Ctx BaseType).
   Set (Assignment IndexLit i)
   -> Assignment (ArrayResultWrapper (Expr t) i) x
   -> Set (Assignment IndexLit i)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) b.
FoldableFC t =>
(forall (x :: k). b -> f x -> b)
-> forall (x :: l). b -> t f x -> b
forall (f :: BaseType -> Type) b.
(forall (x :: BaseType). b -> f x -> b)
-> forall (x :: Ctx BaseType). b -> Assignment f x -> b
foldlFC' Set (Assignment IndexLit i)
-> ArrayResultWrapper (Expr t) i x -> Set (Assignment IndexLit i)
forall (x :: BaseType).
Set (Assignment IndexLit i)
-> ArrayResultWrapper (Expr t) i x -> Set (Assignment IndexLit i)
f Set (Assignment IndexLit i)
forall a. Set a
Set.empty
  where f :: Set (Ctx.Assignment IndexLit i)
          -> ArrayResultWrapper (Expr t) i tp
          -> Set (Ctx.Assignment IndexLit i)
        f :: forall (x :: BaseType).
Set (Assignment IndexLit i)
-> ArrayResultWrapper (Expr t) i x -> Set (Assignment IndexLit i)
f Set (Assignment IndexLit i)
s ArrayResultWrapper (Expr t) i tp
e
          | Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
m Expr t ('BaseArrayType (i ::> itp) tp1)
_) <- Expr t (BaseArrayType i tp)
-> Maybe (App (Expr t) (BaseArrayType i tp))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp (ArrayResultWrapper (Expr t) i tp -> Expr t (BaseArrayType i tp)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult  ArrayResultWrapper (Expr t) i tp
e) =
            Set (Assignment IndexLit i)
-> Set (Assignment IndexLit i) -> Set (Assignment IndexLit i)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Assignment IndexLit i)
s (ArrayUpdateMap (Expr t) i tp1 -> Set (Assignment IndexLit i)
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp -> Set (Assignment IndexLit ctx)
AUM.keysSet ArrayUpdateMap (Expr t) i tp1
ArrayUpdateMap (Expr t) (i ::> itp) tp1
m)
          | Bool
otherwise = Set (Assignment IndexLit i)
s



data IntLit tp = (tp ~ BaseIntegerType) => IntLit Integer

asIntBounds :: Ctx.Assignment (Expr t) idx -> Maybe (Ctx.Assignment IntLit idx)
asIntBounds :: forall t (idx :: Ctx BaseType).
Assignment (Expr t) idx -> Maybe (Assignment IntLit idx)
asIntBounds = (forall (x :: BaseType). Expr t x -> Maybe (IntLit x))
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> Maybe (Assignment IntLit x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC Expr t x -> Maybe (IntLit x)
forall t (tp :: BaseType). Expr t tp -> Maybe (IntLit tp)
forall (x :: BaseType). Expr t x -> Maybe (IntLit x)
f
  where f :: Expr t tp -> Maybe (IntLit tp)
        f :: forall t (tp :: BaseType). Expr t tp -> Maybe (IntLit tp)
f (SemiRingLiteral SemiRingRepr sr
SR.SemiRingIntegerRepr Coefficient sr
n ProgramLoc
_) = IntLit tp -> Maybe (IntLit tp)
forall a. a -> Maybe a
Just (Integer -> IntLit tp
forall (tp :: BaseType).
(tp ~ BaseIntegerType) =>
Integer -> IntLit tp
IntLit Integer
Coefficient sr
n)
        f Expr t tp
_ = Maybe (IntLit tp)
forall a. Maybe a
Nothing

foldBoundLeM :: (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM :: forall r. (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM r -> Integer -> IO r
f r
r Integer
n
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = r -> IO r
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure r
r
  | Bool
otherwise =
      do r
r' <- (r -> Integer -> IO r) -> r -> Integer -> IO r
forall r. (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM r -> Integer -> IO r
f r
r (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)
         r -> Integer -> IO r
f r
r' Integer
n

foldIndicesInRangeBounds :: forall sym idx r
                         .  IsExprBuilder sym
                         => sym
                         -> (r -> Ctx.Assignment (SymExpr sym) idx -> IO r)
                         -> r
                         -> Ctx.Assignment IntLit idx
                         -> IO r
foldIndicesInRangeBounds :: forall sym (idx :: Ctx BaseType) r.
IsExprBuilder sym =>
sym
-> (r -> Assignment (SymExpr sym) idx -> IO r)
-> r
-> Assignment IntLit idx
-> IO r
foldIndicesInRangeBounds sym
sym r -> Assignment (SymExpr sym) idx -> IO r
f0 r
a0 Assignment IntLit idx
bnds0 = do
  case Assignment IntLit idx
bnds0 of
    Assignment IntLit idx
Ctx.Empty -> r -> Assignment (SymExpr sym) idx -> IO r
f0 r
a0 Assignment (SymExpr sym) idx
Assignment (SymExpr sym) EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty
    Assignment IntLit ctx
bnds Ctx.:> IntLit Integer
b -> sym
-> (r -> Assignment (SymExpr sym) ctx -> IO r)
-> r
-> Assignment IntLit ctx
-> IO r
forall sym (idx :: Ctx BaseType) r.
IsExprBuilder sym =>
sym
-> (r -> Assignment (SymExpr sym) idx -> IO r)
-> r
-> Assignment IntLit idx
-> IO r
foldIndicesInRangeBounds sym
sym ((r -> Assignment (SymExpr sym) (ctx ::> BaseIntegerType) -> IO r)
-> r -> Assignment (SymExpr sym) ctx -> IO r
forall (idx0 :: Ctx BaseType).
(r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> r -> Assignment (SymExpr sym) idx0 -> IO r
g r -> Assignment (SymExpr sym) idx -> IO r
r -> Assignment (SymExpr sym) (ctx ::> BaseIntegerType) -> IO r
f0) r
a0 Assignment IntLit ctx
bnds
      where g :: (r -> Ctx.Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
              -> r
              -> Ctx.Assignment (SymExpr sym) idx0
              -> IO r
            g :: forall (idx0 :: Ctx BaseType).
(r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> r -> Assignment (SymExpr sym) idx0 -> IO r
g r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r
f r
a Assignment (SymExpr sym) idx0
i = (r -> Integer -> IO r) -> r -> Integer -> IO r
forall r. (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM ((r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> Assignment (SymExpr sym) idx0 -> r -> Integer -> IO r
forall (idx0 :: Ctx BaseType).
(r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> Assignment (SymExpr sym) idx0 -> r -> Integer -> IO r
h r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r
f Assignment (SymExpr sym) idx0
i) r
a Integer
b

            h :: (r -> Ctx.Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
              -> Ctx.Assignment (SymExpr sym) idx0
              -> r
              -> Integer
              -> IO r
            h :: forall (idx0 :: Ctx BaseType).
(r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> Assignment (SymExpr sym) idx0 -> r -> Integer -> IO r
h r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r
f Assignment (SymExpr sym) idx0
i r
a Integer
j = do
              SymExpr sym BaseIntegerType
je <- sym -> Integer -> IO (SymExpr sym BaseIntegerType)
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym Integer
j
              r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r
f r
a (Assignment (SymExpr sym) idx0
i Assignment (SymExpr sym) idx0
-> SymExpr sym BaseIntegerType
-> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymExpr sym BaseIntegerType
je)

-- | Examine the list of terms, and determine if any one of them
--   appears in the given @BoolMap@ with the same polarity.
checkAbsorption ::
  BoolMap (Expr t) ->
  [(BoolExpr t, Polarity)] ->
  Bool
checkAbsorption :: forall t. BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
checkAbsorption BoolMap (Expr t)
_bm [] = Bool
False
checkAbsorption BoolMap (Expr t)
bm ((BoolExpr t
x,Polarity
p):[(BoolExpr t, Polarity)]
_)
  | Just Polarity
p' <- BoolMap (Expr t) -> BoolExpr t -> Maybe Polarity
forall (f :: BaseType -> Type).
OrdF f =>
BoolMap f -> f BaseBoolType -> Maybe Polarity
BM.contains BoolMap (Expr t)
bm BoolExpr t
x, Polarity
p Polarity -> Polarity -> Bool
forall a. Eq a => a -> a -> Bool
== Polarity
p' = Bool
True
checkAbsorption BoolMap (Expr t)
bm ((BoolExpr t, Polarity)
_:[(BoolExpr t, Polarity)]
xs) = BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
forall t. BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
checkAbsorption BoolMap (Expr t)
bm [(BoolExpr t, Polarity)]
xs

-- | If @tryAndAbsorption x y@ returns @True@, that means that @y@
-- implies @x@, so that the conjunction @x AND y = y@. A @False@
-- result gives no information.
tryAndAbsorption ::
  BoolExpr t ->
  BoolExpr t ->
  Bool
tryAndAbsorption :: forall t. BoolExpr t -> BoolExpr t -> Bool
tryAndAbsorption (BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (NotPred (BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as)))) (BoolExpr t -> [(BoolExpr t, Polarity)]
forall t. Expr t BaseBoolType -> [(Expr t BaseBoolType, Polarity)]
asConjunction -> [(BoolExpr t, Polarity)]
bs)
  = BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
forall t. BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
checkAbsorption (BoolMap (Expr t) -> BoolMap (Expr t)
forall (f :: BaseType -> Type). OrdF f => BoolMap f -> BoolMap f
BM.reversePolarities BoolMap (Expr t)
as) [(BoolExpr t, Polarity)]
bs
tryAndAbsorption BoolExpr t
_ BoolExpr t
_ = Bool
False


-- | If @tryOrAbsorption x y@ returns @True@, that means that @x@
-- implies @y@, so that the disjunction @x OR y = y@. A @False@
-- result gives no information.
tryOrAbsorption ::
  BoolExpr t ->
  BoolExpr t ->
  Bool
tryOrAbsorption :: forall t. BoolExpr t -> BoolExpr t -> Bool
tryOrAbsorption (BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as)) (BoolExpr t -> [(BoolExpr t, Polarity)]
forall t. Expr t BaseBoolType -> [(Expr t BaseBoolType, Polarity)]
asDisjunction -> [(BoolExpr t, Polarity)]
bs)
  = BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
forall t. BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
checkAbsorption BoolMap (Expr t)
as [(BoolExpr t, Polarity)]
bs
tryOrAbsorption BoolExpr t
_ BoolExpr t
_ = Bool
False



instance IsExprBuilder (ExprBuilder t st fs) where
  getConfiguration :: ExprBuilder t st fs -> Config
getConfiguration = ExprBuilder t st fs -> Config
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Config
sbConfiguration

  setSolverLogListener :: ExprBuilder t st fs -> Maybe (SolverEvent -> IO ()) -> IO ()
setSolverLogListener ExprBuilder t st fs
sb = IORef (Maybe (SolverEvent -> IO ()))
-> Maybe (SolverEvent -> IO ()) -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef (ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger ExprBuilder t st fs
sb)
  getSolverLogListener :: ExprBuilder t st fs -> IO (Maybe (SolverEvent -> IO ()))
getSolverLogListener ExprBuilder t st fs
sb = IORef (Maybe (SolverEvent -> IO ()))
-> IO (Maybe (SolverEvent -> IO ()))
forall a. IORef a -> IO a
readIORef (ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger ExprBuilder t st fs
sb)

  logSolverEvent :: ExprBuilder t st fs -> SolverEvent -> IO ()
logSolverEvent ExprBuilder t st fs
sb SolverEvent
ev =
    IORef (Maybe (SolverEvent -> IO ()))
-> IO (Maybe (SolverEvent -> IO ()))
forall a. IORef a -> IO a
readIORef (ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger ExprBuilder t st fs
sb) IO (Maybe (SolverEvent -> IO ()))
-> (Maybe (SolverEvent -> IO ()) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (SolverEvent -> IO ())
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
      Just SolverEvent -> IO ()
f  -> SolverEvent -> IO ()
f SolverEvent
ev

  getStatistics :: ExprBuilder t st fs -> IO Statistics
getStatistics ExprBuilder t st fs
sb = do
    Integer
allocs <- NonceGenerator IO t -> IO Integer
forall (m :: Type -> Type) s. NonceGenerator m s -> m Integer
countNoncesGenerated (ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)
    Integer
nonLinearOps <- IORef Integer -> IO Integer
forall a. IORef a -> IO a
readIORef (ExprBuilder t st fs -> IORef Integer
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef Integer
sbNonLinearOps ExprBuilder t st fs
sb)
    Statistics -> IO Statistics
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Statistics -> IO Statistics) -> Statistics -> IO Statistics
forall a b. (a -> b) -> a -> b
$ Statistics { statAllocs :: Integer
statAllocs = Integer
allocs
                        , statNonLinearOps :: Integer
statNonLinearOps = Integer
nonLinearOps }

  annotateTerm :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SymExpr (ExprBuilder t st fs) tp
-> IO
     (SymAnnotation (ExprBuilder t st fs) tp,
      SymExpr (ExprBuilder t st fs) tp)
annotateTerm ExprBuilder t st fs
sym SymExpr (ExprBuilder t st fs) tp
e =
    case SymExpr (ExprBuilder t st fs) tp
e of
      BoundVarExpr (ExprBoundVar t tp -> Nonce t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId -> Nonce t tp
n) -> (Nonce t tp, Expr t tp) -> IO (Nonce t tp, Expr t tp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Nonce t tp
n, SymExpr (ExprBuilder t st fs) tp
Expr t tp
e)
      NonceAppExpr (NonceAppExpr t tp -> NonceApp t (Expr t) tp
forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp -> Annotation BaseTypeRepr tp
_ Nonce t tp
n Expr t tp
_) -> (Nonce t tp, Expr t tp) -> IO (Nonce t tp, Expr t tp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Nonce t tp
n, SymExpr (ExprBuilder t st fs) tp
Expr t tp
e)
      SymExpr (ExprBuilder t st fs) tp
_ -> do
        let tpr :: BaseTypeRepr tp
tpr = Expr t tp -> BaseTypeRepr tp
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) tp
Expr t tp
e
        Nonce t tp
n <- ExprBuilder t st fs -> IO (Nonce t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sym
        Expr t tp
e' <- ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (BaseTypeRepr tp
-> Nonce t tp -> Expr t tp -> NonceApp t (Expr t) tp
forall (tp :: BaseType) t (e :: BaseType -> Type).
BaseTypeRepr tp -> Nonce t tp -> e tp -> NonceApp t e tp
Annotation BaseTypeRepr tp
tpr Nonce t tp
n SymExpr (ExprBuilder t st fs) tp
Expr t tp
e)
        (Nonce t tp, Expr t tp) -> IO (Nonce t tp, Expr t tp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Nonce t tp
n, Expr t tp
e')

  getAnnotation :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SymExpr (ExprBuilder t st fs) tp
-> Maybe (SymAnnotation (ExprBuilder t st fs) tp)
getAnnotation ExprBuilder t st fs
_sym SymExpr (ExprBuilder t st fs) tp
e =
    case SymExpr (ExprBuilder t st fs) tp
e of
      BoundVarExpr (ExprBoundVar t tp -> Nonce t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId -> Nonce t tp
n) -> Nonce t tp -> Maybe (Nonce t tp)
forall a. a -> Maybe a
Just Nonce t tp
n
      NonceAppExpr (NonceAppExpr t tp -> NonceApp t (Expr t) tp
forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp -> Annotation BaseTypeRepr tp
_ Nonce t tp
n Expr t tp
_) -> Nonce t tp -> Maybe (Nonce t tp)
forall a. a -> Maybe a
Just Nonce t tp
n
      SymExpr (ExprBuilder t st fs) tp
_ -> Maybe (Nonce t tp)
Maybe (SymAnnotation (ExprBuilder t st fs) tp)
forall a. Maybe a
Nothing

  getUnannotatedTerm :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SymExpr (ExprBuilder t st fs) tp
-> Maybe (SymExpr (ExprBuilder t st fs) tp)
getUnannotatedTerm ExprBuilder t st fs
_sym SymExpr (ExprBuilder t st fs) tp
e =
    case SymExpr (ExprBuilder t st fs) tp
e of
      NonceAppExpr (NonceAppExpr t tp -> NonceApp t (Expr t) tp
forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp -> Annotation BaseTypeRepr tp
_ Nonce t tp
_ Expr t tp
x) -> Expr t tp -> Maybe (Expr t tp)
forall a. a -> Maybe a
Just Expr t tp
x
      SymExpr (ExprBuilder t st fs) tp
_ -> Maybe (SymExpr (ExprBuilder t st fs) tp)
Maybe (Expr t tp)
forall a. Maybe a
Nothing

  ----------------------------------------------------------------------
  -- Program location operations

  getCurrentProgramLoc :: ExprBuilder t st fs -> IO ProgramLoc
getCurrentProgramLoc = ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc
  setCurrentProgramLoc :: ExprBuilder t st fs -> ProgramLoc -> IO ()
setCurrentProgramLoc ExprBuilder t st fs
sym ProgramLoc
l = IORef ProgramLoc -> ProgramLoc -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef (ExprBuilder t st fs -> IORef ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef ProgramLoc
sbProgramLoc ExprBuilder t st fs
sym) ProgramLoc
l

  ----------------------------------------------------------------------
  -- Bool operations.

  truePred :: ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
truePred  = ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
ExprBuilder t st fs -> BoolExpr t
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> BoolExpr t
sbTrue
  falsePred :: ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
falsePred = ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
ExprBuilder t st fs -> BoolExpr t
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> BoolExpr t
sbFalse

  notPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
notPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x
    | Just Bool
b <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
x
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> BoolExpr t) -> Bool -> BoolExpr t
forall a b. (a -> b) -> a -> b
$! Bool -> Bool
not Bool
b)

    | Just (NotPred BoolExpr t
x') <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Pred (ExprBuilder t st fs)
BoolExpr t
x
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
x'

    | Bool
otherwise
    = ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (BoolExpr t -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type).
e BaseBoolType -> App e BaseBoolType
NotPred Pred (ExprBuilder t st fs)
BoolExpr t
x)

  eqPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
eqPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y
    | Pred (ExprBuilder t st fs)
BoolExpr t
x BoolExpr t -> BoolExpr t -> Bool
forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
BoolExpr t
y
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)

    | Just (NotPred BoolExpr t
x') <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Pred (ExprBuilder t st fs)
BoolExpr t
x
    = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
xorPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
x' Pred (ExprBuilder t st fs)
y

    | Just (NotPred BoolExpr t
y') <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Pred (ExprBuilder t st fs)
BoolExpr t
y
    = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
xorPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
BoolExpr t
y'

    | Bool
otherwise
    = case (BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
x, BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
y) of
        (Just Bool
False, Maybe Bool
_)    -> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
y
        (Just Bool
True, Maybe Bool
_)     -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
y
        (Maybe Bool
_, Just Bool
False)    -> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x
        (Maybe Bool
_, Just Bool
True)     -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
x
        (Maybe Bool, Maybe Bool)
_ -> ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr BaseBoolType
-> BoolExpr t -> BoolExpr t -> App (Expr t) BaseBoolType
forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e BaseBoolType
BaseEq BaseTypeRepr BaseBoolType
BaseBoolRepr (BoolExpr t -> BoolExpr t -> BoolExpr t
forall a. Ord a => a -> a -> a
min Pred (ExprBuilder t st fs)
BoolExpr t
x Pred (ExprBuilder t st fs)
BoolExpr t
y) (BoolExpr t -> BoolExpr t -> BoolExpr t
forall a. Ord a => a -> a -> a
max Pred (ExprBuilder t st fs)
BoolExpr t
x Pred (ExprBuilder t st fs)
BoolExpr t
y)

  xorPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
xorPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
eqPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y

  andPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y =
    case (BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
x, BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
y) of
      (Just Bool
True, Maybe Bool
_)  -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
y
      (Just Bool
False, Maybe Bool
_) -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
x
      (Maybe Bool
_, Just Bool
True)  -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
x
      (Maybe Bool
_, Just Bool
False) -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
y
      (Maybe Bool, Maybe Bool)
_ | Pred (ExprBuilder t st fs)
BoolExpr t
x BoolExpr t -> BoolExpr t -> Bool
forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
BoolExpr t
y -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
x -- and is idempotent
        | Bool
otherwise -> BoolExpr t -> BoolExpr t -> IO (BoolExpr t)
go Pred (ExprBuilder t st fs)
BoolExpr t
x Pred (ExprBuilder t st fs)
BoolExpr t
y

   where
   go :: BoolExpr t -> BoolExpr t -> IO (BoolExpr t)
go BoolExpr t
a BoolExpr t
b
     | Just (ConjPred BoolMap (Expr t)
as) <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BoolExpr t
a
     , Just (ConjPred BoolMap (Expr t)
bs) <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BoolExpr t
b
     = ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (BoolMap (Expr t) -> IO (BoolExpr t))
-> BoolMap (Expr t) -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ BoolMap (Expr t) -> BoolMap (Expr t) -> BoolMap (Expr t)
forall (f :: BaseType -> Type).
OrdF f =>
BoolMap f -> BoolMap f -> BoolMap f
BM.combine BoolMap (Expr t)
as BoolMap (Expr t)
bs

     | BoolExpr t -> BoolExpr t -> Bool
forall t. BoolExpr t -> BoolExpr t -> Bool
tryAndAbsorption BoolExpr t
a BoolExpr t
b
     = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
b

     | BoolExpr t -> BoolExpr t -> Bool
forall t. BoolExpr t -> BoolExpr t -> Bool
tryAndAbsorption BoolExpr t
b BoolExpr t
a
     = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
a

     | Just (ConjPred BoolMap (Expr t)
as) <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BoolExpr t
a
     = ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (BoolMap (Expr t) -> IO (BoolExpr t))
-> BoolMap (Expr t) -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ (BoolExpr t -> Polarity -> BoolMap (Expr t) -> BoolMap (Expr t))
-> (BoolExpr t, Polarity) -> BoolMap (Expr t) -> BoolMap (Expr t)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BoolExpr t -> Polarity -> BoolMap (Expr t) -> BoolMap (Expr t)
forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
f BaseBoolType -> Polarity -> BoolMap f -> BoolMap f
BM.addVar (BoolExpr t -> (BoolExpr t, Polarity)
forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asPosAtom BoolExpr t
b) BoolMap (Expr t)
as

     | Just (ConjPred BoolMap (Expr t)
bs) <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BoolExpr t
b
     = ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (BoolMap (Expr t) -> IO (BoolExpr t))
-> BoolMap (Expr t) -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ (BoolExpr t -> Polarity -> BoolMap (Expr t) -> BoolMap (Expr t))
-> (BoolExpr t, Polarity) -> BoolMap (Expr t) -> BoolMap (Expr t)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BoolExpr t -> Polarity -> BoolMap (Expr t) -> BoolMap (Expr t)
forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
f BaseBoolType -> Polarity -> BoolMap f -> BoolMap f
BM.addVar (BoolExpr t -> (BoolExpr t, Polarity)
forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asPosAtom BoolExpr t
a) BoolMap (Expr t)
bs

     | Bool
otherwise
     = ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (BoolMap (Expr t) -> IO (BoolExpr t))
-> BoolMap (Expr t) -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ [(BoolExpr t, Polarity)] -> BoolMap (Expr t)
forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
[(f BaseBoolType, Polarity)] -> BoolMap f
BM.fromVars [BoolExpr t -> (BoolExpr t, Polarity)
forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asPosAtom BoolExpr t
a, BoolExpr t -> (BoolExpr t, Polarity)
forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asPosAtom BoolExpr t
b]

  orPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
orPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y =
    case (BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
x, BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
y) of
      (Just Bool
True, Maybe Bool
_)  -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
x
      (Just Bool
False, Maybe Bool
_) -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
y
      (Maybe Bool
_, Just Bool
True)  -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
y
      (Maybe Bool
_, Just Bool
False) -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
x
      (Maybe Bool, Maybe Bool)
_ | Pred (ExprBuilder t st fs)
BoolExpr t
x BoolExpr t -> BoolExpr t -> Bool
forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
BoolExpr t
y -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
x -- or is idempotent
        | Bool
otherwise -> BoolExpr t -> BoolExpr t -> IO (BoolExpr t)
go Pred (ExprBuilder t st fs)
BoolExpr t
x Pred (ExprBuilder t st fs)
BoolExpr t
y

   where
   go :: BoolExpr t -> BoolExpr t -> IO (BoolExpr t)
go BoolExpr t
a BoolExpr t
b
     | Just (NotPred (BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as))) <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BoolExpr t
a
     , Just (NotPred (BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
bs))) <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BoolExpr t
b
     = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (BoolMap (Expr t) -> BoolMap (Expr t) -> BoolMap (Expr t)
forall (f :: BaseType -> Type).
OrdF f =>
BoolMap f -> BoolMap f -> BoolMap f
BM.combine BoolMap (Expr t)
as BoolMap (Expr t)
bs)

     | BoolExpr t -> BoolExpr t -> Bool
forall t. BoolExpr t -> BoolExpr t -> Bool
tryOrAbsorption BoolExpr t
a BoolExpr t
b
     = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
b

     | BoolExpr t -> BoolExpr t -> Bool
forall t. BoolExpr t -> BoolExpr t -> Bool
tryOrAbsorption BoolExpr t
b BoolExpr t
a
     = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
a

     | Just (NotPred (BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as))) <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BoolExpr t
a
     = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym ((BoolExpr t -> Polarity -> BoolMap (Expr t) -> BoolMap (Expr t))
-> (BoolExpr t, Polarity) -> BoolMap (Expr t) -> BoolMap (Expr t)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BoolExpr t -> Polarity -> BoolMap (Expr t) -> BoolMap (Expr t)
forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
f BaseBoolType -> Polarity -> BoolMap f -> BoolMap f
BM.addVar (BoolExpr t -> (BoolExpr t, Polarity)
forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asNegAtom BoolExpr t
b) BoolMap (Expr t)
as)

     | Just (NotPred (BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
bs))) <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BoolExpr t
b
     = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym ((BoolExpr t -> Polarity -> BoolMap (Expr t) -> BoolMap (Expr t))
-> (BoolExpr t, Polarity) -> BoolMap (Expr t) -> BoolMap (Expr t)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BoolExpr t -> Polarity -> BoolMap (Expr t) -> BoolMap (Expr t)
forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
f BaseBoolType -> Polarity -> BoolMap f -> BoolMap f
BM.addVar (BoolExpr t -> (BoolExpr t, Polarity)
forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asNegAtom BoolExpr t
a) BoolMap (Expr t)
bs)

     | Bool
otherwise
     = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym ([(BoolExpr t, Polarity)] -> BoolMap (Expr t)
forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
[(f BaseBoolType, Polarity)] -> BoolMap f
BM.fromVars [BoolExpr t -> (BoolExpr t, Polarity)
forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asNegAtom BoolExpr t
a, BoolExpr t -> (BoolExpr t, Polarity)
forall t. Expr t BaseBoolType -> (Expr t BaseBoolType, Polarity)
asNegAtom BoolExpr t
b])

  itePred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
itePred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y
      -- ite c c y = c || y
    | Pred (ExprBuilder t st fs)
BoolExpr t
c BoolExpr t -> BoolExpr t -> Bool
forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
BoolExpr t
x = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
y

      -- ite c x c = c && x
    | Pred (ExprBuilder t st fs)
BoolExpr t
c BoolExpr t -> BoolExpr t -> Bool
forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
BoolExpr t
y = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
x

      -- ite c x x = x
    | Pred (ExprBuilder t st fs)
BoolExpr t
x BoolExpr t -> BoolExpr t -> Bool
forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
BoolExpr t
y = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
x

      -- ite 1 x y = x
    | Just Bool
True  <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
c = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
x

      -- ite 0 x y = y
    | Just Bool
False <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
c = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
BoolExpr t
y

      -- ite !c x y = ite c y x
    | Just (NotPred BoolExpr t
c') <- BoolExpr t -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Pred (ExprBuilder t st fs)
BoolExpr t
c = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
BoolExpr t
c' Pred (ExprBuilder t st fs)
y Pred (ExprBuilder t st fs)
x

      -- ite c 1 y = c || y
    | Just Bool
True  <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
x = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
y

      -- ite c 0 y = !c && y
    | Just Bool
False <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
x = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
y (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c

      -- ite c x 1 = !c || x
    | Just Bool
True  <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
y = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
x (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c

      -- ite c x 0 = c && x
    | Just Bool
False <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
y = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
x

      -- Default case
    | Bool
otherwise =
        let sz :: Integer
sz = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ BoolExpr t -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Pred (ExprBuilder t st fs)
BoolExpr t
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ BoolExpr t -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Pred (ExprBuilder t st fs)
BoolExpr t
y in
        ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr BaseBoolType
-> Integer
-> BoolExpr t
-> BoolExpr t
-> BoolExpr t
-> App (Expr t) BaseBoolType
forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e BaseBoolType -> e tp -> e tp -> App e tp
BaseIte BaseTypeRepr BaseBoolType
BaseBoolRepr Integer
sz Pred (ExprBuilder t st fs)
BoolExpr t
c Pred (ExprBuilder t st fs)
BoolExpr t
x Pred (ExprBuilder t st fs)
BoolExpr t
y

  ----------------------------------------------------------------------
  -- Integer operations.

  intLit :: ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
intLit ExprBuilder t st fs
sym Integer
n = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingInteger
-> Coefficient 'SemiRingInteger
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr Integer
Coefficient 'SemiRingInteger
n

  intNeg :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intNeg ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingInteger
-> Coefficient 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr (-Integer
1) SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x

  intAdd :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intAdd ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Expr t (SemiRingBase 'SemiRingInteger)
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
y

  intMul :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intMul ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Expr t (SemiRingBase 'SemiRingInteger)
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
y

  intIte :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingInteger
-> BoolExpr t
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Expr t (SemiRingBase 'SemiRingInteger)
-> IO (Expr t (SemiRingBase 'SemiRingInteger))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr Pred (ExprBuilder t st fs)
BoolExpr t
c SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
y

  intEq :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
intEq ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
      -- Use range check
    | Just Bool
b <- ValueRange Integer -> ValueRange Integer -> Maybe Bool
forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckEq (Expr t BaseIntegerType -> AbstractValue BaseIntegerType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x) (Expr t BaseIntegerType -> AbstractValue BaseIntegerType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y)
    = Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

      -- Reduce to bitvector equality, when possible
    | Just (SBVToInteger Expr t (BaseBVType w)
xbv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y
    = let wx :: NatRepr w
wx = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
          wy :: NatRepr w
wy = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv
          -- Sign extend to largest bitvector and compare.
       in case NatRepr w -> NatRepr w -> NatCases w w
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
wx NatRepr w
wy of
            NatCaseLT LeqProof (w + 1) w
LeqProof -> do
              Expr t (BaseBVType w)
x' <- ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
wy SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv
              ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
            NatCases w w
NatCaseEQ ->
              ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
            NatCaseGT LeqProof (w + 1) w
LeqProof -> do
              Expr t (BaseBVType w)
y' <- ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
wx SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
              ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'

      -- Reduce to bitvector equality, when possible
    | Just (BVToInteger Expr t (BaseBVType w)
xbv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , Just (BVToInteger Expr t (BaseBVType w)
ybv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y
    = let wx :: NatRepr w
wx = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
          wy :: NatRepr w
wy = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv
          -- Zero extend to largest bitvector and compare.
       in case NatRepr w -> NatRepr w -> NatCases w w
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
wx NatRepr w
wy of
            NatCaseLT LeqProof (w + 1) w
LeqProof -> do
              Expr t (BaseBVType w)
x' <- ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
wy SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv
              ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
            NatCases w w
NatCaseEQ ->
              ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
            NatCaseGT LeqProof (w + 1) w
LeqProof -> do
              Expr t (BaseBVType w)
y' <- ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
wx SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
              ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'

    | Just (SBVToInteger Expr t (BaseBVType w)
xbv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , Just Coefficient 'SemiRingInteger
yi <- SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Maybe (Coefficient 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
y
    = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv in
      if Integer
Coefficient 'SemiRingInteger
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w Bool -> Bool -> Bool
|| Integer
Coefficient 'SemiRingInteger
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
         then BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
         else ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv (Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient 'SemiRingInteger
yi)

    | Just Coefficient 'SemiRingInteger
xi <- SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Maybe (Coefficient 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x
    , Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv in
      if Integer
Coefficient 'SemiRingInteger
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w Bool -> Bool -> Bool
|| Integer
Coefficient 'SemiRingInteger
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
         then BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
         else ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv (Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient 'SemiRingInteger
xi)

    | Just (BVToInteger Expr t (BaseBVType w)
xbv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , Just Coefficient 'SemiRingInteger
yi <- SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Maybe (Coefficient 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
y
    = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv in
      if Integer
Coefficient 'SemiRingInteger
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w Bool -> Bool -> Bool
|| Integer
Coefficient 'SemiRingInteger
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
         then BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
         else ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv (Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient 'SemiRingInteger
yi)

    | Just Coefficient 'SemiRingInteger
xi <- SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Maybe (Coefficient 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x
    , Just (BVToInteger Expr t (BaseBVType w)
ybv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv in
      if Integer
Coefficient 'SemiRingInteger
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w Bool -> Bool -> Bool
|| Integer
Coefficient 'SemiRingInteger
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
         then BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
         else ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv (Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient 'SemiRingInteger
xi)

    | Bool
otherwise = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingInteger
-> (Expr t (SemiRingBase 'SemiRingInteger)
    -> Expr t (SemiRingBase 'SemiRingInteger) -> IO (BoolExpr t))
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Expr t (SemiRingBase 'SemiRingInteger)
-> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> (Expr t (SemiRingBase sr)
    -> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t BaseBoolType)
semiRingEq ExprBuilder t st fs
sym SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr (ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym) SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
y

  intLe :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
intLe ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
      -- Use abstract domains
    | Just Bool
b <- ValueRange Integer -> ValueRange Integer -> Maybe Bool
forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckLe (Expr t BaseIntegerType -> AbstractValue BaseIntegerType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x) (Expr t BaseIntegerType -> AbstractValue BaseIntegerType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y)
    = Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

      -- Check with two bitvectors.
    | Just (SBVToInteger Expr t (BaseBVType w)
xbv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y
    = do let wx :: NatRepr w
wx = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
         let wy :: NatRepr w
wy = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv
         -- Sign extend to largest bitvector and compare.
         case NatRepr w -> NatRepr w -> NatCases w w
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
wx NatRepr w
wy of
           NatCaseLT LeqProof (w + 1) w
LeqProof -> do
             Expr t (BaseBVType w)
x' <- ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
wy SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv
             ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
           NatCases w w
NatCaseEQ -> ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
           NatCaseGT LeqProof (w + 1) w
LeqProof -> do
             Expr t (BaseBVType w)
y' <- ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
wx SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
             ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'

      -- Check with two bitvectors.
    | Just (BVToInteger Expr t (BaseBVType w)
xbv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , Just (BVToInteger Expr t (BaseBVType w)
ybv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y
    = do let wx :: NatRepr w
wx = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
         let wy :: NatRepr w
wy = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv
         -- Zero extend to largest bitvector and compare.
         case NatRepr w -> NatRepr w -> NatCases w w
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
wx NatRepr w
wy of
           NatCaseLT LeqProof (w + 1) w
LeqProof -> do
             Expr t (BaseBVType w)
x' <- ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
wy SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv
             ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
           NatCases w w
NatCaseEQ -> ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
           NatCaseGT LeqProof (w + 1) w
LeqProof -> do
             Expr t (BaseBVType w)
y' <- ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
wx SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
ybv
             ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'

    | Just (SBVToInteger Expr t (BaseBVType w)
xbv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , Just Coefficient 'SemiRingInteger
yi <- SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Maybe (Coefficient 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
y
    = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv in
      if | Integer
Coefficient 'SemiRingInteger
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
         | Integer
Coefficient 'SemiRingInteger
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
         | Bool
otherwise -> IO (IO (BoolExpr t)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w))
-> IO (Expr t (BaseBVType w) -> IO (BoolExpr t))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t (BaseBVType w)
xbv IO (Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w)) -> IO (IO (BoolExpr t))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient 'SemiRingInteger
yi))

    | Just Coefficient 'SemiRingInteger
xi <- SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Maybe (Coefficient 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x
    , Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv in
      if | Integer
Coefficient 'SemiRingInteger
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
         | Integer
Coefficient 'SemiRingInteger
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
         | Bool
otherwise -> IO (IO (BoolExpr t)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w))
-> IO (Expr t (BaseBVType w) -> IO (BoolExpr t))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient 'SemiRingInteger
xi) IO (Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w)) -> IO (IO (BoolExpr t))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t (BaseBVType w)
ybv)

    | Just (BVToInteger Expr t (BaseBVType w)
xbv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , Just Coefficient 'SemiRingInteger
yi <- SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Maybe (Coefficient 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
y
    = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv in
      if | Integer
Coefficient 'SemiRingInteger
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
         | Integer
Coefficient 'SemiRingInteger
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
         | Bool
otherwise -> IO (IO (BoolExpr t)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w))
-> IO (Expr t (BaseBVType w) -> IO (BoolExpr t))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t (BaseBVType w)
xbv IO (Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w)) -> IO (IO (BoolExpr t))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient 'SemiRingInteger
yi))

    | Just Coefficient 'SemiRingInteger
xi <- SemiRingRepr 'SemiRingInteger
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Maybe (Coefficient 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x
    , Just (BVToInteger Expr t (BaseBVType w)
ybv) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv in
      if | Integer
Coefficient 'SemiRingInteger
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
         | Integer
Coefficient 'SemiRingInteger
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
         | Bool
otherwise -> IO (IO (BoolExpr t)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w))
-> IO (Expr t (BaseBVType w) -> IO (BoolExpr t))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient 'SemiRingInteger
xi) IO (Expr t (BaseBVType w) -> IO (BoolExpr t))
-> IO (Expr t (BaseBVType w)) -> IO (IO (BoolExpr t))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t (BaseBVType w)
ybv)

{-  FIXME? how important are these reductions?

      -- Compare to BV lower bound.
    | Just (SBVToInteger xbv) <- x = do
      let w = bvWidth xbv
      l <- curProgramLoc sym
      b_max <- realGe sym y (SemiRingLiteral SemiRingReal (toRational (maxSigned w)) l)
      b_min <- realGe sym y (SemiRingLiteral SemiRingReal (toRational (minSigned w)) l)
      orPred sym b_max =<< andPred sym b_min =<< (bvSle sym xbv =<< realToSBV sym w y)

      -- Compare to SBV upper bound.
    | SBVToReal ybv <- y = do
      let w = bvWidth ybv
      l <- curProgramLoc sym
      b_min <- realLe sym x (SemiRingLiteral SemiRingReal (toRational (minSigned w)) l)
      b_max <- realLe sym x (SemiRingLiteral SemiRingReal (toRational (maxSigned w)) l)
      orPred sym b_min
        =<< andPred sym b_max
        =<< (\xbv -> bvSle sym xbv ybv) =<< realToSBV sym w x
-}

    | Bool
otherwise
    = ExprBuilder t st fs
-> OrderedSemiRingRepr 'SemiRingInteger
-> (Expr t (SemiRingBase 'SemiRingInteger)
    -> Expr t (SemiRingBase 'SemiRingInteger) -> IO (BoolExpr t))
-> Expr t (SemiRingBase 'SemiRingInteger)
-> Expr t (SemiRingBase 'SemiRingInteger)
-> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> (Expr t (SemiRingBase sr)
    -> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t BaseBoolType)
semiRingLe ExprBuilder t st fs
sym OrderedSemiRingRepr 'SemiRingInteger
SR.OrderedSemiRingIntegerRepr (ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe ExprBuilder t st fs
sym) SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
x SymInteger (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingInteger)
y

  intAbs :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intAbs ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x
    | Just Integer
i <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x = ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer -> Integer
forall a. Num a => a -> a
abs Integer
i)
    | Just Bool
True <- ValueRange Integer -> ValueRange Integer -> Maybe Bool
forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckLe (Integer -> ValueRange Integer
forall tp. tp -> ValueRange tp
SingleRange Integer
0) (Expr t BaseIntegerType -> AbstractValue BaseIntegerType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x) = Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    | Just Bool
True <- ValueRange Integer -> ValueRange Integer -> Maybe Bool
forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckLe (Expr t BaseIntegerType -> AbstractValue BaseIntegerType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x) (Integer -> ValueRange Integer
forall tp. tp -> ValueRange tp
SingleRange Integer
0) = ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> IO (SymInteger sym)
intNeg ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseIntegerType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseIntegerType -> App e BaseIntegerType
IntAbs SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x)

  intDiv :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intDiv ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
      -- Div by 1.
    | Just Integer
1 <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y = Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
      -- As integers.
    | Just Integer
xi <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x, Just Integer
yi <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y, Integer
yi Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 =
      if Integer
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then
        ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
xi Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
yi)
      else
        ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer -> Integer
forall a. Num a => a -> a
negate (Integer
xi Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer -> Integer
forall a. Num a => a -> a
negate Integer
yi))
      -- Return int div
    | Bool
otherwise =
        ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseIntegerType
-> Expr t BaseIntegerType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseIntegerType -> e BaseIntegerType -> App e BaseIntegerType
IntDiv SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y)

  intMod :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intMod ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
      -- Mod by 1.
    | Just Integer
1 <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y = ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
0
      -- As integers.
    | Just Integer
xi <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x, Just Integer
yi <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y, Integer
yi Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 =
        ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
xi Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer -> Integer
forall a. Num a => a -> a
abs Integer
yi)
    | Just (SemiRingSum WeightedSum (Expr t) sr
xsum) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , SemiRingRepr sr
SR.SemiRingIntegerRepr <- WeightedSum (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
xsum
    , Just Integer
yi <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y
    , Integer
yi Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 =
        case WeightedSum (Expr t) 'SemiRingInteger
-> Integer -> WeightedSum (Expr t) 'SemiRingInteger
forall (f :: BaseType -> Type).
Tm f =>
WeightedSum f 'SemiRingInteger
-> Integer -> WeightedSum f 'SemiRingInteger
WSum.reduceIntSumMod WeightedSum (Expr t) sr
WeightedSum (Expr t) 'SemiRingInteger
xsum (Integer -> Integer
forall a. Num a => a -> a
abs Integer
yi) of
          WeightedSum (Expr t) 'SemiRingInteger
xsum' | Just Coefficient 'SemiRingInteger
xi <- WeightedSum (Expr t) 'SemiRingInteger
-> Maybe (Coefficient 'SemiRingInteger)
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) 'SemiRingInteger
xsum' ->
                    ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
Coefficient 'SemiRingInteger
xi
                | Bool
otherwise ->
                    do Expr t BaseIntegerType
x' <- ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger -> IO (IntegerExpr t)
intSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingInteger
xsum'
                       ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseIntegerType
-> Expr t BaseIntegerType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseIntegerType -> e BaseIntegerType -> App e BaseIntegerType
IntMod Expr t BaseIntegerType
x' SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y)
      -- Return int mod.
    | Bool
otherwise =
        ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseIntegerType
-> Expr t BaseIntegerType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseIntegerType -> e BaseIntegerType -> App e BaseIntegerType
IntMod SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
y)

  intDivisible :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> Natural
-> IO (Pred (ExprBuilder t st fs))
intDivisible ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x Natural
k
    | Natural
k Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0 = ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x (Expr t BaseIntegerType -> IO (BoolExpr t))
-> IO (Expr t BaseIntegerType) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
0
    | Natural
k Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
1 = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
    | Just Integer
xi <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x = Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Integer
xi Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
k) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)
    | Just (SemiRingSum WeightedSum (Expr t) sr
xsum) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x
    , SemiRingRepr sr
SR.SemiRingIntegerRepr <- WeightedSum (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
xsum =
        case WeightedSum (Expr t) 'SemiRingInteger
-> Integer -> WeightedSum (Expr t) 'SemiRingInteger
forall (f :: BaseType -> Type).
Tm f =>
WeightedSum f 'SemiRingInteger
-> Integer -> WeightedSum f 'SemiRingInteger
WSum.reduceIntSumMod WeightedSum (Expr t) sr
WeightedSum (Expr t) 'SemiRingInteger
xsum (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
k) of
          WeightedSum (Expr t) 'SemiRingInteger
xsum' | Just Coefficient 'SemiRingInteger
xi <- WeightedSum (Expr t) 'SemiRingInteger
-> Maybe (Coefficient 'SemiRingInteger)
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) 'SemiRingInteger
xsum' ->
                    Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Integer
Coefficient 'SemiRingInteger
xi Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)
                | Bool
otherwise ->
                    do Expr t BaseIntegerType
x' <- ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger
-> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingInteger -> IO (IntegerExpr t)
intSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingInteger
xsum'
                       ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseIntegerType -> Natural -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type).
e BaseIntegerType -> Natural -> App e BaseBoolType
IntDivisible Expr t BaseIntegerType
x' Natural
k)
    | Bool
otherwise =
        ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseIntegerType -> Natural -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type).
e BaseIntegerType -> Natural -> App e BaseBoolType
IntDivisible SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x Natural
k)

  ---------------------------------------------------------------------
  -- Bitvector operations

  bvLit :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
bvLit ExprBuilder t st fs
sym NatRepr w
w BV w
bv =
    ExprBuilder t st fs
-> SemiRingRepr ('SemiRingBV 'BVArith w)
-> Coefficient ('SemiRingBV 'BVArith w)
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVArith w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym (BVFlavorRepr 'BVArith
-> NatRepr w -> SemiRingRepr ('SemiRingBV 'BVArith w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr NatRepr w
w) BV w
Coefficient ('SemiRingBV 'BVArith w)
bv

  bvConcat :: forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
bvConcat ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) u
x SymBV (ExprBuilder t st fs) v
y =
    case (Expr t (BaseBVType u) -> Maybe (BV u)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x, Expr t (BaseBVType v) -> Maybe (BV v)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y) of
      -- both values are constants, just compute the concatenation
      (Just BV u
xv, Just BV v
yv) -> do
          let w' :: NatRepr (u + v)
w' = NatRepr u -> NatRepr v -> NatRepr (u + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y)
          LeqProof 1 (u + v)
LeqProof <- LeqProof 1 (u + v) -> IO (LeqProof 1 (u + v))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (NatRepr u -> NatRepr v -> LeqProof 1 (u + v)
forall (m :: Natural) (n :: Natural) (p :: Natural -> Type)
       (q :: Natural -> Type).
(1 <= m, 1 <= n) =>
p m -> q n -> LeqProof 1 (m + n)
leqAddPos (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y))
          ExprBuilder t st fs
-> NatRepr (u + v)
-> BV (u + v)
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr (u + v)
w' (NatRepr u -> NatRepr v -> BV u -> BV v -> BV (u + v)
forall (w :: Natural) (w' :: Natural).
NatRepr w -> NatRepr w' -> BV w -> BV w' -> BV (w + w')
BV.concat (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y) BV u
xv BV v
yv)
      -- reassociate to combine constants where possible
      (Just BV u
_xv, Maybe (BV v)
_)
        | Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- Expr t (BaseBVType v) -> Maybe (App (Expr t) (BaseBVType v))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y
        , Just BV u
_av <- Expr t (BaseBVType u) -> Maybe (BV u)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType u)
a
        , Just (u + v) :~: ((u + u) + v)
Refl <- NatRepr (u + v)
-> NatRepr ((u + u) + v) -> Maybe ((u + v) :~: ((u + u) + v))
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (NatRepr u -> NatRepr v -> NatRepr (u + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x) (NatRepr u -> NatRepr v -> NatRepr (u + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)))
                        (NatRepr (u + u) -> NatRepr v -> NatRepr ((u + u) + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (NatRepr u -> NatRepr u -> NatRepr (u + u)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x) (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a)) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b))
        , Just LeqProof 1 (u + u)
LeqProof <- NatRepr (u + u) -> Maybe (LeqProof 1 (u + u))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (NatRepr u -> NatRepr u -> NatRepr (u + u)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x) (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a)) -> do
            Expr t (BaseBVType (u + u))
xa <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) (u + u))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) u
x SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
a
            ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) (u + u)
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) ((u + u) + v))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) (u + u)
Expr t (BaseBVType (u + u))
xa SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
b
      -- concat two adjacent sub-selects just makes a single select
      (Maybe (BV u), Maybe (BV v))
_ | Just (BVSelect NatRepr idx
idx1 NatRepr n
n1 Expr t (BaseBVType w)
a) <- Expr t (BaseBVType u) -> Maybe (App (Expr t) (BaseBVType u))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x
        , Just (BVSelect NatRepr idx
idx2 NatRepr n
n2 Expr t (BaseBVType w)
b) <- Expr t (BaseBVType v) -> Maybe (App (Expr t) (BaseBVType v))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y
        , Just BaseBVType w :~: BaseBVType w
Refl <- Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (BaseBVType w :~: BaseBVType w)
forall t (a :: BaseType) (b :: BaseType).
Expr t a -> Expr t b -> Maybe (a :~: b)
sameTerm Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b
        , Just idx :~: (idx + v)
Refl <- NatRepr idx -> NatRepr (idx + v) -> Maybe (idx :~: (idx + v))
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr idx
idx1 (NatRepr idx -> NatRepr n -> NatRepr (idx + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx2 NatRepr n
n2)
        , Just LeqProof 1 (u + v)
LeqProof <- NatRepr (u + v) -> Maybe (LeqProof 1 (u + v))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (NatRepr n -> NatRepr n -> NatRepr (n + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr n
n1 NatRepr n
n2)
        , Just LeqProof (idx + (u + v)) w
LeqProof <- NatRepr (idx + (u + v))
-> NatRepr w -> Maybe (LeqProof (idx + (u + v)) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr idx -> NatRepr (u + v) -> NatRepr (idx + (u + v))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx2 (NatRepr n -> NatRepr n -> NatRepr (n + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr n
n1 NatRepr n
n2)) (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
a) ->
            ExprBuilder t st fs
-> NatRepr idx
-> NatRepr (u + v)
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sym NatRepr idx
idx2 (NatRepr n -> NatRepr n -> NatRepr (n + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr n
n1 NatRepr n
n2) SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
a
      -- always reassociate to the right
      (Maybe (BV u), Maybe (BV v))
_ | Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- Expr t (BaseBVType u) -> Maybe (App (Expr t) (BaseBVType u))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x
        , Just BV v
_bv <- Expr t (BaseBVType v) -> Maybe (BV v)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType v)
b
        , Just (u + (v + v)) :~: (u + v)
Refl <- NatRepr (u + (v + v))
-> NatRepr (u + v) -> Maybe ((u + (v + v)) :~: (u + v))
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (NatRepr u -> NatRepr (v + v) -> NatRepr (u + (v + v))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) (NatRepr v -> NatRepr v -> NatRepr (v + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y)))
                        (NatRepr u -> NatRepr v -> NatRepr (u + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (NatRepr u -> NatRepr v -> NatRepr (u + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y))
        , Just LeqProof 1 (v + v)
LeqProof <- NatRepr (v + v) -> Maybe (LeqProof 1 (v + v))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (NatRepr v -> NatRepr v -> NatRepr (v + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y)) -> do
            Expr t (BaseBVType (v + v))
by <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) v
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (v + v))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
b SymBV (ExprBuilder t st fs) v
y
            ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) (v + v)
-> IO (SymBV (ExprBuilder t st fs) (u + (v + v)))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
a SymBV (ExprBuilder t st fs) (v + v)
Expr t (BaseBVType (v + v))
by
      -- no special case applies, emit a basic concat expression
      (Maybe (BV u), Maybe (BV v))
_ -> do
        let wx :: NatRepr u
wx = Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x
        let wy :: NatRepr v
wy = Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y
        Just LeqProof 1 (u + v)
LeqProof <- Maybe (LeqProof 1 (u + v)) -> IO (Maybe (LeqProof 1 (u + v)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (NatRepr (u + v) -> Maybe (LeqProof 1 (u + v))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (NatRepr u -> NatRepr v -> NatRepr (u + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr u
wx NatRepr v
wy))
        ExprBuilder t st fs
-> App (Expr t) ('BaseBVType (u + v))
-> IO (Expr t ('BaseBVType (u + v)))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseBVType (u + v))
 -> IO (Expr t ('BaseBVType (u + v))))
-> App (Expr t) ('BaseBVType (u + v))
-> IO (Expr t ('BaseBVType (u + v)))
forall a b. (a -> b) -> a -> b
$ NatRepr (u + v)
-> Expr t (BaseBVType u)
-> Expr t (BaseBVType v)
-> App (Expr t) ('BaseBVType (u + v))
forall (u :: Natural) (v :: Natural) (e :: BaseType -> Type).
(1 <= u, 1 <= v, 1 <= (u + v)) =>
NatRepr (u + v)
-> e (BaseBVType u)
-> e (BaseBVType v)
-> App e ('BaseBVType (u + v))
BVConcat (NatRepr u -> NatRepr v -> NatRepr (u + v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr u
wx NatRepr v
wy) SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
y

  -- bvSelect has a bunch of special cases that examine the form of the
  -- bitvector being selected from.  This can significantly reduce the size
  -- of expressions that result from the very verbose packing and unpacking
  -- operations that arise from byte-oriented memory models.
  bvSelect :: forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr n
n SymBV (ExprBuilder t st fs) w
x
    | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = do
      ExprBuilder t st fs
-> NatRepr n -> BV n -> IO (SymBV (ExprBuilder t st fs) n)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr n
n (NatRepr idx -> NatRepr n -> BV w -> BV n
forall (ix :: Natural) (w' :: Natural) (w :: Natural).
((ix + w') <= w) =>
NatRepr ix -> NatRepr w' -> BV w -> BV w'
BV.select NatRepr idx
idx NatRepr n
n BV w
xv)

      -- nested selects can be collapsed
    | Just (BVSelect NatRepr idx
idx' NatRepr n
_n' Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , let idx2 :: NatRepr (idx + idx)
idx2 = NatRepr idx -> NatRepr idx -> NatRepr (idx + idx)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr idx
idx'
    , Just LeqProof ((idx + idx) + n) w
LeqProof <- NatRepr ((idx + idx) + n)
-> NatRepr w -> Maybe (LeqProof ((idx + idx) + n) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr (idx + idx) -> NatRepr n -> NatRepr ((idx + idx) + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (idx + idx)
idx2 NatRepr n
n) (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b) =
      ExprBuilder t st fs
-> NatRepr (idx + idx)
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr (idx + idx)
idx2 NatRepr n
n SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b

      -- select the entire bitvector is the identity function
    | Just idx :~: 0
_ <- NatRepr idx -> NatRepr 0 -> Maybe (idx :~: 0)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr idx
idx (NatRepr 0
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 0)
    , Just n :~: w
Refl <- NatRepr n -> NatRepr w -> Maybe (n :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr n
n (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) =
      Expr t (BaseBVType n) -> IO (Expr t (BaseBVType n))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType n)
x

    | Just (BVShl NatRepr w
w Expr t ('BaseBVType w)
a Expr t ('BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just BV w
diff <- Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
    , Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof x idx
LeqProof <- NatRepr x -> NatRepr idx -> Maybe (LeqProof x idx)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr x
diffRepr NatRepr idx
idx = do
      Just LeqProof ((idx - x) + n) w
LeqProof <- Maybe (LeqProof ((idx - x) + n) w)
-> IO (Maybe (LeqProof ((idx - x) + n) w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof ((idx - x) + n) w)
 -> IO (Maybe (LeqProof ((idx - x) + n) w)))
-> Maybe (LeqProof ((idx - x) + n) w)
-> IO (Maybe (LeqProof ((idx - x) + n) w))
forall a b. (a -> b) -> a -> b
$ NatRepr ((idx - x) + n)
-> NatRepr w -> Maybe (LeqProof ((idx - x) + n) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr (idx - x) -> NatRepr n -> NatRepr ((idx - x) + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (NatRepr idx -> NatRepr x -> NatRepr (idx - x)
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n) NatRepr w
w
      ExprBuilder t st fs
-> NatRepr (idx - x)
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb (NatRepr idx -> NatRepr x -> NatRepr (idx - x)
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
a

    | Just (BVShl NatRepr w
_w Expr t ('BaseBVType w)
_a Expr t ('BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just BV w
diff <- Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
    , Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof (idx + n) x
LeqProof <- NatRepr (idx + n) -> NatRepr x -> Maybe (LeqProof (idx + n) x)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr idx -> NatRepr n -> NatRepr (idx + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) NatRepr x
diffRepr =
      ExprBuilder t st fs
-> NatRepr n -> BV n -> IO (SymBV (ExprBuilder t st fs) n)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr n
n (NatRepr n -> BV n
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr n
n)

    | Just (BVAshr NatRepr w
w Expr t ('BaseBVType w)
a Expr t ('BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just BV w
diff <- Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
    , Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof ((idx + x) + n) w
LeqProof <- NatRepr ((idx + x) + n)
-> NatRepr w -> Maybe (LeqProof ((idx + x) + n) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr (idx + x) -> NatRepr n -> NatRepr ((idx + x) + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (NatRepr idx -> NatRepr x -> NatRepr (idx + x)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n) NatRepr w
w =
      ExprBuilder t st fs
-> NatRepr (idx + x)
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb (NatRepr idx -> NatRepr x -> NatRepr (idx + x)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
a

    | Just (BVLshr NatRepr w
w Expr t ('BaseBVType w)
a Expr t ('BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just BV w
diff <- Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
    , Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof ((idx + x) + n) w
LeqProof <- NatRepr ((idx + x) + n)
-> NatRepr w -> Maybe (LeqProof ((idx + x) + n) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr (idx + x) -> NatRepr n -> NatRepr ((idx + x) + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (NatRepr idx -> NatRepr x -> NatRepr (idx + x)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n) NatRepr w
w =
      ExprBuilder t st fs
-> NatRepr (idx + x)
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb (NatRepr idx -> NatRepr x -> NatRepr (idx + x)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
a

    | Just (BVLshr NatRepr w
w Expr t ('BaseBVType w)
_a Expr t ('BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just BV w
diff <- Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
    , Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof w (idx + x)
LeqProof <- NatRepr w -> NatRepr (idx + x) -> Maybe (LeqProof w (idx + x))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr w
w (NatRepr idx -> NatRepr x -> NatRepr (idx + x)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) =
      ExprBuilder t st fs
-> NatRepr n -> BV n -> IO (SymBV (ExprBuilder t st fs) n)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr n
n (NatRepr n -> BV n
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr n
n)

      -- select from a sign extension
    | Just (BVSext NatRepr r
w Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = do
      -- Add dynamic check
      Just LeqProof w r
LeqProof <- Maybe (LeqProof w r) -> IO (Maybe (LeqProof w r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof w r) -> IO (Maybe (LeqProof w r)))
-> Maybe (LeqProof w r) -> IO (Maybe (LeqProof w r))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> NatRepr r -> Maybe (LeqProof w r)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b) NatRepr r
w
      let ext :: NatRepr (r - w)
ext = NatRepr r -> NatRepr w -> NatRepr (r - w)
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr r
w (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b)
      -- Add dynamic check
      Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Maybe (LeqProof 1 r)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
      Just LeqProof 1 (w - w)
LeqProof <- Maybe (LeqProof 1 (w - w)) -> IO (Maybe (LeqProof 1 (w - w)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 (w - w)) -> IO (Maybe (LeqProof 1 (w - w))))
-> Maybe (LeqProof 1 (w - w)) -> IO (Maybe (LeqProof 1 (w - w)))
forall a b. (a -> b) -> a -> b
$ NatRepr (w - w) -> Maybe (LeqProof 1 (w - w))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (w - w)
NatRepr (r - w)
ext
      Expr t (BaseBVType (w - w))
zeros <- ExprBuilder t st fs
-> NatRepr (w - w) -> IO (SymBV (ExprBuilder t st fs) (w - w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> IO (SymBV sym w)
minUnsignedBV ExprBuilder t st fs
sb NatRepr (w - w)
NatRepr (r - w)
ext
      Expr t (BaseBVType (w - w))
ones  <- ExprBuilder t st fs
-> NatRepr (w - w) -> IO (SymBV (ExprBuilder t st fs) (w - w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> IO (SymBV sym w)
maxUnsignedBV ExprBuilder t st fs
sb NatRepr (w - w)
NatRepr (r - w)
ext
      BoolExpr t
c     <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNeg ExprBuilder t st fs
sb SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b
      Expr t (BaseBVType (w - w))
hi    <- ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) (w - w)
-> SymBV (ExprBuilder t st fs) (w - w)
-> IO (SymBV (ExprBuilder t st fs) (w - w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
BoolExpr t
c SymBV (ExprBuilder t st fs) (w - w)
Expr t (BaseBVType (w - w))
ones SymBV (ExprBuilder t st fs) (w - w)
Expr t (BaseBVType (w - w))
zeros
      Expr t (BaseBVType ((w - w) + w))
x'    <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) (w - w)
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) ((w - w) + w))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sb SymBV (ExprBuilder t st fs) (w - w)
Expr t (BaseBVType (w - w))
hi SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b
      -- Add dynamic check
      Just LeqProof (idx + n) ((w - w) + w)
LeqProof <- Maybe (LeqProof (idx + n) ((w - w) + w))
-> IO (Maybe (LeqProof (idx + n) ((w - w) + w)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof (idx + n) ((w - w) + w))
 -> IO (Maybe (LeqProof (idx + n) ((w - w) + w))))
-> Maybe (LeqProof (idx + n) ((w - w) + w))
-> IO (Maybe (LeqProof (idx + n) ((w - w) + w)))
forall a b. (a -> b) -> a -> b
$ NatRepr (idx + n)
-> NatRepr ((w - w) + w)
-> Maybe (LeqProof (idx + n) ((w - w) + w))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr idx -> NatRepr n -> NatRepr (idx + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) (NatRepr (w - w) -> NatRepr w -> NatRepr ((w - w) + w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
NatRepr (r - w)
ext (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b))
      ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) ((w - w) + w)
-> IO (SymBV (ExprBuilder t st fs) n)
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr n
n SymBV (ExprBuilder t st fs) ((w - w) + w)
Expr t (BaseBVType ((w - w) + w))
x'

      -- select from a zero extension
    | Just (BVZext NatRepr r
w Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = do
      -- Add dynamic check
      Just LeqProof w r
LeqProof <- Maybe (LeqProof w r) -> IO (Maybe (LeqProof w r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof w r) -> IO (Maybe (LeqProof w r)))
-> Maybe (LeqProof w r) -> IO (Maybe (LeqProof w r))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> NatRepr r -> Maybe (LeqProof w r)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b) NatRepr r
w
      let ext :: NatRepr (r - w)
ext = NatRepr r -> NatRepr w -> NatRepr (r - w)
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr r
w (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b)
      Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Maybe (LeqProof 1 r)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
      Just LeqProof 1 (w - w)
LeqProof <- Maybe (LeqProof 1 (w - w)) -> IO (Maybe (LeqProof 1 (w - w)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 (w - w)) -> IO (Maybe (LeqProof 1 (w - w))))
-> Maybe (LeqProof 1 (w - w)) -> IO (Maybe (LeqProof 1 (w - w)))
forall a b. (a -> b) -> a -> b
$ NatRepr (w - w) -> Maybe (LeqProof 1 (w - w))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (w - w)
NatRepr (r - w)
ext
      Expr t (BaseBVType (w - w))
hi    <- ExprBuilder t st fs
-> NatRepr (w - w)
-> BV (w - w)
-> IO (SymBV (ExprBuilder t st fs) (w - w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr (w - w)
NatRepr (r - w)
ext (NatRepr (w - w) -> BV (w - w)
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr (w - w)
NatRepr (r - w)
ext)
      Expr t (BaseBVType ((w - w) + w))
x'    <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) (w - w)
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) ((w - w) + w))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sb SymBV (ExprBuilder t st fs) (w - w)
Expr t (BaseBVType (w - w))
hi SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b
      -- Add dynamic check
      Just LeqProof (idx + n) ((w - w) + w)
LeqProof <- Maybe (LeqProof (idx + n) ((w - w) + w))
-> IO (Maybe (LeqProof (idx + n) ((w - w) + w)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof (idx + n) ((w - w) + w))
 -> IO (Maybe (LeqProof (idx + n) ((w - w) + w))))
-> Maybe (LeqProof (idx + n) ((w - w) + w))
-> IO (Maybe (LeqProof (idx + n) ((w - w) + w)))
forall a b. (a -> b) -> a -> b
$ NatRepr (idx + n)
-> NatRepr ((w - w) + w)
-> Maybe (LeqProof (idx + n) ((w - w) + w))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr idx -> NatRepr n -> NatRepr (idx + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) (NatRepr (w - w) -> NatRepr w -> NatRepr ((w - w) + w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
NatRepr (r - w)
ext (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b))
      ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) ((w - w) + w)
-> IO (SymBV (ExprBuilder t st fs) n)
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr n
n SymBV (ExprBuilder t st fs) ((w - w) + w)
Expr t (BaseBVType ((w - w) + w))
x'

      -- select is entirely within the less-significant bits of a concat
    | Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
_a Expr t (BaseBVType v)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just LeqProof (idx + n) v
LeqProof <- NatRepr (idx + n) -> NatRepr v -> Maybe (LeqProof (idx + n) v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr idx -> NatRepr n -> NatRepr (idx + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) = do
      ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) n)
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr n
n SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
b

      -- select is entirely within the more-significant bits of a concat
    | Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just LeqProof v idx
LeqProof <- NatRepr v -> NatRepr idx -> Maybe (LeqProof v idx)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) NatRepr idx
idx
    , Just LeqProof 1 idx
LeqProof <- NatRepr idx -> Maybe (LeqProof 1 idx)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr idx
idx
    , let diff :: NatRepr (idx - v)
diff = NatRepr idx -> NatRepr v -> NatRepr (idx - v)
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr idx
idx (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)
    , Just LeqProof ((idx - v) + n) u
LeqProof <- NatRepr ((idx - v) + n)
-> NatRepr u -> Maybe (LeqProof ((idx - v) + n) u)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr (idx - v) -> NatRepr n -> NatRepr ((idx - v) + n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (idx - v)
diff NatRepr n
n) (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) = do
      ExprBuilder t st fs
-> NatRepr (idx - v)
-> NatRepr n
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) n)
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb (NatRepr idx -> NatRepr v -> NatRepr (idx - v)
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr idx
idx (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)) NatRepr n
n SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
a

    -- when the selected region overlaps a concat boundary we have:
    --  select idx n (concat a b) =
    --      concat (select 0 n1 a) (select idx n2 b)
    --   where n1 + n2 = n and idx + n2 = width b
    --
    -- NB: this case must appear after the two above that check for selects
    --     entirely within the first or second arguments of a concat, otherwise
    --     some of the arithmetic checks below may fail
    | Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = do
      Just LeqProof idx v
LeqProof <- Maybe (LeqProof idx v) -> IO (Maybe (LeqProof idx v))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof idx v) -> IO (Maybe (LeqProof idx v)))
-> Maybe (LeqProof idx v) -> IO (Maybe (LeqProof idx v))
forall a b. (a -> b) -> a -> b
$ NatRepr idx -> NatRepr v -> Maybe (LeqProof idx v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr idx
idx (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)
      let n2 :: NatRepr (v - idx)
n2 = NatRepr v -> NatRepr idx -> NatRepr (v - idx)
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) NatRepr idx
idx
      Just LeqProof (v - idx) n
LeqProof <- Maybe (LeqProof (v - idx) n) -> IO (Maybe (LeqProof (v - idx) n))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof (v - idx) n) -> IO (Maybe (LeqProof (v - idx) n)))
-> Maybe (LeqProof (v - idx) n)
-> IO (Maybe (LeqProof (v - idx) n))
forall a b. (a -> b) -> a -> b
$ NatRepr (v - idx) -> NatRepr n -> Maybe (LeqProof (v - idx) n)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr (v - idx)
n2 NatRepr n
n
      let n1 :: NatRepr (n - (v - idx))
n1 = NatRepr n -> NatRepr (v - idx) -> NatRepr (n - (v - idx))
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr n
n NatRepr (v - idx)
n2
      let z :: NatRepr 0
z  = NatRepr 0
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 0

      Just LeqProof 1 (n - (v - idx))
LeqProof <- Maybe (LeqProof 1 (n - (v - idx)))
-> IO (Maybe (LeqProof 1 (n - (v - idx))))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 (n - (v - idx)))
 -> IO (Maybe (LeqProof 1 (n - (v - idx)))))
-> Maybe (LeqProof 1 (n - (v - idx)))
-> IO (Maybe (LeqProof 1 (n - (v - idx))))
forall a b. (a -> b) -> a -> b
$ NatRepr (n - (v - idx)) -> Maybe (LeqProof 1 (n - (v - idx)))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (n - (v - idx))
n1
      Just LeqProof (n - (v - idx)) u
LeqProof <- Maybe (LeqProof (n - (v - idx)) u)
-> IO (Maybe (LeqProof (n - (v - idx)) u))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof (n - (v - idx)) u)
 -> IO (Maybe (LeqProof (n - (v - idx)) u)))
-> Maybe (LeqProof (n - (v - idx)) u)
-> IO (Maybe (LeqProof (n - (v - idx)) u))
forall a b. (a -> b) -> a -> b
$ NatRepr (n - (v - idx))
-> NatRepr u -> Maybe (LeqProof (n - (v - idx)) u)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr 0
-> NatRepr (n - (v - idx)) -> NatRepr (0 + (n - (v - idx)))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr 0
z NatRepr (n - (v - idx))
n1) (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a)
      Expr t (BaseBVType (n - (v - idx)))
a' <- ExprBuilder t st fs
-> NatRepr 0
-> NatRepr (n - (v - idx))
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) (n - (v - idx)))
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr 0
z   NatRepr (n - (v - idx))
n1 SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
a

      Just LeqProof 1 (v - idx)
LeqProof <- Maybe (LeqProof 1 (v - idx)) -> IO (Maybe (LeqProof 1 (v - idx)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 (v - idx)) -> IO (Maybe (LeqProof 1 (v - idx))))
-> Maybe (LeqProof 1 (v - idx))
-> IO (Maybe (LeqProof 1 (v - idx)))
forall a b. (a -> b) -> a -> b
$ NatRepr (v - idx) -> Maybe (LeqProof 1 (v - idx))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (v - idx)
n2
      Just LeqProof (idx + (v - idx)) v
LeqProof <- Maybe (LeqProof (idx + (v - idx)) v)
-> IO (Maybe (LeqProof (idx + (v - idx)) v))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof (idx + (v - idx)) v)
 -> IO (Maybe (LeqProof (idx + (v - idx)) v)))
-> Maybe (LeqProof (idx + (v - idx)) v)
-> IO (Maybe (LeqProof (idx + (v - idx)) v))
forall a b. (a -> b) -> a -> b
$ NatRepr (idx + (v - idx))
-> NatRepr v -> Maybe (LeqProof (idx + (v - idx)) v)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr idx -> NatRepr (v - idx) -> NatRepr (idx + (v - idx))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr (v - idx)
n2) (Expr t (BaseBVType v) -> NatRepr v
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)
      Expr t (BaseBVType (v - idx))
b' <- ExprBuilder t st fs
-> NatRepr idx
-> NatRepr (v - idx)
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (v - idx))
forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr (v - idx)
n2 SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
b

      Just ((n - (v - idx)) + (v - idx)) :~: n
Refl <- Maybe (((n - (v - idx)) + (v - idx)) :~: n)
-> IO (Maybe (((n - (v - idx)) + (v - idx)) :~: n))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (((n - (v - idx)) + (v - idx)) :~: n)
 -> IO (Maybe (((n - (v - idx)) + (v - idx)) :~: n)))
-> Maybe (((n - (v - idx)) + (v - idx)) :~: n)
-> IO (Maybe (((n - (v - idx)) + (v - idx)) :~: n))
forall a b. (a -> b) -> a -> b
$ NatRepr ((n - (v - idx)) + (v - idx))
-> NatRepr n -> Maybe (((n - (v - idx)) + (v - idx)) :~: n)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (NatRepr (n - (v - idx))
-> NatRepr (v - idx) -> NatRepr ((n - (v - idx)) + (v - idx))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (n - (v - idx))
n1 NatRepr (v - idx)
n2) NatRepr n
n
      ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) (n - (v - idx))
-> SymBV (ExprBuilder t st fs) (v - idx)
-> IO (SymBV (ExprBuilder t st fs) ((n - (v - idx)) + (v - idx)))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sb SymBV (ExprBuilder t st fs) (n - (v - idx))
Expr t (BaseBVType (n - (v - idx)))
a' SymBV (ExprBuilder t st fs) (v - idx)
Expr t (BaseBVType (v - idx))
b'

    -- Truncate a weighted sum: Remove terms with coefficients that
    -- would become zero after truncation.
    --
    -- Truncation of w-bit words down to n bits respects congruence
    -- modulo 2^n. Furthermore, w-bit addition and multiplication also
    -- preserve congruence modulo 2^n. This means that it is sound to
    -- replace coefficients in a weighted sum with new masked ones
    -- that are congruent modulo 2^n: the final result after
    -- truncation will be the same.
    --
    -- NOTE: This case is carefully designed to preserve sharing. Only
    -- one App node (the SemiRingSum) is ever deconstructed. The
    -- 'traverseCoeffs' call does not touch any other App nodes inside
    -- the WeightedSum. Finally, we only reconstruct a new SemiRingSum
    -- App node in the event that one of the coefficients has changed;
    -- the writer monad tracks whether a change has occurred.
    | Just (SemiRingSum WeightedSum (Expr t) sr
s) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVArithRepr NatRepr w
w <- WeightedSum (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s
    , Just idx :~: 0
Refl <- NatRepr idx -> NatRepr 0 -> Maybe (idx :~: 0)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr idx
idx (NatRepr 0
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 0) =
      do let mask :: BV w
mask = case NatRepr n -> NatRepr w -> Either (LeqProof (n + 1) w) (n :~: w)
forall (m :: Natural) (n :: Natural).
(m <= n) =>
NatRepr m -> NatRepr n -> Either (LeqProof (m + 1) n) (m :~: n)
testStrictLeq NatRepr n
n NatRepr w
w of
               Left LeqProof (n + 1) w
LeqProof -> NatRepr w -> BV n -> BV w
forall (w :: Natural) (w' :: Natural).
((w + 1) <= w') =>
NatRepr w' -> BV w -> BV w'
BV.zext NatRepr w
w (NatRepr n -> BV n
forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr n
n)
               Right n :~: w
Refl -> NatRepr n -> BV n
forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr n
n
         let reduce :: BV w -> WriterT Any Identity (BV w)
reduce BV w
i
               | BV w
i BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
`BV.and` BV w
mask BV w -> BV w -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w = (BV w, Any) -> WriterT Any Identity (BV w)
forall (m :: Type -> Type) a w. Monad m => (a, w) -> WriterT w m a
writer (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w, Bool -> Any
Any Bool
True)
               | Bool
otherwise                    = (BV w, Any) -> WriterT Any Identity (BV w)
forall (m :: Type -> Type) a w. Monad m => (a, w) -> WriterT w m a
writer (BV w
i, Bool -> Any
Any Bool
False)
         let (WeightedSum (Expr t) sr
s', Any Bool
changed) = Writer Any (WeightedSum (Expr t) sr)
-> (WeightedSum (Expr t) sr, Any)
forall w a. Writer w a -> (a, w)
runWriter (Writer Any (WeightedSum (Expr t) sr)
 -> (WeightedSum (Expr t) sr, Any))
-> Writer Any (WeightedSum (Expr t) sr)
-> (WeightedSum (Expr t) sr, Any)
forall a b. (a -> b) -> a -> b
$ (Coefficient sr -> WriterT Any Identity (Coefficient sr))
-> WeightedSum (Expr t) sr -> Writer Any (WeightedSum (Expr t) sr)
forall (m :: Type -> Type) (f :: BaseType -> Type)
       (sr :: SemiRing).
(Applicative m, Tm f) =>
(Coefficient sr -> m (Coefficient sr))
-> WeightedSum f sr -> m (WeightedSum f sr)
WSum.traverseCoeffs BV w -> WriterT Any Identity (BV w)
Coefficient sr -> WriterT Any Identity (Coefficient sr)
reduce WeightedSum (Expr t) sr
s
         Expr t (BaseBVType w)
x' <- if Bool
changed then ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (WeightedSum (Expr t) sr -> App (Expr t) (SemiRingBase sr)
forall (e :: BaseType -> Type) (sr :: SemiRing).
WeightedSum e sr -> App e (SemiRingBase sr)
SemiRingSum WeightedSum (Expr t) sr
s') else Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
         ExprBuilder t st fs
-> App (Expr t) (BaseBVType n) -> IO (Expr t (BaseBVType n))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (App (Expr t) (BaseBVType n) -> IO (Expr t (BaseBVType n)))
-> App (Expr t) (BaseBVType n) -> IO (Expr t (BaseBVType n))
forall a b. (a -> b) -> a -> b
$ NatRepr idx
-> NatRepr n
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseBVType n)
forall (n :: Natural) (idx :: Natural) (w :: Natural)
       (e :: BaseType -> Type).
(1 <= n, (idx + n) <= w) =>
NatRepr idx
-> NatRepr n -> e (BaseBVType w) -> App e ('BaseBVType n)
BVSelect NatRepr idx
idx NatRepr n
n Expr t (BaseBVType w)
x'

{-  Avoid doing work that may lose sharing...

    -- Select from a weighted XOR: push down through the sum
    | Just (SemiRingSum s) <- asApp x
    , SR.SemiRingBVRepr SR.BVBitsRepr _w <- WSum.sumRepr s
    = do let mask = maxUnsigned n
         let shft = fromIntegral (natValue idx)
         s' <- WSum.transformSum (SR.SemiRingBVRepr SR.BVBitsRepr n)
                 (\c -> return ((c `Bits.shiftR` shft)  Bits..&. mask))
                 (bvSelect sb idx n)
                 s
         semiRingSum sb s'

    -- Select from a AND: push down through the AND
    | Just (SemiRingProd pd) <- asApp x
    , SR.SemiRingBVRepr SR.BVBitsRepr _w <- WSum.prodRepr pd
    = do pd' <- WSum.prodEvalM
                   (bvAndBits sb)
                   (bvSelect sb idx n)
                   pd
         maybe (bvLit sb n (maxUnsigned n)) return pd'

    -- Select from an OR: push down through the OR
    | Just (BVOrBits pd) <- asApp x
    = do pd' <- WSum.prodEvalM
                   (bvOrBits sb)
                   (bvSelect sb idx n)
                   pd
         maybe (bvLit sb n 0) return pd'
-}

    -- Truncate from a unary bitvector
    | Just (BVUnaryTerm UnaryBV (BoolExpr t) n
u) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just idx :~: 0
Refl <- NatRepr idx -> NatRepr 0 -> Maybe (idx :~: 0)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr idx
idx (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @0) =
      ExprBuilder t st fs
-> UnaryBV (BoolExpr t) n -> IO (Expr t (BaseBVType n))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sb (UnaryBV (BoolExpr t) n -> IO (Expr t (BaseBVType n)))
-> IO (UnaryBV (BoolExpr t) n) -> IO (Expr t (BaseBVType n))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) n
-> NatRepr n
-> IO (UnaryBV (Pred (ExprBuilder t st fs)) n)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, u <= r) =>
sym
-> UnaryBV (Pred sym) r -> NatRepr u -> IO (UnaryBV (Pred sym) u)
UnaryBV.trunc ExprBuilder t st fs
sb UnaryBV (Pred (ExprBuilder t st fs)) n
UnaryBV (BoolExpr t) n
u NatRepr n
n

      -- if none of the above apply, produce a basic select term
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseBVType n) -> IO (Expr t (BaseBVType n))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (App (Expr t) (BaseBVType n) -> IO (Expr t (BaseBVType n)))
-> App (Expr t) (BaseBVType n) -> IO (Expr t (BaseBVType n))
forall a b. (a -> b) -> a -> b
$ NatRepr idx
-> NatRepr n
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseBVType n)
forall (n :: Natural) (idx :: Natural) (w :: Natural)
       (e :: BaseType -> Type).
(1 <= n, (idx + n) <= w) =>
NatRepr idx
-> NatRepr n -> e (BaseBVType w) -> App e ('BaseBVType n)
BVSelect NatRepr idx
idx NatRepr n
n SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x

  testBitBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
testBitBV ExprBuilder t st fs
sym Natural
i SymBV (ExprBuilder t st fs) w
y
    | Natural
i Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
< Natural
0 Bool -> Bool -> Bool
|| Natural
i Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) =
      String -> IO (Pred (ExprBuilder t st fs))
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> IO (Pred (ExprBuilder t st fs)))
-> String -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ String
"Illegal bit index."

      -- Constant evaluation
    | Just BV w
yc <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    , Natural
i Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Natural -> BV w -> Bool
forall (w :: Natural). Natural -> BV w -> Bool
BV.testBit' (Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
i) BV w
yc)

    | Just (BVZext NatRepr r
_w Expr t (BaseBVType w)
y') <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    = if Natural
i Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y') then
        Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym
      else
        ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'

    | Just (BVSext NatRepr r
_w Expr t (BaseBVType w)
y') <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    = if Natural
i Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
>= NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y') then
        ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym (NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y') Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1) SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'
      else
        ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'

    | Just (BVFill NatRepr w
_ BoolExpr t
p) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
p

    | Just Bool
b <- NatRepr w -> BVDomain w -> Natural -> Maybe Bool
forall (w :: Natural).
NatRepr w -> BVDomain w -> Natural -> Maybe Bool
BVD.testBit (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) Natural
i
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

    | Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ BoolExpr t
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    , Maybe (BV w) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a) Bool -> Bool -> Bool
|| Maybe (BV w) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b) -- NB avoid losing sharing
    = do BoolExpr t
a' <- ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
a
         BoolExpr t
b' <- ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b
         ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c Pred (ExprBuilder t st fs)
BoolExpr t
a' Pred (ExprBuilder t st fs)
BoolExpr t
b'

{- These rewrites can sometimes yield significant simplifications, but
   also may lead to loss of sharing, so they are disabled...

    | Just ws <- asSemiRingSum (SR.SemiRingBVRepr SR.BVBitsRepr (bvWidth y)) y
    = let smul c x
           | Bits.testBit c (fromIntegral i) = testBitBV sym i x
           | otherwise                       = return (falsePred sym)
          cnst c = return $! backendPred sym (Bits.testBit c (fromIntegral i))
       in WSum.evalM (xorPred sym) smul cnst ws

    | Just pd <- asSemiRingProd (SR.SemiRingBVRepr SR.BVBitsRepr (bvWidth y)) y
    = fromMaybe (truePred sym) <$> WSum.prodEvalM (andPred sym) (testBitBV sym i) pd

    | Just (BVOrBits pd) <- asApp y
    = fromMaybe (falsePred sym) <$> WSum.prodEvalM (orPred sym) (testBitBV sym i) pd
-}

    | Bool
otherwise = ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ Natural -> Expr t (BaseBVType w) -> App (Expr t) BaseBoolType
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
Natural -> e (BaseBVType w) -> App e BaseBoolType
BVTestBit Natural
i SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

  bvFill :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w
-> Pred (ExprBuilder t st fs)
-> IO (SymBV (ExprBuilder t st fs) w)
bvFill ExprBuilder t st fs
sym NatRepr w
w Pred (ExprBuilder t st fs)
p
    | Just Bool
True  <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
p = ExprBuilder t st fs
-> NatRepr w
-> BV w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr w
w)
    | Just Bool
False <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
p = ExprBuilder t st fs
-> NatRepr w -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero ExprBuilder t st fs
sym NatRepr w
w
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BoolExpr t -> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e BaseBoolType -> App e ('BaseBVType w)
BVFill NatRepr w
w Pred (ExprBuilder t st fs)
BoolExpr t
p

  bvIte :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
    | Just (BVFill NatRepr w
w BoolExpr t
px) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just (BVFill NatRepr w
_w BoolExpr t
py) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y =
      do BoolExpr t
z <- ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
BoolExpr t
px Pred (ExprBuilder t st fs)
BoolExpr t
py
         ExprBuilder t st fs
-> NatRepr w
-> Pred (ExprBuilder t st fs)
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w
-> Pred (ExprBuilder t st fs)
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> Pred sym -> IO (SymBV sym w)
bvFill ExprBuilder t st fs
sym NatRepr w
w Pred (ExprBuilder t st fs)
BoolExpr t
z

    | Just (BVZext NatRepr r
w  Expr t (BaseBVType w)
x') <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just (BVZext NatRepr r
w' Expr t (BaseBVType w)
y') <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    , Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
x') (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y')
    , Just r :~: r
Refl <- NatRepr r -> NatRepr r -> Maybe (r :~: r)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr r
w NatRepr r
w' =
      do Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'
         ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) r)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr r
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

    | Just (BVSext NatRepr r
w  Expr t (BaseBVType w)
x') <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just (BVSext NatRepr r
w' Expr t (BaseBVType w)
y') <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    , Just w :~: w
Refl <- NatRepr w -> NatRepr w -> Maybe (w :~: w)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
x') (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y')
    , Just r :~: r
Refl <- NatRepr r -> NatRepr r -> Maybe (r :~: r)
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr r
w NatRepr r
w' =
      do Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'
         ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) r)
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr r
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

    | Just (FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp1 Expr t (BaseFloatType (FloatingPointPrecision eb sb))
x') <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just (FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp2 Expr t (BaseFloatType (FloatingPointPrecision eb sb))
y') <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    , Just FloatingPointPrecision eb sb :~: FloatingPointPrecision eb sb
Refl <- FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> Maybe
     (FloatingPointPrecision eb sb :~: FloatingPointPrecision eb sb)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: FloatPrecision) (b :: FloatPrecision).
FloatPrecisionRepr a -> FloatPrecisionRepr b -> Maybe (a :~: b)
testEquality FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp1 FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp2 =
      ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
-> IO (SymBV (ExprBuilder t st fs) (eb + sb))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
-> IO (SymBV (ExprBuilder t st fs) (eb + sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st fs
sym (Expr t (BaseFloatType (FloatingPointPrecision eb sb))
 -> IO (Expr t (BaseBVType w)))
-> IO (Expr t (BaseFloatType (FloatingPointPrecision eb sb)))
-> IO (Expr t (BaseBVType w))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
-> SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
-> IO
     (SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
Expr t (BaseFloatType (FloatingPointPrecision eb sb))
x' SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
Expr t (BaseFloatType (FloatingPointPrecision eb sb))
y'

    | Bool
otherwise =
        do Integer
ut <- OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
           let ?unaryThreshold = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ut
           ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (Expr t (BaseBVType w))
-> IO (Expr t (BaseBVType w))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w, ?unaryThreshold::Int) =>
ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (BVExpr t w)
-> IO (BVExpr t w)
sbTryUnaryTerm ExprBuilder t st fs
sym
             (do UnaryBV (BoolExpr t) w
ux <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (BoolExpr t) w)
forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
                 UnaryBV (BoolExpr t) w
uy <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (BoolExpr t) w)
forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
                 IO (UnaryBV (BoolExpr t) w) -> Maybe (IO (UnaryBV (BoolExpr t) w))
forall a. a -> Maybe a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (UnaryBV (Pred (ExprBuilder t st fs)) w)
forall sym (n :: Natural).
(1 <= n, IsExprBuilder sym) =>
sym
-> Pred sym
-> UnaryBV (Pred sym) n
-> UnaryBV (Pred sym) n
-> IO (UnaryBV (Pred sym) n)
UnaryBV.mux ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (BoolExpr t) w
ux UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (BoolExpr t) w
uy))
             (case Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (Some BVFlavorRepr)
forall t (w :: Natural).
Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (Some BVFlavorRepr)
inSameBVSemiRing SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y of
                Just (Some BVFlavorRepr x
flv) ->
                  ExprBuilder t st fs
-> SemiRingRepr ('SemiRingBV x w)
-> BoolExpr t
-> Expr t (SemiRingBase ('SemiRingBV x w))
-> Expr t (SemiRingBase ('SemiRingBV x w))
-> IO (Expr t (SemiRingBase ('SemiRingBV x w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym (BVFlavorRepr x -> NatRepr w -> SemiRingRepr ('SemiRingBV x w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr x
flv (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)) Pred (ExprBuilder t st fs)
BoolExpr t
c SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV x w))
x SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV x w))
y
                Maybe (Some BVFlavorRepr)
Nothing ->
                  ExprBuilder t st fs
-> BoolExpr t
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y)

  bvEq :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
    | SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> Bool
forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym

    | Just (BVFill NatRepr w
_ BoolExpr t
px) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just (BVFill NatRepr w
_ BoolExpr t
py) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y =
      ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
eqPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
px Pred (ExprBuilder t st fs)
BoolExpr t
py

    | Just Bool
b <- BVDomain w -> BVDomain w -> Maybe Bool
forall (w :: Natural). BVDomain w -> BVDomain w -> Maybe Bool
BVD.eq (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) = do
      BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

    -- Push some equalities under if/then/else
    | SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- SymBV (ExprBuilder t st fs) w
x
    , Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ BoolExpr t
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    , Maybe (BV w) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a) Bool -> Bool -> Bool
|| Maybe (BV w) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b) -- avoid loss of sharing
    = IO (IO (BoolExpr t)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c (BoolExpr t -> BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t -> IO (BoolExpr t))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
a IO (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (IO (BoolExpr t))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b)

    -- Push some equalities under if/then/else
    | Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ BoolExpr t
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- SymBV (ExprBuilder t st fs) w
y
    , Maybe (BV w) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a) Bool -> Bool -> Bool
|| Maybe (BV w) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b) -- avoid loss of sharing
    = IO (IO (BoolExpr t)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c (BoolExpr t -> BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t -> IO (BoolExpr t))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
a SymBV (ExprBuilder t st fs) w
y IO (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (IO (BoolExpr t))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b SymBV (ExprBuilder t st fs) w
y)

    | Just (Some BVFlavorRepr x
flv) <- Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (Some BVFlavorRepr)
forall t (w :: Natural).
Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (Some BVFlavorRepr)
inSameBVSemiRing SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    , let sr :: SemiRingRepr ('SemiRingBV x w)
sr = BVFlavorRepr x -> NatRepr w -> SemiRingRepr ('SemiRingBV x w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr x
flv (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)
    , (WeightedSum (Expr t) ('SemiRingBV x w)
z, WeightedSum (Expr t) ('SemiRingBV x w)
x',WeightedSum (Expr t) ('SemiRingBV x w)
y') <- WeightedSum (Expr t) ('SemiRingBV x w)
-> WeightedSum (Expr t) ('SemiRingBV x w)
-> (WeightedSum (Expr t) ('SemiRingBV x w),
    WeightedSum (Expr t) ('SemiRingBV x w),
    WeightedSum (Expr t) ('SemiRingBV x w))
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
WeightedSum f sr
-> WeightedSum f sr
-> (WeightedSum f sr, WeightedSum f sr, WeightedSum f sr)
WSum.extractCommon (SemiRingRepr ('SemiRingBV x w)
-> Expr t (SemiRingBase ('SemiRingBV x w))
-> WeightedSum (Expr t) ('SemiRingBV x w)
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr ('SemiRingBV x w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV x w))
x) (SemiRingRepr ('SemiRingBV x w)
-> Expr t (SemiRingBase ('SemiRingBV x w))
-> WeightedSum (Expr t) ('SemiRingBV x w)
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr ('SemiRingBV x w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV x w))
y)
    , Bool -> Bool
not (SemiRingRepr ('SemiRingBV x w)
-> WeightedSum (Expr t) ('SemiRingBV x w) -> Bool
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr ('SemiRingBV x w)
sr WeightedSum (Expr t) ('SemiRingBV x w)
z) =
        case (WeightedSum (Expr t) ('SemiRingBV x w)
-> Maybe (Coefficient ('SemiRingBV x w))
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) ('SemiRingBV x w)
x', WeightedSum (Expr t) ('SemiRingBV x w)
-> Maybe (Coefficient ('SemiRingBV x w))
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) ('SemiRingBV x w)
y') of
          (Just BV w
a, Just BV w
b) -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (SemiRingRepr ('SemiRingBV x w)
-> Coefficient ('SemiRingBV x w)
-> Coefficient ('SemiRingBV x w)
-> Bool
forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr ('SemiRingBV x w)
sr BV w
Coefficient ('SemiRingBV x w)
a BV w
Coefficient ('SemiRingBV x w)
b)
          (Maybe (BV w), Maybe (BV w))
_ -> do Expr t (BaseBVType w)
xr <- ExprBuilder t st fs
-> WeightedSum (Expr t) ('SemiRingBV x w)
-> IO (Expr t (SemiRingBase ('SemiRingBV x w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) ('SemiRingBV x w)
x'
                  Expr t (BaseBVType w)
yr <- ExprBuilder t st fs
-> WeightedSum (Expr t) ('SemiRingBV x w)
-> IO (Expr t (SemiRingBase ('SemiRingBV x w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) ('SemiRingBV x w)
y'
                  ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr (BaseBVType w)
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) BaseBoolType
forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e BaseBoolType
BaseEq (SemiRingRepr ('SemiRingBV x w)
-> BaseTypeRepr (SemiRingBase ('SemiRingBV x w))
forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr ('SemiRingBV x w)
sr) (Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Expr t (BaseBVType w)
forall a. Ord a => a -> a -> a
min Expr t (BaseBVType w)
xr Expr t (BaseBVType w)
yr) (Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Expr t (BaseBVType w)
forall a. Ord a => a -> a -> a
max Expr t (BaseBVType w)
xr Expr t (BaseBVType w)
yr)

    | Bool
otherwise = do
        Integer
ut <- OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
        let ?unaryThreshold = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ut
        if | Just UnaryBV (BoolExpr t) w
ux <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (BoolExpr t) w)
forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
           , Just UnaryBV (BoolExpr t) w
uy <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (BoolExpr t) w)
forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
           -> ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (Pred (ExprBuilder t st fs))
forall (n :: Natural) sym.
(1 <= n, IsExprBuilder sym) =>
sym
-> UnaryBV (Pred sym) n -> UnaryBV (Pred sym) n -> IO (Pred sym)
UnaryBV.eq ExprBuilder t st fs
sym UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (BoolExpr t) w
ux UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (BoolExpr t) w
uy
           | Bool
otherwise
           -> ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr (BaseBVType w)
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) BaseBoolType
forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e BaseBoolType
BaseEq (NatRepr w -> BaseTypeRepr (BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)) (Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Expr t (BaseBVType w)
forall a. Ord a => a -> a -> a
min SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) (Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Expr t (BaseBVType w)
forall a. Ord a => a -> a -> a
max SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y)

  bvSlt :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
bvSlt ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
    | Just BV w
xc <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just BV w
yc <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y =
      BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (NatRepr w -> BV w -> BV w -> Bool
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> BV w -> Bool
BV.slt (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
xc BV w
yc)
    | Just Bool
b <- NatRepr w -> BVDomain w -> BVDomain w -> Maybe Bool
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> Maybe Bool
BVD.slt (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) =
      BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
    | SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> Bool
forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)

    | Bool
otherwise = do
        Integer
ut <- OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
        let ?unaryThreshold = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ut
        if | Just UnaryBV (BoolExpr t) w
ux <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (BoolExpr t) w)
forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
           , Just UnaryBV (BoolExpr t) w
uy <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (BoolExpr t) w)
forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
           -> ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (Pred (ExprBuilder t st fs))
forall (n :: Natural) sym.
(1 <= n, IsExprBuilder sym) =>
sym
-> UnaryBV (Pred sym) n -> UnaryBV (Pred sym) n -> IO (Pred sym)
UnaryBV.slt ExprBuilder t st fs
sym UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (BoolExpr t) w
ux UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (BoolExpr t) w
uy
           | Bool
otherwise
           -> ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> App (Expr t) BaseBoolType
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> e (BaseBVType w) -> App e BaseBoolType
BVSlt SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

  bvUlt :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
bvUlt ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
    | Just BV w
xc <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Just BV w
yc <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y = do
      BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (BV w -> BV w -> Bool
forall (w :: Natural). BV w -> BV w -> Bool
BV.ult BV w
xc BV w
yc)
    | Just Bool
b <- BVDomain w -> BVDomain w -> Maybe Bool
forall (w :: Natural).
(1 <= w) =>
BVDomain w -> BVDomain w -> Maybe Bool
BVD.ult (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) =
      BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
    | SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> Bool
forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y =
      BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym

    | SemiRingRepr ('SemiRingBV 'BVArith w)
sr <- BVFlavorRepr 'BVArith
-> NatRepr w -> SemiRingRepr ('SemiRingBV 'BVArith w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)
    , (WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
z, WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
x', WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
y') <- WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
-> (WeightedSum (Expr t) ('SemiRingBV 'BVArith w),
    WeightedSum (Expr t) ('SemiRingBV 'BVArith w),
    WeightedSum (Expr t) ('SemiRingBV 'BVArith w))
forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
WeightedSum f sr
-> WeightedSum f sr
-> (WeightedSum f sr, WeightedSum f sr, WeightedSum f sr)
WSum.extractCommon (SemiRingRepr ('SemiRingBV 'BVArith w)
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr ('SemiRingBV 'BVArith w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
x) (SemiRingRepr ('SemiRingBV 'BVArith w)
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr ('SemiRingBV 'BVArith w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
y)
    , Bool -> Bool
not (SemiRingRepr ('SemiRingBV 'BVArith w)
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith w) -> Bool
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr ('SemiRingBV 'BVArith w)
sr WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
z)
    , BVDomain w -> BVDomain w -> BVDomain w -> Bool
forall (w :: Natural).
BVDomain w -> BVDomain w -> BVDomain w -> Bool
BVD.isUltSumCommonEquiv (WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
-> AbstractValue (SemiRingBase ('SemiRingBV 'BVArith w))
forall (f :: BaseType -> Type) (sr :: SemiRing).
OrdF f =>
WeightedSum f sr -> AbstractValue (SemiRingBase sr)
WSum.sumAbsValue WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
x') (WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
-> AbstractValue (SemiRingBase ('SemiRingBV 'BVArith w))
forall (f :: BaseType -> Type) (sr :: SemiRing).
OrdF f =>
WeightedSum f sr -> AbstractValue (SemiRingBase sr)
WSum.sumAbsValue WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
y') (WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
-> AbstractValue (SemiRingBase ('SemiRingBV 'BVArith w))
forall (f :: BaseType -> Type) (sr :: SemiRing).
OrdF f =>
WeightedSum f sr -> AbstractValue (SemiRingBase sr)
WSum.sumAbsValue WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
z) = do
      Expr t (BaseBVType w)
xr <- ExprBuilder t st fs
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVArith w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
x'
      Expr t (BaseBVType w)
yr <- ExprBuilder t st fs
-> WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVArith w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) ('SemiRingBV 'BVArith w)
y'
      ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUlt ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
xr SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
yr

    | Bool
otherwise = do
        Integer
ut <- OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
        let ?unaryThreshold = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ut
        if | Just UnaryBV (BoolExpr t) w
ux <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (BoolExpr t) w)
forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
           , Just UnaryBV (BoolExpr t) w
uy <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (BoolExpr t) w)
forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
           -> ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (Pred (ExprBuilder t st fs))
forall (n :: Natural) sym.
(1 <= n, IsExprBuilder sym) =>
sym
-> UnaryBV (Pred sym) n -> UnaryBV (Pred sym) n -> IO (Pred sym)
UnaryBV.ult ExprBuilder t st fs
sym UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (BoolExpr t) w
ux UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (BoolExpr t) w
uy

           | Bool
otherwise
           -> ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> App (Expr t) BaseBoolType
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> e (BaseBVType w) -> App e BaseBoolType
BVUlt SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

  bvShl :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvShl ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
   -- shift by 0 is the identity function
   | Just (BV.BV Integer
0) <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   = Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x

   -- shift by more than word width returns 0
   | let (Integer
lo, Integer
_hi) = BVDomain w -> (Integer, Integer)
forall (w :: Natural). BVDomain w -> (Integer, Integer)
BVD.ubounds (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y)
   , Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
intValue (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)
   = ExprBuilder t st fs
-> NatRepr w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)

   | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x, Just BV w
n <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (NatRepr w -> BV w -> Natural -> BV w
forall (w :: Natural). NatRepr w -> BV w -> Natural -> BV w
BV.shl (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
xv (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n))

   | Bool
otherwise
   = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVShl (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

  bvLshr :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvLshr ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
   -- shift by 0 is the identity function
   | Just (BV.BV Integer
0) <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   = Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x

   -- shift by more than word width returns 0
   | let (Integer
lo, Integer
_hi) = BVDomain w -> (Integer, Integer)
forall (w :: Natural). BVDomain w -> (Integer, Integer)
BVD.ubounds (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y)
   , Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
intValue (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)
   = ExprBuilder t st fs
-> NatRepr w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)

   | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x, Just BV w
n <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> Natural -> BV w
forall (w :: Natural). NatRepr w -> BV w -> Natural -> BV w
BV.lshr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
xv (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n)

   | Bool
otherwise
   = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVLshr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

  bvAshr :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvAshr ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
   -- shift by 0 is the identity function
   | Just (BV.BV Integer
0) <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   = Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x

   -- shift by more than word width returns either 0 (if x is nonnegative)
   -- or 1 (if x is negative)
   | let (Integer
lo, Integer
_hi) = BVDomain w -> (Integer, Integer)
forall (w :: Natural). BVDomain w -> (Integer, Integer)
BVD.ubounds (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y)
   , Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
intValue (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)
   = ExprBuilder t st fs
-> NatRepr w
-> Pred (ExprBuilder t st fs)
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w
-> Pred (ExprBuilder t st fs)
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> Pred sym -> IO (SymBV sym w)
bvFill ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BoolExpr t -> IO (Expr t (BaseBVType w)))
-> IO (BoolExpr t) -> IO (Expr t (BaseBVType w))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNeg ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x

   | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x, Just BV w
n <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> Natural -> BV w
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> Natural -> BV w
BV.ashr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
xv (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n)

   | Bool
otherwise
   = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVAshr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

  bvRol :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvRol ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
   | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x, Just BV w
n <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> Natural -> BV w
forall (w :: Natural). NatRepr w -> BV w -> Natural -> BV w
BV.rotateL (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
xv (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n)

   | Just BV w
n <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   , BV w
n BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
`BV.urem` NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.width (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) BV w -> BV w -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.zero (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y)
   = Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x

   | Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   , Natural -> Bool
forall a. (Bits a, Num a) => a -> Bool
isPow2 (NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
   = do Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
y
        ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRol ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

   | Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   = do Expr t (BaseBVType w)
wbv <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
        Expr t (BaseBVType w)
n' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
y' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
n' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'
        ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRol ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

   | Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   , Natural -> Bool
forall a. (Bits a, Num a) => a -> Bool
isPow2 (NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
   = do Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
y
        ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRor ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

   | Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   = do Expr t (BaseBVType w)
wbv <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
        Expr t (BaseBVType w)
y' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
n' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
n' (Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> IO (Expr t (BaseBVType w)) -> IO (Expr t (BaseBVType w))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'
        ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRor ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

   | Bool
otherwise
   = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x in
     ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVRol NatRepr w
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

  bvRor :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvRor ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
   | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x, Just BV w
n <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> Natural -> BV w
forall (w :: Natural). NatRepr w -> BV w -> Natural -> BV w
BV.rotateR (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
xv (BV w -> Natural
forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n)

   | Just BV w
n <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
   , BV w
n BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
`BV.urem` NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.width (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) BV w -> BV w -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.zero (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y)
   = Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x

   | Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   , Natural -> Bool
forall a. (Bits a, Num a) => a -> Bool
isPow2 (NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
   = do Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
y
        ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRor ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

   | Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   = do Expr t (BaseBVType w)
wbv <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
        Expr t (BaseBVType w)
n' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
y' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
n' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'
        ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRor ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

   | Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   , Natural -> Bool
forall a. (Bits a, Num a) => a -> Bool
isPow2 (NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
   = do Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
y
        ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRol ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

   | Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   = do Expr t (BaseBVType w)
wbv <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
        Expr t (BaseBVType w)
n' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
y' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
z <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
n' (Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> IO (Expr t (BaseBVType w)) -> IO (Expr t (BaseBVType w))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
wbv SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y'
        ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRol ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
z

   | Bool
otherwise
   = let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x in
     ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVRor NatRepr w
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

  bvZext :: forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
bvZext ExprBuilder t st fs
sym NatRepr r
w SymBV (ExprBuilder t st fs) u
x
    | Just BV u
xv <- Expr t (BaseBVType u) -> Maybe (BV u)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Maybe (LeqProof 1 r)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
      ExprBuilder t st fs
-> NatRepr r -> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr r
w (NatRepr r -> BV u -> BV r
forall (w :: Natural) (w' :: Natural).
((w + 1) <= w') =>
NatRepr w' -> BV w -> BV w'
BV.zext NatRepr r
w BV u
xv)

      -- Concatenate unsign extension.
    | Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
y) <- Expr t (BaseBVType u) -> Maybe (App (Expr t) (BaseBVType u))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof (w + 1) r
LeqProof <- Maybe (LeqProof (w + 1) r) -> IO (Maybe (LeqProof (w + 1) r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof (w + 1) r) -> IO (Maybe (LeqProof (w + 1) r)))
-> Maybe (LeqProof (w + 1) r) -> IO (Maybe (LeqProof (w + 1) r))
forall a b. (a -> b) -> a -> b
$ NatRepr (w + 1) -> NatRepr r -> Maybe (LeqProof (w + 1) r)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y)) NatRepr r
w
      Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr 1 -> NatRepr r -> Maybe (LeqProof 1 r)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
w
      ExprBuilder t st fs
-> App (Expr t) ('BaseBVType r) -> IO (Expr t ('BaseBVType r))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseBVType r) -> IO (Expr t ('BaseBVType r)))
-> App (Expr t) ('BaseBVType r) -> IO (Expr t ('BaseBVType r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Expr t (BaseBVType w) -> App (Expr t) ('BaseBVType r)
forall (w :: Natural) (r :: Natural) (e :: BaseType -> Type).
(1 <= w, (w + 1) <= r, 1 <= r) =>
NatRepr r -> e (BaseBVType w) -> App e ('BaseBVType r)
BVZext NatRepr r
w Expr t (BaseBVType w)
y

      -- Extend unary representation.
    | Just (BVUnaryTerm UnaryBV (BoolExpr t) n
u) <- Expr t (BaseBVType u) -> Maybe (App (Expr t) (BaseBVType u))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Maybe (LeqProof 1 r)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
      ExprBuilder t st fs
-> UnaryBV (BoolExpr t) r -> IO (Expr t ('BaseBVType r))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sym (UnaryBV (BoolExpr t) r -> IO (Expr t ('BaseBVType r)))
-> UnaryBV (BoolExpr t) r -> IO (Expr t ('BaseBVType r))
forall a b. (a -> b) -> a -> b
$ UnaryBV (BoolExpr t) n -> NatRepr r -> UnaryBV (BoolExpr t) r
forall (u :: Natural) (r :: Natural) p.
(1 <= u, (u + 1) <= r) =>
UnaryBV p u -> NatRepr r -> UnaryBV p r
UnaryBV.uext UnaryBV (BoolExpr t) n
u NatRepr r
w

    | Bool
otherwise = do
      Bool
pmo <- OptionSetting BaseBoolType -> IO Bool
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseBoolType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseBoolType
sbPushMuxOps ExprBuilder t st fs
sym)
      if | Bool
pmo
         , Just (BaseIte BaseTypeRepr (BaseBVType u)
_ Integer
_ BoolExpr t
c Expr t (BaseBVType u)
a Expr t (BaseBVType u)
b) <- Expr t (BaseBVType u) -> Maybe (App (Expr t) (BaseBVType u))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x
         , Just BV u
a_bv <- Expr t (BaseBVType u) -> Maybe (BV u)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType u)
a
         , Just BV u
b_bv <- Expr t (BaseBVType u) -> Maybe (BV u)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType u)
b -> do
             Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Maybe (LeqProof 1 r)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
             Expr t ('BaseBVType r)
a' <- ExprBuilder t st fs
-> NatRepr r -> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr r
w (BV r -> IO (SymBV (ExprBuilder t st fs) r))
-> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall a b. (a -> b) -> a -> b
$ NatRepr r -> BV u -> BV r
forall (w :: Natural) (w' :: Natural).
((w + 1) <= w') =>
NatRepr w' -> BV w -> BV w'
BV.zext NatRepr r
w BV u
a_bv
             Expr t ('BaseBVType r)
b' <- ExprBuilder t st fs
-> NatRepr r -> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr r
w (BV r -> IO (SymBV (ExprBuilder t st fs) r))
-> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall a b. (a -> b) -> a -> b
$ NatRepr r -> BV u -> BV r
forall (w :: Natural) (w' :: Natural).
((w + 1) <= w') =>
NatRepr w' -> BV w -> BV w'
BV.zext NatRepr r
w BV u
b_bv
             ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) r
-> SymBV (ExprBuilder t st fs) r
-> IO (SymBV (ExprBuilder t st fs) r)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c SymBV (ExprBuilder t st fs) r
Expr t ('BaseBVType r)
a' SymBV (ExprBuilder t st fs) r
Expr t ('BaseBVType r)
b'

         | Bool
otherwise -> do
             Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr 1 -> NatRepr r -> Maybe (LeqProof 1 r)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
w
             ExprBuilder t st fs
-> App (Expr t) ('BaseBVType r) -> IO (Expr t ('BaseBVType r))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseBVType r) -> IO (Expr t ('BaseBVType r)))
-> App (Expr t) ('BaseBVType r) -> IO (Expr t ('BaseBVType r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Expr t (BaseBVType u) -> App (Expr t) ('BaseBVType r)
forall (w :: Natural) (r :: Natural) (e :: BaseType -> Type).
(1 <= w, (w + 1) <= r, 1 <= r) =>
NatRepr r -> e (BaseBVType w) -> App e ('BaseBVType r)
BVZext NatRepr r
w SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x

  bvSext :: forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
bvSext ExprBuilder t st fs
sym NatRepr r
w SymBV (ExprBuilder t st fs) u
x
    | Just BV u
xv <- Expr t (BaseBVType u) -> Maybe (BV u)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Maybe (LeqProof 1 r)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
      ExprBuilder t st fs
-> NatRepr r -> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr r
w (NatRepr u -> NatRepr r -> BV u -> BV r
forall (w :: Natural) (w' :: Natural).
(1 <= w, (w + 1) <= w') =>
NatRepr w -> NatRepr w' -> BV w -> BV w'
BV.sext (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x) NatRepr r
w BV u
xv)

      -- Concatenate sign extension.
    | Just (BVSext NatRepr r
_ Expr t (BaseBVType w)
y) <- Expr t (BaseBVType u) -> Maybe (App (Expr t) (BaseBVType u))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof (w + 1) r
LeqProof <- Maybe (LeqProof (w + 1) r) -> IO (Maybe (LeqProof (w + 1) r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof (w + 1) r) -> IO (Maybe (LeqProof (w + 1) r)))
-> Maybe (LeqProof (w + 1) r) -> IO (Maybe (LeqProof (w + 1) r))
forall a b. (a -> b) -> a -> b
$ NatRepr (w + 1) -> NatRepr r -> Maybe (LeqProof (w + 1) r)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr w -> NatRepr (w + 1)
forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y)) NatRepr r
w
      Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr 1 -> NatRepr r -> Maybe (LeqProof 1 r)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
w
      ExprBuilder t st fs
-> App (Expr t) ('BaseBVType r) -> IO (Expr t ('BaseBVType r))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (NatRepr r -> Expr t (BaseBVType w) -> App (Expr t) ('BaseBVType r)
forall (w :: Natural) (r :: Natural) (e :: BaseType -> Type).
(1 <= w, (w + 1) <= r, 1 <= r) =>
NatRepr r -> e (BaseBVType w) -> App e ('BaseBVType r)
BVSext NatRepr r
w Expr t (BaseBVType w)
y)

      -- Extend unary representation.
    | Just (BVUnaryTerm UnaryBV (BoolExpr t) n
u) <- Expr t (BaseBVType u) -> Maybe (App (Expr t) (BaseBVType u))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Maybe (LeqProof 1 r)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
      ExprBuilder t st fs
-> UnaryBV (BoolExpr t) r -> IO (Expr t ('BaseBVType r))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sym (UnaryBV (BoolExpr t) r -> IO (Expr t ('BaseBVType r)))
-> UnaryBV (BoolExpr t) r -> IO (Expr t ('BaseBVType r))
forall a b. (a -> b) -> a -> b
$ UnaryBV (BoolExpr t) n -> NatRepr r -> UnaryBV (BoolExpr t) r
forall (u :: Natural) (r :: Natural) p.
(1 <= u, (u + 1) <= r) =>
UnaryBV p u -> NatRepr r -> UnaryBV p r
UnaryBV.sext UnaryBV (BoolExpr t) n
u NatRepr r
w

    | Bool
otherwise = do
      Bool
pmo <- OptionSetting BaseBoolType -> IO Bool
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseBoolType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseBoolType
sbPushMuxOps ExprBuilder t st fs
sym)
      if | Bool
pmo
         , Just (BaseIte BaseTypeRepr (BaseBVType u)
_ Integer
_ BoolExpr t
c Expr t (BaseBVType u)
a Expr t (BaseBVType u)
b) <- Expr t (BaseBVType u) -> Maybe (App (Expr t) (BaseBVType u))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x
         , Just BV u
a_bv <- Expr t (BaseBVType u) -> Maybe (BV u)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType u)
a
         , Just BV u
b_bv <- Expr t (BaseBVType u) -> Maybe (BV u)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType u)
b -> do
             Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr r -> Maybe (LeqProof 1 r)
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
             Expr t ('BaseBVType r)
a' <- ExprBuilder t st fs
-> NatRepr r -> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr r
w (BV r -> IO (SymBV (ExprBuilder t st fs) r))
-> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall a b. (a -> b) -> a -> b
$ NatRepr u -> NatRepr r -> BV u -> BV r
forall (w :: Natural) (w' :: Natural).
(1 <= w, (w + 1) <= w') =>
NatRepr w -> NatRepr w' -> BV w -> BV w'
BV.sext (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x) NatRepr r
w BV u
a_bv
             Expr t ('BaseBVType r)
b' <- ExprBuilder t st fs
-> NatRepr r -> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr r
w (BV r -> IO (SymBV (ExprBuilder t st fs) r))
-> BV r -> IO (SymBV (ExprBuilder t st fs) r)
forall a b. (a -> b) -> a -> b
$ NatRepr u -> NatRepr r -> BV u -> BV r
forall (w :: Natural) (w' :: Natural).
(1 <= w, (w + 1) <= w') =>
NatRepr w -> NatRepr w' -> BV w -> BV w'
BV.sext (Expr t (BaseBVType u) -> NatRepr u
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x) NatRepr r
w BV u
b_bv
             ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) r
-> SymBV (ExprBuilder t st fs) r
-> IO (SymBV (ExprBuilder t st fs) r)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c SymBV (ExprBuilder t st fs) r
Expr t ('BaseBVType r)
a' SymBV (ExprBuilder t st fs) r
Expr t ('BaseBVType r)
b'

         | Bool
otherwise -> do
             Just LeqProof 1 r
LeqProof <- Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r)))
-> Maybe (LeqProof 1 r) -> IO (Maybe (LeqProof 1 r))
forall a b. (a -> b) -> a -> b
$ NatRepr 1 -> NatRepr r -> Maybe (LeqProof 1 r)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr 1
forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
w
             ExprBuilder t st fs
-> App (Expr t) ('BaseBVType r) -> IO (Expr t ('BaseBVType r))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (NatRepr r -> Expr t (BaseBVType u) -> App (Expr t) ('BaseBVType r)
forall (w :: Natural) (r :: Natural) (e :: BaseType -> Type).
(1 <= w, (w + 1) <= r, 1 <= r) =>
NatRepr r -> e (BaseBVType w) -> App e ('BaseBVType r)
BVSext NatRepr r
w SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
x)

  bvXorBits :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvXorBits ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
    | SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> Bool
forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y = ExprBuilder t st fs
-> NatRepr w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)  -- special case: x `xor` x = 0
    | Bool
otherwise
    = let sr :: SemiRingRepr ('SemiRingBV 'BVBits w)
sr = BVFlavorRepr 'BVBits
-> NatRepr w -> SemiRingRepr ('SemiRingBV 'BVBits w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)
       in ExprBuilder t st fs
-> SemiRingRepr ('SemiRingBV 'BVBits w)
-> Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
-> Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVBits w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVBits w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
x SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
y

  bvAndBits :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvAndBits ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
    | SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> Bool
forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y = Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x -- Special case: idempotency of and

    | Just (BVOrBits NatRepr w
_ BVOrSet (Expr t) w
bs) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Expr t ('BaseBVType w) -> BVOrSet (Expr t) w -> Bool
forall (e :: BaseType -> Type) (w :: Natural).
OrdF e =>
e (BaseBVType w) -> BVOrSet e w -> Bool
bvOrContains SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
y BVOrSet (Expr t) w
bs
    = Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y -- absorption law

    | Just (BVOrBits NatRepr w
_ BVOrSet (Expr t) w
bs) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    , Expr t ('BaseBVType w) -> BVOrSet (Expr t) w -> Bool
forall (e :: BaseType -> Type) (w :: Natural).
OrdF e =>
e (BaseBVType w) -> BVOrSet e w -> Bool
bvOrContains SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x BVOrSet (Expr t) w
bs
    = Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x -- absorption law

    | Bool
otherwise
    = do Bool
pmo <- OptionSetting BaseBoolType -> IO Bool
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseBoolType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseBoolType
sbPushMuxOps ExprBuilder t st fs
sym)
         if | Bool
pmo
            , Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ BoolExpr t
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
            , Just BV w
a_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a
            , Just BV w
b_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b
            , Just BV w
y_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y -> do
                Expr t (BaseBVType w)
a' <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
BV.and BV w
a_bv BV w
y_bv
                Expr t (BaseBVType w)
b' <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
BV.and BV w
b_bv BV w
y_bv
                ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
a' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b'

            | Bool
pmo
            , Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ BoolExpr t
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
            , Just BV w
a_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a
            , Just BV w
b_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b
            , Just BV w
x_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x -> do
                Expr t (BaseBVType w)
a' <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
BV.and BV w
x_bv BV w
a_bv
                Expr t (BaseBVType w)
b' <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
BV.and BV w
x_bv BV w
b_bv
                ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
a' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b'

            | Bool
otherwise
            -> let sr :: SemiRingRepr ('SemiRingBV 'BVBits w)
sr = BVFlavorRepr 'BVBits
-> NatRepr w -> SemiRingRepr ('SemiRingBV 'BVBits w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)
                in ExprBuilder t st fs
-> SemiRingRepr ('SemiRingBV 'BVBits w)
-> Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
-> Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVBits w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVBits w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
x SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
y

  -- XOR by the all-1 constant of the bitwise semiring.
  -- This is equivalant to negation
  bvNotBits :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvNotBits ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
    | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ BV w
xv BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
`BV.xor` (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x))

    | Bool
otherwise
    = do Bool
pmo <- OptionSetting BaseBoolType -> IO Bool
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseBoolType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseBoolType
sbPushMuxOps ExprBuilder t st fs
sym)
         if | Bool
pmo
            , Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ BoolExpr t
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
            , Just BV w
a_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a
            , Just BV w
b_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b -> do
                Expr t (BaseBVType w)
a' <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> BV w
forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.complement (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
a_bv
                Expr t (BaseBVType w)
b' <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> BV w
forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.complement (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
b_bv
                ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
a' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b'
            | Bool
otherwise ->
                let sr :: SemiRingRepr ('SemiRingBV 'BVBits w)
sr = (BVFlavorRepr 'BVBits
-> NatRepr w -> SemiRingRepr ('SemiRingBV 'BVBits w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x))
                 in ExprBuilder t st fs
-> WeightedSum (Expr t) ('SemiRingBV 'BVBits w)
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVBits w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (WeightedSum (Expr t) ('SemiRingBV 'BVBits w)
 -> IO (Expr t (SemiRingBase ('SemiRingBV 'BVBits w))))
-> WeightedSum (Expr t) ('SemiRingBV 'BVBits w)
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVBits w)))
forall a b. (a -> b) -> a -> b
$ SemiRingRepr ('SemiRingBV 'BVBits w)
-> WeightedSum (Expr t) ('SemiRingBV 'BVBits w)
-> Coefficient ('SemiRingBV 'BVBits w)
-> WeightedSum (Expr t) ('SemiRingBV 'BVBits w)
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr ('SemiRingBV 'BVBits w)
sr (SemiRingRepr ('SemiRingBV 'BVBits w)
-> Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
-> WeightedSum (Expr t) ('SemiRingBV 'BVBits w)
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr ('SemiRingBV 'BVBits w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVBits w))
x) (NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x))

  bvOrBits :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvOrBits ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y =
    case (Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x, Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) of
      (Just BV w
xv, Just BV w
yv) -> ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w
xv BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
`BV.or` BV w
yv)
      (Just BV w
xv , Maybe (BV w)
_)
        | BV w
xv BV w -> BV w -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.zero (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) -> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
        | BV w
xv BV w -> BV w -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) -> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
      (Maybe (BV w)
_, Just BV w
yv)
        | BV w
yv BV w -> BV w -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.zero (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) -> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
        | BV w
yv BV w -> BV w -> Bool
forall a. Eq a => a -> a -> Bool
== NatRepr w -> BV w
forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) -> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

      (Maybe (BV w), Maybe (BV w))
_
        | SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> Bool
forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
        -> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x -- or is idempotent

        | Just (SemiRingProd SemiRingProduct (Expr t) sr
xs) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
        , SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVBitsRepr NatRepr w
_w <- SemiRingProduct (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
xs
        , SemiRingProduct (Expr t) sr -> Expr t (SemiRingBase sr) -> Bool
forall (f :: BaseType -> Type) (sr :: SemiRing).
OrdF f =>
SemiRingProduct f sr -> f (SemiRingBase sr) -> Bool
WSum.prodContains SemiRingProduct (Expr t) sr
xs SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase sr)
y
        -> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y   -- absorption law

        | Just (SemiRingProd SemiRingProduct (Expr t) sr
ys) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
        , SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVBitsRepr NatRepr w
_w <- SemiRingProduct (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
ys
        , SemiRingProduct (Expr t) sr -> Expr t (SemiRingBase sr) -> Bool
forall (f :: BaseType -> Type) (sr :: SemiRing).
OrdF f =>
SemiRingProduct f sr -> f (SemiRingBase sr) -> Bool
WSum.prodContains SemiRingProduct (Expr t) sr
ys SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase sr)
x
        -> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x   -- absorption law

        | Just (BVOrBits NatRepr w
w BVOrSet (Expr t) w
xs) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
        , Just (BVOrBits NatRepr w
_ BVOrSet (Expr t) w
ys) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
        -> ExprBuilder t st fs
-> App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w)))
-> App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BVOrSet (Expr t) w -> App (Expr t) ('BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits NatRepr w
w (BVOrSet (Expr t) w -> App (Expr t) ('BaseBVType w))
-> BVOrSet (Expr t) w -> App (Expr t) ('BaseBVType w)
forall a b. (a -> b) -> a -> b
$ BVOrSet (Expr t) w -> BVOrSet (Expr t) w -> BVOrSet (Expr t) w
forall (e :: BaseType -> Type) (w :: Natural).
OrdF e =>
BVOrSet e w -> BVOrSet e w -> BVOrSet e w
bvOrUnion BVOrSet (Expr t) w
xs BVOrSet (Expr t) w
BVOrSet (Expr t) w
ys

        | Just (BVOrBits NatRepr w
w BVOrSet (Expr t) w
xs) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
        -> ExprBuilder t st fs
-> App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w)))
-> App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BVOrSet (Expr t) w -> App (Expr t) ('BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits NatRepr w
w (BVOrSet (Expr t) w -> App (Expr t) ('BaseBVType w))
-> BVOrSet (Expr t) w -> App (Expr t) ('BaseBVType w)
forall a b. (a -> b) -> a -> b
$ Expr t ('BaseBVType w) -> BVOrSet (Expr t) w -> BVOrSet (Expr t) w
forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
y BVOrSet (Expr t) w
xs

        | Just (BVOrBits NatRepr w
w BVOrSet (Expr t) w
ys) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
        -> ExprBuilder t st fs
-> App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w)))
-> App (Expr t) ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BVOrSet (Expr t) w -> App (Expr t) ('BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits NatRepr w
w (BVOrSet (Expr t) w -> App (Expr t) ('BaseBVType w))
-> BVOrSet (Expr t) w -> App (Expr t) ('BaseBVType w)
forall a b. (a -> b) -> a -> b
$ Expr t ('BaseBVType w) -> BVOrSet (Expr t) w -> BVOrSet (Expr t) w
forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x BVOrSet (Expr t) w
ys

        -- (or (shl x n) (zext w y)) is equivalent to (concat (trunc (w - n) x) y) when n is
        -- the number of bits of y. Notice that the low bits of a shl expression are 0 and
        -- the high bits of a zext expression are 0, thus the or expression is equivalent to
        -- the concatenation between the high bits of the shl expression and the low bits of
        -- the zext expression.
        | Just (BVShl NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
        , Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
lo) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
        , Just Integer
ni <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
n
        , NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
intValue (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
ni
        , Just LeqProof w w
LeqProof <- NatRepr w -> NatRepr w -> Maybe (LeqProof w w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) NatRepr w
w -- dynamic check for GHC typechecker
        , NatRepr (w - w)
w' <- NatRepr w -> NatRepr w -> NatRepr (w - w)
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr w
w (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo)
        , Just LeqProof 1 (w - w)
LeqProof <- NatRepr 1 -> NatRepr (w - w) -> Maybe (LeqProof 1 (w - w))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) NatRepr (w - w)
NatRepr (w - w)
w' -- dynamic check for GHC typechecker
        , Just LeqProof ((w - w) + 1) w
LeqProof <- NatRepr ((w - w) + 1)
-> NatRepr w -> Maybe (LeqProof ((w - w) + 1) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr (w - w) -> NatRepr 1 -> NatRepr ((w - w) + 1)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
NatRepr (w - w)
w' (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1)) NatRepr w
w -- dynamic check for GHC typechecker
        , Just w :~: ((w - w) + w)
Refl <- NatRepr w -> NatRepr ((w - w) + w) -> Maybe (w :~: ((w - w) + w))
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w (NatRepr (w - w) -> NatRepr w -> NatRepr ((w - w) + w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
NatRepr (w - w)
w' (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo)) -- dynamic check for GHC typechecker
        -> do
          Expr t (BaseBVType (w - w))
hi <- ExprBuilder t st fs
-> NatRepr (w - w)
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) (w - w))
forall (r :: Natural) (w :: Natural).
(1 <= r, (r + 1) <= w) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc ExprBuilder t st fs
sym NatRepr (w - w)
NatRepr (w - w)
w' SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
x'
          ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) (w - w)
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) ((w - w) + w))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) (w - w)
Expr t (BaseBVType (w - w))
hi SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
lo
        | Just (BVShl NatRepr w
w Expr t ('BaseBVType w)
y' Expr t ('BaseBVType w)
n) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
        , Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
lo) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
        , Just Integer
ni <- BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned (BV w -> Integer) -> Maybe (BV w) -> Maybe Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t ('BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
n
        , NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
intValue (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
ni
        , Just LeqProof w w
LeqProof <- NatRepr w -> NatRepr w -> Maybe (LeqProof w w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) NatRepr w
w -- dynamic check for GHC typechecker
        , NatRepr (w - w)
w' <- NatRepr w -> NatRepr w -> NatRepr (w - w)
forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr w
w (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo)
        , Just LeqProof 1 (w - w)
LeqProof <- NatRepr 1 -> NatRepr (w - w) -> Maybe (LeqProof 1 (w - w))
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) NatRepr (w - w)
NatRepr (w - w)
w' -- dynamic check for GHC typechecker
        , Just LeqProof ((w - w) + 1) w
LeqProof <- NatRepr ((w - w) + 1)
-> NatRepr w -> Maybe (LeqProof ((w - w) + 1) w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (NatRepr (w - w) -> NatRepr 1 -> NatRepr ((w - w) + 1)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
NatRepr (w - w)
w' (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1)) NatRepr w
w -- dynamic check for GHC typechecker
        , Just w :~: ((w - w) + w)
Refl <- NatRepr w -> NatRepr ((w - w) + w) -> Maybe (w :~: ((w - w) + w))
forall (a :: Natural) (b :: Natural).
NatRepr a -> NatRepr b -> Maybe (a :~: b)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w (NatRepr (w - w) -> NatRepr w -> NatRepr ((w - w) + w)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
NatRepr (w - w)
w' (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo)) -- dynamic check for GHC typechecker
        -> do
          Expr t (BaseBVType (w - w))
hi <- ExprBuilder t st fs
-> NatRepr (w - w)
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) (w - w))
forall (r :: Natural) (w :: Natural).
(1 <= r, (r + 1) <= w) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc ExprBuilder t st fs
sym NatRepr (w - w)
NatRepr (w - w)
w' SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
y'
          ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) (w - w)
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) ((w - w) + w))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) (w - w)
Expr t (BaseBVType (w - w))
hi SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
lo

        | Bool
otherwise
        -> ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BVOrSet (Expr t) w -> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BVOrSet (Expr t) w -> App (Expr t) (BaseBVType w))
-> BVOrSet (Expr t) w -> App (Expr t) (BaseBVType w)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseBVType w) -> BVOrSet (Expr t) w -> BVOrSet (Expr t) w
forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x (BVOrSet (Expr t) w -> BVOrSet (Expr t) w)
-> BVOrSet (Expr t) w -> BVOrSet (Expr t) w
forall a b. (a -> b) -> a -> b
$ Expr t (BaseBVType w) -> BVOrSet (Expr t) w
forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w
bvOrSingleton SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y

  bvAdd :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y = ExprBuilder t st fs
-> SemiRingRepr ('SemiRingBV 'BVArith w)
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVArith w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVArith w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
x SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
y
     where sr :: SemiRingRepr ('SemiRingBV 'BVArith w)
sr = BVFlavorRepr 'BVArith
-> NatRepr w -> SemiRingRepr ('SemiRingBV 'BVArith w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)

  bvMul :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvMul ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y = ExprBuilder t st fs
-> SemiRingRepr ('SemiRingBV 'BVArith w)
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVArith w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVArith w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
x SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
y
     where sr :: SemiRingRepr ('SemiRingBV 'BVArith w)
sr = BVFlavorRepr 'BVArith
-> NatRepr w -> SemiRingRepr ('SemiRingBV 'BVArith w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)

  bvNeg :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvNeg ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
    | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (NatRepr w -> BV w -> BV w
forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.negate (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
xv)
    | Bool
otherwise = do
        Bool
pmo <- OptionSetting BaseBoolType -> IO Bool
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseBoolType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseBoolType
sbPushMuxOps ExprBuilder t st fs
sym)
        if | Bool
pmo
           , Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ BoolExpr t
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
           , Just BV w
a_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a
           , Just BV w
b_bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b -> do
               Expr t (BaseBVType w)
a' <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> BV w
forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.negate (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
a_bv
               Expr t (BaseBVType w)
b' <- ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> BV w
forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.negate (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
b_bv
               ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
a' SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
b'
           | Bool
otherwise -> do
               Integer
ut <- OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
               let ?unaryThreshold = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
ut
               ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (Expr t (BaseBVType w))
-> IO (Expr t (BaseBVType w))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w, ?unaryThreshold::Int) =>
ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (BVExpr t w)
-> IO (BVExpr t w)
sbTryUnaryTerm ExprBuilder t st fs
sym
                 (do UnaryBV (BoolExpr t) w
ux <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (BoolExpr t) w)
forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
                     IO (UnaryBV (BoolExpr t) w) -> Maybe (IO (UnaryBV (BoolExpr t) w))
forall a. a -> Maybe a
Just (ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (UnaryBV (Pred (ExprBuilder t st fs)) w)
forall sym (n :: Natural).
(1 <= n, IsExprBuilder sym) =>
sym -> UnaryBV (Pred sym) n -> IO (UnaryBV (Pred sym) n)
UnaryBV.neg ExprBuilder t st fs
sym UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (BoolExpr t) w
ux))
                 (do let sr :: SemiRingRepr ('SemiRingBV 'BVArith w)
sr = BVFlavorRepr 'BVArith
-> NatRepr w -> SemiRingRepr ('SemiRingBV 'BVArith w)
forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)
                     ExprBuilder t st fs
-> SemiRingRepr ('SemiRingBV 'BVArith w)
-> Coefficient ('SemiRingBV 'BVArith w)
-> Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
-> IO (Expr t (SemiRingBase ('SemiRingBV 'BVArith w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVArith w)
sr (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (-Integer
1)) SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase ('SemiRingBV 'BVArith w))
x)

  bvIsNonzero :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
bvIsNonzero ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
    | Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ BoolExpr t
p Expr t (BaseBVType w)
t Expr t (BaseBVType w)
f) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Maybe (BV w) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
t) Bool -> Bool -> Bool
|| Maybe (BV w) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
f) -- NB, avoid losing possible sharing
    = do  BoolExpr t
t' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
t
          BoolExpr t
f' <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
f
          ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
p Pred (ExprBuilder t st fs)
BoolExpr t
t' Pred (ExprBuilder t st fs)
BoolExpr t
f'
    | Just (BVConcat NatRepr (u + v)
_ Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    , Maybe (BV u) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType u) -> Maybe (BV u)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType u)
a) Bool -> Bool -> Bool
|| Maybe (BV v) -> Bool
forall a. Maybe a -> Bool
isJust (Expr t (BaseBVType v) -> Maybe (BV v)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType v)
b) -- NB, avoid losing possible sharing
    =  do BoolExpr t
pa <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u -> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) u
Expr t (BaseBVType u)
a
          BoolExpr t
pb <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) v -> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) v
Expr t (BaseBVType v)
b
          ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
pa Pred (ExprBuilder t st fs)
BoolExpr t
pb
    | Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
y) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x =
          ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    | Just (BVSext NatRepr r
_ Expr t (BaseBVType w)
y) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x =
          ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
    | Just (BVFill NatRepr w
_ BoolExpr t
p) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x =
          BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
p
    | Just (BVUnaryTerm UnaryBV (BoolExpr t) n
ubv) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x =
          (Integer -> IO (BoolExpr t))
-> (BoolExpr t -> BoolExpr t -> BoolExpr t -> IO (BoolExpr t))
-> UnaryBV (BoolExpr t) n
-> IO (BoolExpr t)
forall (m :: Type -> Type) r p (n :: Natural).
(Applicative m, Monad m) =>
(Integer -> m r) -> (p -> r -> r -> m r) -> UnaryBV p n -> m r
UnaryBV.sym_evaluate
            (\Integer
i -> BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Integer
iInteger -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/=Integer
0))
            (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym)
            UnaryBV (BoolExpr t) n
ubv
    | Bool
otherwise = do
          let w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
          Expr t (BaseBVType w)
zro <- ExprBuilder t st fs
-> NatRepr w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero ExprBuilder t st fs
sym NatRepr w
w
          ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
zro

  bvUdiv :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvUdiv = (NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> BVExpr t w -> BVExpr t w -> App (Expr t) ('BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp ((BV w -> BV w -> BV w) -> NatRepr w -> BV w -> BV w -> BV w
forall a b. a -> b -> a
const BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
BV.uquot) NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) ('BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVUdiv
  bvUrem :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
    | Just Bool
True <- BVDomain w -> BVDomain w -> Maybe Bool
forall (w :: Natural).
(1 <= w) =>
BVDomain w -> BVDomain w -> Maybe Bool
BVD.ult (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (Expr t (BaseBVType w) -> AbstractValue (BaseBVType w)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y) = Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
    | Bool
otherwise = (NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> Expr t (BaseBVType w)
    -> Expr t (BaseBVType w)
    -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> IO (Expr t (BaseBVType w))
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp ((BV w -> BV w -> BV w) -> NatRepr w -> BV w -> BV w -> BV w
forall a b. a -> b -> a
const BV w -> BV w -> BV w
forall (w :: Natural). BV w -> BV w -> BV w
BV.urem) NatRepr w
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y
  bvSdiv :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvSdiv = (NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> BVExpr t w -> BVExpr t w -> App (Expr t) ('BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp NatRepr w -> BV w -> BV w -> BV w
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> BV w -> BV w
BV.squot NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) ('BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVSdiv
  bvSrem :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvSrem = (NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> BVExpr t w -> BVExpr t w -> App (Expr t) ('BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp NatRepr w -> BV w -> BV w -> BV w
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> BV w -> BV w
BV.srem NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) ('BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVSrem

  bvPopcount :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvPopcount ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
    | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (BV w -> BV w
forall (w :: Natural). BV w -> BV w
BV.popCount BV w
xv)
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> Expr t (BaseBVType w) -> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e (BaseBVType w) -> App e (BaseBVType w)
BVPopcount NatRepr w
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   where w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x

  bvCountTrailingZeros :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvCountTrailingZeros ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
    | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> BV w -> BV w
forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.ctz NatRepr w
w BV w
xv)
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> Expr t (BaseBVType w) -> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e (BaseBVType w) -> App e (BaseBVType w)
BVCountTrailingZeros NatRepr w
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   where w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x

  bvCountLeadingZeros :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvCountLeadingZeros ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
    | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> BV w -> BV w
forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.clz NatRepr w
w BV w
xv)
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w)))
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a b. (a -> b) -> a -> b
$ NatRepr w -> Expr t (BaseBVType w) -> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e (BaseBVType w) -> App e (BaseBVType w)
BVCountLeadingZeros NatRepr w
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
   where w :: NatRepr w
w = Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x

  mkStruct :: forall (flds :: Ctx BaseType).
ExprBuilder t st fs
-> Assignment (SymExpr (ExprBuilder t st fs)) flds
-> IO (SymStruct (ExprBuilder t st fs) flds)
mkStruct ExprBuilder t st fs
sym Assignment (SymExpr (ExprBuilder t st fs)) flds
args = do
    ExprBuilder t st fs
-> App (Expr t) ('BaseStructType flds)
-> IO (Expr t ('BaseStructType flds))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseStructType flds)
 -> IO (Expr t ('BaseStructType flds)))
-> App (Expr t) ('BaseStructType flds)
-> IO (Expr t ('BaseStructType flds))
forall a b. (a -> b) -> a -> b
$ Assignment BaseTypeRepr flds
-> Assignment (Expr t) flds -> App (Expr t) ('BaseStructType flds)
forall (flds :: Ctx BaseType) (e :: BaseType -> Type).
Assignment BaseTypeRepr flds
-> Assignment e flds -> App e ('BaseStructType flds)
StructCtor ((forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp)
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> Assignment BaseTypeRepr x
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
fmapFC Expr t x -> BaseTypeRepr x
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr (ExprBuilder t st fs)) flds
Assignment (Expr t) flds
args) Assignment (SymExpr (ExprBuilder t st fs)) flds
Assignment (Expr t) flds
args

  structField :: forall (flds :: Ctx BaseType) (tp :: BaseType).
ExprBuilder t st fs
-> SymStruct (ExprBuilder t st fs) flds
-> Index flds tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
structField ExprBuilder t st fs
sym SymStruct (ExprBuilder t st fs) flds
s Index flds tp
i
    | Just (StructCtor Assignment BaseTypeRepr flds
_ Assignment (Expr t) flds
args) <- Expr t (BaseStructType flds)
-> Maybe (App (Expr t) (BaseStructType flds))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
s = Expr t tp -> IO (Expr t tp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t tp -> IO (Expr t tp)) -> Expr t tp -> IO (Expr t tp)
forall a b. (a -> b) -> a -> b
$! Assignment (Expr t) flds
args Assignment (Expr t) flds -> Index flds tp -> Expr t tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index flds tp
Index flds tp
i
    | Bool
otherwise = do
      case Expr t (BaseStructType flds) -> BaseTypeRepr (BaseStructType flds)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
s of
        BaseStructRepr Assignment BaseTypeRepr ctx
flds ->
          ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) tp -> IO (Expr t tp))
-> App (Expr t) tp -> IO (Expr t tp)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseStructType flds)
-> Index flds tp -> BaseTypeRepr tp -> App (Expr t) tp
forall (e :: BaseType -> Type) (flds :: Ctx BaseType)
       (tp :: BaseType).
e (BaseStructType flds)
-> Index flds tp -> BaseTypeRepr tp -> App e tp
StructField SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
s Index flds tp
i (Assignment BaseTypeRepr ctx
flds Assignment BaseTypeRepr ctx -> Index ctx tp -> BaseTypeRepr tp
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index flds tp
Index ctx tp
i)

  structIte :: forall (flds :: Ctx BaseType).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymStruct (ExprBuilder t st fs) flds
-> SymStruct (ExprBuilder t st fs) flds
-> IO (SymStruct (ExprBuilder t st fs) flds)
structIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p SymStruct (ExprBuilder t st fs) flds
x SymStruct (ExprBuilder t st fs) flds
y
    | Just Bool
True  <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
p = Expr t (BaseStructType flds) -> IO (Expr t (BaseStructType flds))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
x
    | Just Bool
False <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
p = Expr t (BaseStructType flds) -> IO (Expr t (BaseStructType flds))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
y
    | SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
x Expr t (BaseStructType flds)
-> Expr t (BaseStructType flds) -> Bool
forall a. Eq a => a -> a -> Bool
== SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
y                         = Expr t (BaseStructType flds) -> IO (Expr t (BaseStructType flds))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
x
    | Bool
otherwise                      = ExprBuilder t st fs
-> BoolExpr t
-> Expr t (BaseStructType flds)
-> Expr t (BaseStructType flds)
-> IO (Expr t (BaseStructType flds))
forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
p SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
x SymStruct (ExprBuilder t st fs) flds
Expr t (BaseStructType flds)
y

  --------------------------------------------------------------------
  -- String operations

  stringEmpty :: forall (si :: StringInfo).
ExprBuilder t st fs
-> StringInfoRepr si -> IO (SymString (ExprBuilder t st fs) si)
stringEmpty ExprBuilder t st fs
sym StringInfoRepr si
si = ExprBuilder t st fs
-> StringLiteral si
-> IO (SymExpr (ExprBuilder t st fs) (BaseStringType si))
forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> StringLiteral si -> IO (SymString sym si)
forall (si :: StringInfo).
ExprBuilder t st fs
-> StringLiteral si -> IO (SymString (ExprBuilder t st fs) si)
stringLit ExprBuilder t st fs
sym (StringInfoRepr si -> StringLiteral si
forall (si :: StringInfo). StringInfoRepr si -> StringLiteral si
stringLitEmpty StringInfoRepr si
si)

  stringLit :: forall (si :: StringInfo).
ExprBuilder t st fs
-> StringLiteral si -> IO (SymString (ExprBuilder t st fs) si)
stringLit ExprBuilder t st fs
sym StringLiteral si
s =
    do ProgramLoc
l <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
       Expr t ('BaseStringType si) -> IO (Expr t ('BaseStringType si))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t ('BaseStringType si) -> IO (Expr t ('BaseStringType si)))
-> Expr t ('BaseStringType si) -> IO (Expr t ('BaseStringType si))
forall a b. (a -> b) -> a -> b
$! StringLiteral si -> ProgramLoc -> Expr t ('BaseStringType si)
forall (si :: StringInfo) t.
StringLiteral si -> ProgramLoc -> Expr t ('BaseStringType si)
StringExpr StringLiteral si
s ProgramLoc
l

  stringEq :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (Pred (ExprBuilder t st fs))
stringEq ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    , Just StringLiteral si
y' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Maybe (si :~: si) -> Bool
forall a. Maybe a -> Bool
isJust (StringLiteral si -> StringLiteral si -> Maybe (si :~: si)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: StringInfo) (b :: StringInfo).
StringLiteral a -> StringLiteral b -> Maybe (a :~: b)
testEquality StringLiteral si
x' StringLiteral si
y'))
  stringEq ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
    = ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr (BaseStringType si)
-> Expr t (BaseStringType si)
-> Expr t (BaseStringType si)
-> App (Expr t) BaseBoolType
forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e BaseBoolType
BaseEq (StringInfoRepr si -> BaseTypeRepr (BaseStringType si)
forall (si :: StringInfo).
StringInfoRepr si -> BaseTypeRepr ('BaseStringType si)
BaseStringRepr (Expr t (BaseStringType si) -> StringInfoRepr si
forall (si :: StringInfo).
Expr t (BaseStringType si) -> StringInfoRepr si
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> StringInfoRepr si
stringInfo SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x)) SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y

  stringIte :: forall (si :: StringInfo).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (SymString (ExprBuilder t st fs) si)
stringIte ExprBuilder t st fs
_sym Pred (ExprBuilder t st fs)
c SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
    | Just Bool
c' <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
c
    = if Bool
c' then Expr t (BaseStringType si) -> IO (Expr t (BaseStringType si))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x else Expr t (BaseStringType si) -> IO (Expr t (BaseStringType si))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
  stringIte ExprBuilder t st fs
_sym Pred (ExprBuilder t st fs)
_c SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    , Just StringLiteral si
y' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
    , Maybe (si :~: si) -> Bool
forall a. Maybe a -> Bool
isJust (StringLiteral si -> StringLiteral si -> Maybe (si :~: si)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: StringInfo) (b :: StringInfo).
StringLiteral a -> StringLiteral b -> Maybe (a :~: b)
testEquality StringLiteral si
x' StringLiteral si
y')
    = Expr t (BaseStringType si) -> IO (Expr t (BaseStringType si))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
  stringIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
    = ExprBuilder t st fs
-> BoolExpr t
-> Expr t (BaseStringType si)
-> Expr t (BaseStringType si)
-> IO (Expr t (BaseStringType si))
forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y

  stringIndexOf :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
stringIndexOf ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y SymInteger (ExprBuilder t st fs)
k
    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    , Just StringLiteral si
y' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
    , Just Integer
k' <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
k
    = ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer -> IO (Expr t BaseIntegerType))
-> Integer -> IO (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$! StringLiteral si -> StringLiteral si -> Integer -> Integer
forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Integer -> Integer
stringLitIndexOf StringLiteral si
x' StringLiteral si
y' Integer
k'
  stringIndexOf ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y SymInteger (ExprBuilder t st fs)
k
    = ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType))
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseStringType si)
-> Expr t (BaseStringType si)
-> Expr t BaseIntegerType
-> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si)
-> e BaseIntegerType
-> App e BaseIntegerType
StringIndexOf SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
k

  stringContains :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (Pred (ExprBuilder t st fs))
stringContains ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    , Just StringLiteral si
y' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (StringLiteral si -> StringLiteral si -> Bool
forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Bool
stringLitContains StringLiteral si
x' StringLiteral si
y')
    | Just Bool
b <- StringAbstractValue -> StringAbstractValue -> Maybe Bool
stringAbsContains (Expr t (BaseStringType si) -> AbstractValue (BaseStringType si)
forall (tp :: BaseType). Expr t tp -> AbstractValue tp
forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x) (Expr t (BaseStringType si) -> AbstractValue (BaseStringType si)
forall (tp :: BaseType). Expr t tp -> AbstractValue tp
forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y)
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
    | Bool
otherwise
    = ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseStringType si)
-> Expr t (BaseStringType si) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si) -> App e BaseBoolType
StringContains SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y

  stringIsPrefixOf :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (Pred (ExprBuilder t st fs))
stringIsPrefixOf ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    , Just StringLiteral si
y' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (StringLiteral si -> StringLiteral si -> Bool
forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Bool
stringLitIsPrefixOf StringLiteral si
x' StringLiteral si
y')

    | Just Bool
b <- StringAbstractValue -> StringAbstractValue -> Maybe Bool
stringAbsIsPrefixOf (Expr t (BaseStringType si) -> AbstractValue (BaseStringType si)
forall (tp :: BaseType). Expr t tp -> AbstractValue tp
forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x) (Expr t (BaseStringType si) -> AbstractValue (BaseStringType si)
forall (tp :: BaseType). Expr t tp -> AbstractValue tp
forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y)
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

    | Bool
otherwise
    = ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseStringType si)
-> Expr t (BaseStringType si) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si) -> App e BaseBoolType
StringIsPrefixOf SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y

  stringIsSuffixOf :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (Pred (ExprBuilder t st fs))
stringIsSuffixOf ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    , Just StringLiteral si
y' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (StringLiteral si -> StringLiteral si -> Bool
forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Bool
stringLitIsSuffixOf StringLiteral si
x' StringLiteral si
y')

    | Just Bool
b <- StringAbstractValue -> StringAbstractValue -> Maybe Bool
stringAbsIsSuffixOf (Expr t (BaseStringType si) -> AbstractValue (BaseStringType si)
forall (tp :: BaseType). Expr t tp -> AbstractValue tp
forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x) (Expr t (BaseStringType si) -> AbstractValue (BaseStringType si)
forall (tp :: BaseType). Expr t tp -> AbstractValue tp
forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y)
    = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

    | Bool
otherwise
    = ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseStringType si)
-> Expr t (BaseStringType si) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si) -> App e BaseBoolType
StringIsSuffixOf SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y

  stringSubstring :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymString (ExprBuilder t st fs) si)
stringSubstring ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymInteger (ExprBuilder t st fs)
off SymInteger (ExprBuilder t st fs)
len
    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    , Just Integer
off' <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
off
    , Just Integer
len' <- Expr t BaseIntegerType -> Maybe Integer
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
len
    = ExprBuilder t st fs
-> StringLiteral si -> IO (SymString (ExprBuilder t st fs) si)
forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> StringLiteral si -> IO (SymString sym si)
forall (si :: StringInfo).
ExprBuilder t st fs
-> StringLiteral si -> IO (SymString (ExprBuilder t st fs) si)
stringLit ExprBuilder t st fs
sym (StringLiteral si -> IO (Expr t (BaseStringType si)))
-> StringLiteral si -> IO (Expr t (BaseStringType si))
forall a b. (a -> b) -> a -> b
$! StringLiteral si -> Integer -> Integer -> StringLiteral si
forall (si :: StringInfo).
StringLiteral si -> Integer -> Integer -> StringLiteral si
stringLitSubstring StringLiteral si
x' Integer
off' Integer
len'

    | Bool
otherwise
    = ExprBuilder t st fs
-> App (Expr t) (BaseStringType si)
-> IO (Expr t (BaseStringType si))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseStringType si)
 -> IO (Expr t (BaseStringType si)))
-> App (Expr t) (BaseStringType si)
-> IO (Expr t (BaseStringType si))
forall a b. (a -> b) -> a -> b
$ StringInfoRepr si
-> Expr t (BaseStringType si)
-> Expr t BaseIntegerType
-> Expr t BaseIntegerType
-> App (Expr t) (BaseStringType si)
forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si
-> e (BaseStringType si)
-> e BaseIntegerType
-> e BaseIntegerType
-> App e (BaseStringType si)
StringSubstring (Expr t (BaseStringType si) -> StringInfoRepr si
forall (si :: StringInfo).
Expr t (BaseStringType si) -> StringInfoRepr si
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> StringInfoRepr si
stringInfo SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x) SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
off SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
len

  stringConcat :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (SymString (ExprBuilder t st fs) si)
stringConcat ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x, StringLiteral si -> Bool
forall (si :: StringInfo). StringLiteral si -> Bool
stringLitNull StringLiteral si
x'
    = Expr t (BaseStringType si) -> IO (Expr t (BaseStringType si))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y

    | Just StringLiteral si
y' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y, StringLiteral si -> Bool
forall (si :: StringInfo). StringLiteral si -> Bool
stringLitNull StringLiteral si
y'
    = Expr t (BaseStringType si) -> IO (Expr t (BaseStringType si))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x

    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    , Just StringLiteral si
y' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
    = ExprBuilder t st fs
-> StringLiteral si -> IO (SymString (ExprBuilder t st fs) si)
forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> StringLiteral si -> IO (SymString sym si)
forall (si :: StringInfo).
ExprBuilder t st fs
-> StringLiteral si -> IO (SymString (ExprBuilder t st fs) si)
stringLit ExprBuilder t st fs
sym (StringLiteral si
x' StringLiteral si -> StringLiteral si -> StringLiteral si
forall a. Semigroup a => a -> a -> a
<> StringLiteral si
y')

    | Just (StringAppend StringInfoRepr si
si StringSeq (Expr t) si
xs) <- Expr t (BaseStringType si)
-> Maybe (App (Expr t) (BaseStringType si))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    , Just (StringAppend StringInfoRepr si
_  StringSeq (Expr t) si
ys) <- Expr t (BaseStringType si)
-> Maybe (App (Expr t) (BaseStringType si))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
    = ExprBuilder t st fs
-> App (Expr t) ('BaseStringType si)
-> IO (Expr t ('BaseStringType si))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseStringType si)
 -> IO (Expr t ('BaseStringType si)))
-> App (Expr t) ('BaseStringType si)
-> IO (Expr t ('BaseStringType si))
forall a b. (a -> b) -> a -> b
$ StringInfoRepr si
-> StringSeq (Expr t) si -> App (Expr t) ('BaseStringType si)
forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
si (StringSeq (Expr t) si
-> StringSeq (Expr t) si -> StringSeq (Expr t) si
forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringSeq e si -> StringSeq e si
SSeq.append StringSeq (Expr t) si
xs StringSeq (Expr t) si
StringSeq (Expr t) si
ys)

    | Just (StringAppend StringInfoRepr si
si StringSeq (Expr t) si
xs) <- Expr t (BaseStringType si)
-> Maybe (App (Expr t) (BaseStringType si))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    = ExprBuilder t st fs
-> App (Expr t) ('BaseStringType si)
-> IO (Expr t ('BaseStringType si))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseStringType si)
 -> IO (Expr t ('BaseStringType si)))
-> App (Expr t) ('BaseStringType si)
-> IO (Expr t ('BaseStringType si))
forall a b. (a -> b) -> a -> b
$ StringInfoRepr si
-> StringSeq (Expr t) si -> App (Expr t) ('BaseStringType si)
forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
si (StringSeq (Expr t) si
-> StringSeq (Expr t) si -> StringSeq (Expr t) si
forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringSeq e si -> StringSeq e si
SSeq.append StringSeq (Expr t) si
xs (StringInfoRepr si
-> Expr t ('BaseStringType si) -> StringSeq (Expr t) si
forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e, IsExpr e) =>
StringInfoRepr si -> e (BaseStringType si) -> StringSeq e si
SSeq.singleton StringInfoRepr si
si SymString (ExprBuilder t st fs) si
Expr t ('BaseStringType si)
y))

    | Just (StringAppend StringInfoRepr si
si StringSeq (Expr t) si
ys) <- Expr t (BaseStringType si)
-> Maybe (App (Expr t) (BaseStringType si))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y
    = ExprBuilder t st fs
-> App (Expr t) ('BaseStringType si)
-> IO (Expr t ('BaseStringType si))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseStringType si)
 -> IO (Expr t ('BaseStringType si)))
-> App (Expr t) ('BaseStringType si)
-> IO (Expr t ('BaseStringType si))
forall a b. (a -> b) -> a -> b
$ StringInfoRepr si
-> StringSeq (Expr t) si -> App (Expr t) ('BaseStringType si)
forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
si (StringSeq (Expr t) si
-> StringSeq (Expr t) si -> StringSeq (Expr t) si
forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringSeq e si -> StringSeq e si
SSeq.append (StringInfoRepr si
-> Expr t ('BaseStringType si) -> StringSeq (Expr t) si
forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e, IsExpr e) =>
StringInfoRepr si -> e (BaseStringType si) -> StringSeq e si
SSeq.singleton StringInfoRepr si
si SymString (ExprBuilder t st fs) si
Expr t ('BaseStringType si)
x) StringSeq (Expr t) si
ys)

    | Bool
otherwise
    = let si :: StringInfoRepr si
si = Expr t (BaseStringType si) -> StringInfoRepr si
forall (si :: StringInfo).
Expr t (BaseStringType si) -> StringInfoRepr si
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> StringInfoRepr si
stringInfo SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x in
      ExprBuilder t st fs
-> App (Expr t) (BaseStringType si)
-> IO (Expr t (BaseStringType si))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseStringType si)
 -> IO (Expr t (BaseStringType si)))
-> App (Expr t) (BaseStringType si)
-> IO (Expr t (BaseStringType si))
forall a b. (a -> b) -> a -> b
$ StringInfoRepr si
-> StringSeq (Expr t) si -> App (Expr t) (BaseStringType si)
forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
si (StringSeq (Expr t) si
-> StringSeq (Expr t) si -> StringSeq (Expr t) si
forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringSeq e si -> StringSeq e si
SSeq.append (StringInfoRepr si
-> Expr t (BaseStringType si) -> StringSeq (Expr t) si
forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e, IsExpr e) =>
StringInfoRepr si -> e (BaseStringType si) -> StringSeq e si
SSeq.singleton StringInfoRepr si
si SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x) (StringInfoRepr si
-> Expr t (BaseStringType si) -> StringSeq (Expr t) si
forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e, IsExpr e) =>
StringInfoRepr si -> e (BaseStringType si) -> StringSeq e si
SSeq.singleton StringInfoRepr si
si SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
y))

  stringLength :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> IO (SymInteger (ExprBuilder t st fs))
stringLength ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x
    | Just StringLiteral si
x' <- Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (si :: StringInfo).
Expr t (BaseStringType si) -> Maybe (StringLiteral si)
forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    = ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (StringLiteral si -> Integer
forall (si :: StringInfo). StringLiteral si -> Integer
stringLitLength StringLiteral si
x')

    | Just (StringAppend StringInfoRepr si
_si StringSeq (Expr t) si
xs) <- Expr t (BaseStringType si)
-> Maybe (App (Expr t) (BaseStringType si))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x
    = do let f :: Expr t BaseIntegerType
-> StringSeqEntry (Expr t) si -> IO (Expr t BaseIntegerType)
f Expr t BaseIntegerType
sm (SSeq.StringSeqLiteral StringLiteral si
l) = ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intAdd ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
sm (Expr t BaseIntegerType -> IO (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType) -> IO (Expr t BaseIntegerType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (StringLiteral si -> Integer
forall (si :: StringInfo). StringLiteral si -> Integer
stringLitLength StringLiteral si
l)
             f Expr t BaseIntegerType
sm (SSeq.StringSeqTerm Expr t ('BaseStringType si)
t)    = ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intAdd ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
sm (Expr t BaseIntegerType -> IO (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType) -> IO (Expr t BaseIntegerType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t ('BaseStringType si) -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si) -> App e BaseIntegerType
StringLength Expr t ('BaseStringType si)
t)
         Expr t BaseIntegerType
z  <- ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
0
         (Expr t BaseIntegerType
 -> StringSeqEntry (Expr t) si -> IO (Expr t BaseIntegerType))
-> Expr t BaseIntegerType
-> [StringSeqEntry (Expr t) si]
-> IO (Expr t BaseIntegerType)
forall (t :: Type -> Type) (m :: Type -> Type) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Expr t BaseIntegerType
-> StringSeqEntry (Expr t) si -> IO (Expr t BaseIntegerType)
f Expr t BaseIntegerType
z (StringSeq (Expr t) si -> [StringSeqEntry (Expr t) si]
forall (e :: BaseType -> Type) (si :: StringInfo).
StringSeq e si -> [StringSeqEntry e si]
SSeq.toList StringSeq (Expr t) si
xs)

    | Bool
otherwise
    = ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType))
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$ Expr t (BaseStringType si) -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si) -> App e BaseIntegerType
StringLength SymString (ExprBuilder t st fs) si
Expr t (BaseStringType si)
x

  --------------------------------------------------------------------
  -- Symbolic array operations

  constantArray :: forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> Assignment BaseTypeRepr (idx ::> tp)
-> SymExpr (ExprBuilder t st fs) b
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) b)
constantArray ExprBuilder t st fs
sym Assignment BaseTypeRepr (idx ::> tp)
idxRepr SymExpr (ExprBuilder t st fs) b
v =
    ExprBuilder t st fs
-> App (Expr t) ('BaseArrayType (idx ::> tp) b)
-> IO (Expr t ('BaseArrayType (idx ::> tp) b))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseArrayType (idx ::> tp) b)
 -> IO (Expr t ('BaseArrayType (idx ::> tp) b)))
-> App (Expr t) ('BaseArrayType (idx ::> tp) b)
-> IO (Expr t ('BaseArrayType (idx ::> tp) b))
forall a b. (a -> b) -> a -> b
$ Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr b
-> Expr t b
-> App (Expr t) ('BaseArrayType (idx ::> tp) b)
forall (i :: Ctx BaseType) (tp1 :: BaseType) (b :: BaseType)
       (e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> tp1)
-> BaseTypeRepr b -> e b -> App e ('BaseArrayType (i ::> tp1) b)
ConstantArray Assignment BaseTypeRepr (idx ::> tp)
idxRepr (Expr t b -> BaseTypeRepr b
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) b
Expr t b
v) SymExpr (ExprBuilder t st fs) b
Expr t b
v

  arrayFromFn :: forall (idx :: Ctx BaseType) (itp :: BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) ret
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) ret)
arrayFromFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (idx ::> itp) ret
fn = do
    ExprBuilder t st fs
-> NonceApp t (Expr t) ('BaseArrayType (idx ::> itp) ret)
-> IO (Expr t ('BaseArrayType (idx ::> itp) ret))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) ('BaseArrayType (idx ::> itp) ret)
 -> IO (Expr t ('BaseArrayType (idx ::> itp) ret)))
-> NonceApp t (Expr t) ('BaseArrayType (idx ::> itp) ret)
-> IO (Expr t ('BaseArrayType (idx ::> itp) ret))
forall a b. (a -> b) -> a -> b
$ ExprSymFn t (idx ::> itp) ret
-> NonceApp t (Expr t) ('BaseArrayType (idx ::> itp) ret)
forall t (idx :: Ctx BaseType) (itp :: BaseType) (ret :: BaseType)
       (e :: BaseType -> Type).
ExprSymFn t (idx ::> itp) ret
-> NonceApp t e ('BaseArrayType (idx ::> itp) ret)
ArrayFromFn SymFn (ExprBuilder t st fs) (idx ::> itp) ret
ExprSymFn t (idx ::> itp) ret
fn

  arrayMap :: forall (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
       (idx :: Ctx BaseType) (itp :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
     (ctx ::> d)
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) r)
arrayMap ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
f Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
arrays
      -- Cancel out integerToReal (realToInteger a)
    | Just MatlabSolverFn (Expr t) (ctx ::> d) r
IntegerToRealFn  <- ExprSymFn t (ctx ::> d) r
-> Maybe (MatlabSolverFn (Expr t) (ctx ::> d) r)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn SymFn (ExprBuilder t st fs) (ctx ::> d) r
ExprSymFn t (ctx ::> d) r
f
    , Just (MapOverArrays ExprSymFn t (ctx ::> d) r
g Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- Expr t (BaseArrayType (idx ::> itp) BaseIntegerType)
-> Maybe
     (NonceApp t (Expr t) (BaseArrayType (idx ::> itp) BaseIntegerType))
forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType
-> Expr t (BaseArrayType (idx ::> itp) BaseIntegerType)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment
  (ArrayResultWrapper (Expr t) (idx ::> itp))
  (EmptyCtx '::> BaseIntegerType)
arraysAssignment
  (ArrayResultWrapper (Expr t) (idx ::> itp))
  (EmptyCtx '::> BaseIntegerType)
-> Getting
     (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
     (Assignment
        (ArrayResultWrapper (Expr t) (idx ::> itp))
        (EmptyCtx '::> BaseIntegerType))
     (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
-> ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType
forall s a. s -> Getting a s a -> a
^.Getting
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp))
     (EmptyCtx '::> BaseIntegerType))
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp))
     (EmptyCtx '::> BaseIntegerType))
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp))
     (EmptyCtx '::> BaseIntegerType))
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
_1))
    , Just MatlabSolverFn (Expr t) (ctx ::> d) r
RealToIntegerFn <- ExprSymFn t (ctx ::> d) r
-> Maybe (MatlabSolverFn (Expr t) (ctx ::> d) r)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn ExprSymFn t (ctx ::> d) r
g =
      Expr t (BaseArrayType (idx ::> itp) BaseRealType)
-> IO (Expr t (BaseArrayType (idx ::> itp) BaseRealType))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (idx ::> itp) BaseRealType)
 -> IO (Expr t (BaseArrayType (idx ::> itp) BaseRealType)))
-> Expr t (BaseArrayType (idx ::> itp) BaseRealType)
-> IO (Expr t (BaseArrayType (idx ::> itp) BaseRealType))
forall a b. (a -> b) -> a -> b
$! ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType
-> Expr t (BaseArrayType (idx ::> itp) BaseRealType)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
argsAssignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Getting
     (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
     (Assignment
        (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d))
     (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
-> ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType
forall s a. s -> Getting a s a -> a
^.Getting
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d))
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d))
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d))
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
_1)
      -- Cancel out realToInteger (integerToReal a)
    | Just MatlabSolverFn (Expr t) (ctx ::> d) r
RealToIntegerFn  <- ExprSymFn t (ctx ::> d) r
-> Maybe (MatlabSolverFn (Expr t) (ctx ::> d) r)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn SymFn (ExprBuilder t st fs) (ctx ::> d) r
ExprSymFn t (ctx ::> d) r
f
    , Just (MapOverArrays ExprSymFn t (ctx ::> d) r
g Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- Expr t (BaseArrayType (idx ::> itp) BaseRealType)
-> Maybe
     (NonceApp t (Expr t) (BaseArrayType (idx ::> itp) BaseRealType))
forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType
-> Expr t (BaseArrayType (idx ::> itp) BaseRealType)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment
  (ArrayResultWrapper (Expr t) (idx ::> itp))
  (EmptyCtx '::> BaseRealType)
arraysAssignment
  (ArrayResultWrapper (Expr t) (idx ::> itp))
  (EmptyCtx '::> BaseRealType)
-> Getting
     (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
     (Assignment
        (ArrayResultWrapper (Expr t) (idx ::> itp))
        (EmptyCtx '::> BaseRealType))
     (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
-> ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType
forall s a. s -> Getting a s a -> a
^.Getting
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp))
     (EmptyCtx '::> BaseRealType))
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp))
     (EmptyCtx '::> BaseRealType))
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp))
     (EmptyCtx '::> BaseRealType))
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseRealType)
_1))
    , Just MatlabSolverFn (Expr t) (ctx ::> d) r
IntegerToRealFn <- ExprSymFn t (ctx ::> d) r
-> Maybe (MatlabSolverFn (Expr t) (ctx ::> d) r)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn ExprSymFn t (ctx ::> d) r
g =
      Expr t (BaseArrayType (idx ::> itp) BaseIntegerType)
-> IO (Expr t (BaseArrayType (idx ::> itp) BaseIntegerType))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (idx ::> itp) BaseIntegerType)
 -> IO (Expr t (BaseArrayType (idx ::> itp) BaseIntegerType)))
-> Expr t (BaseArrayType (idx ::> itp) BaseIntegerType)
-> IO (Expr t (BaseArrayType (idx ::> itp) BaseIntegerType))
forall a b. (a -> b) -> a -> b
$! ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType
-> Expr t (BaseArrayType (idx ::> itp) BaseIntegerType)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
argsAssignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Getting
     (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
     (Assignment
        (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d))
     (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
-> ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType
forall s a. s -> Getting a s a -> a
^.Getting
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d))
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d))
  (Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d))
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
  (ArrayResultWrapper (Expr t) (idx ::> itp) BaseIntegerType)
_1)

    -- When the array is an update of concrete entries, map over the entries.
    | Set (Assignment IndexLit (idx ::> itp))
s <- Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Set (Assignment IndexLit (idx ::> itp))
forall t (i :: Ctx BaseType) (ctx :: Ctx BaseType).
Assignment (ArrayResultWrapper (Expr t) i) ctx
-> Set (Assignment IndexLit i)
concreteArrayEntries Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays
    , Bool -> Bool
not (Set (Assignment IndexLit (idx ::> itp)) -> Bool
forall a. Set a -> Bool
Set.null Set (Assignment IndexLit (idx ::> itp))
s) = do
        -- Distribute over base values.
        --
        -- The underlyingArrayMapElf function strings a top-level arrayMap value.
        --
        -- It is ok because we don't care what the value of base is at any index
        -- in s.
        Expr t ('BaseArrayType (idx ::> itp) r)
base <- ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
     (ctx ::> d)
-> IO
     (SymExpr (ExprBuilder t st fs) ('BaseArrayType (idx ::> itp) r))
forall sym (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
       (idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr sym) (idx ::> itp)) (ctx ::> d)
-> IO (SymArray sym (idx ::> itp) r)
forall (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
       (idx :: Ctx BaseType) (itp :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
     (ctx ::> d)
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) r)
arrayMap ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
f ((forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (idx ::> itp) x
 -> ArrayResultWrapper (Expr t) (idx ::> itp) x)
-> forall (x :: Ctx BaseType).
   Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) x
   -> Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) x
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
fmapFC ArrayResultWrapper (Expr t) (idx ::> itp) x
-> ArrayResultWrapper (Expr t) (idx ::> itp) x
forall t (i :: Ctx BaseType) (tp :: BaseType).
ArrayResultWrapper (Expr t) i tp
-> ArrayResultWrapper (Expr t) i tp
forall (x :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) x
-> ArrayResultWrapper (Expr t) (idx ::> itp) x
underlyingArrayMapExpr Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays)
        BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
ret <- BaseTypeRepr ('BaseArrayType (idx ::> itp) r)
-> IO (BaseTypeRepr ('BaseArrayType (idx ::> itp) r))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t ('BaseArrayType (idx ::> itp) r)
-> BaseTypeRepr ('BaseArrayType (idx ::> itp) r)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t ('BaseArrayType (idx ::> itp) r)
base)

        -- This lookups a given index in an array used as an argument.
        let evalArgs :: Ctx.Assignment IndexLit (idx ::> itp)
                        -- ^ A representatio of the concrete index (if defined).
                        -> Ctx.Assignment (Expr t)  (idx ::> itp)
                           -- ^ The index to use.
                        -> ArrayResultWrapper (Expr t) (idx ::> itp) d
                           -- ^ The array to get the value at.
                        -> IO (Expr t d)
            evalArgs :: forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
Assignment IndexLit (idx ::> itp)
-> Assignment (Expr t) (idx ::> itp)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
-> IO (Expr t d)
evalArgs Assignment IndexLit (idx ::> itp)
const_idx Assignment (Expr t) (idx ::> itp)
sym_idx ArrayResultWrapper (Expr t) (idx ::> itp) d
a = do
              ExprBuilder t st fs
-> Expr t (BaseArrayType (idx ::> itp) d)
-> Maybe (Assignment IndexLit (idx ::> itp))
-> Assignment (Expr t) (idx ::> itp)
-> IO (Expr t d)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym (ArrayResultWrapper (Expr t) (idx ::> itp) d
-> Expr t (BaseArrayType (idx ::> itp) d)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) (idx ::> itp) d
a) (Assignment IndexLit (idx ::> itp)
-> Maybe (Assignment IndexLit (idx ::> itp))
forall a. a -> Maybe a
Just Assignment IndexLit (idx ::> itp)
const_idx) Assignment (Expr t) (idx ::> itp)
sym_idx
        let evalIndex :: ExprSymFn t ctx ret
                      -> Ctx.Assignment (ArrayResultWrapper (Expr t) (i::>itp)) ctx
                      -> Ctx.Assignment IndexLit (i::>itp)
                      -> IO (Expr t ret)
            evalIndex :: forall (ctx :: Ctx BaseType) (ret :: BaseType) (i :: Ctx BaseType)
       (itp :: BaseType).
ExprSymFn t ctx ret
-> Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
-> Assignment IndexLit (i ::> itp)
-> IO (Expr t ret)
evalIndex ExprSymFn t ctx ret
g Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
arrays0 Assignment IndexLit (i ::> itp)
const_idx = do
              Assignment (Expr t) (i ::> itp)
sym_idx <- (forall (x :: BaseType). IndexLit x -> IO (Expr t x))
-> forall (x :: Ctx BaseType).
   Assignment IndexLit x -> IO (Assignment (Expr t) x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC (ExprBuilder t st fs
-> IndexLit x -> IO (SymExpr (ExprBuilder t st fs) x)
forall sym (idx :: BaseType).
IsExprBuilder sym =>
sym -> IndexLit idx -> IO (SymExpr sym idx)
indexLit ExprBuilder t st fs
sym) Assignment IndexLit (i ::> itp)
const_idx
              ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) ctx ret
-> Assignment (SymExpr (ExprBuilder t st fs)) ctx
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) args ret
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
applySymFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) ctx ret
ExprSymFn t ctx ret
g (Assignment (Expr t) ctx -> IO (Expr t ret))
-> IO (Assignment (Expr t) ctx) -> IO (Expr t ret)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (i ::> itp) x -> IO (Expr t x))
-> forall (x :: Ctx BaseType).
   Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) x
   -> IO (Assignment (Expr t) x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC (Assignment IndexLit (i ::> itp)
-> Assignment (Expr t) (i ::> itp)
-> ArrayResultWrapper (Expr t) (i ::> itp) x
-> IO (Expr t x)
forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
Assignment IndexLit (idx ::> itp)
-> Assignment (Expr t) (idx ::> itp)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
-> IO (Expr t d)
evalArgs Assignment IndexLit (i ::> itp)
const_idx Assignment (Expr t) (i ::> itp)
sym_idx) Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
arrays0
        ArrayUpdateMap (Expr t) (idx ::> itp) xs
m <- BaseTypeRepr xs
-> [(Assignment IndexLit (idx ::> itp), Expr t xs)]
-> ArrayUpdateMap (Expr t) (idx ::> itp) xs
forall (e :: BaseType -> Type) (tp :: BaseType)
       (ctx :: Ctx BaseType).
(HasAbsValue e, HashableF e) =>
BaseTypeRepr tp
-> [(Assignment IndexLit ctx, e tp)] -> ArrayUpdateMap e ctx tp
AUM.fromAscList BaseTypeRepr xs
ret ([(Assignment IndexLit (idx ::> itp), Expr t xs)]
 -> ArrayUpdateMap (Expr t) (idx ::> itp) xs)
-> IO [(Assignment IndexLit (idx ::> itp), Expr t xs)]
-> IO (ArrayUpdateMap (Expr t) (idx ::> itp) xs)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Assignment IndexLit (idx ::> itp)
 -> IO (Assignment IndexLit (idx ::> itp), Expr t xs))
-> [Assignment IndexLit (idx ::> itp)]
-> IO [(Assignment IndexLit (idx ::> itp), Expr t xs)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (\Assignment IndexLit (idx ::> itp)
k -> (Assignment IndexLit (idx ::> itp)
k,) (Expr t xs -> (Assignment IndexLit (idx ::> itp), Expr t xs))
-> IO (Expr t xs)
-> IO (Assignment IndexLit (idx ::> itp), Expr t xs)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprSymFn t (ctx ::> d) xs
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Assignment IndexLit (idx ::> itp)
-> IO (Expr t xs)
forall (ctx :: Ctx BaseType) (ret :: BaseType) (i :: Ctx BaseType)
       (itp :: BaseType).
ExprSymFn t ctx ret
-> Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
-> Assignment IndexLit (i ::> itp)
-> IO (Expr t ret)
evalIndex SymFn (ExprBuilder t st fs) (ctx ::> d) r
ExprSymFn t (ctx ::> d) xs
f Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays Assignment IndexLit (idx ::> itp)
k) (Set (Assignment IndexLit (idx ::> itp))
-> [Assignment IndexLit (idx ::> itp)]
forall a. Set a -> [a]
Set.toAscList Set (Assignment IndexLit (idx ::> itp))
s)
        ExprBuilder t st fs
-> ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) xs
-> SymArray (ExprBuilder t st fs) (idx ::> itp) xs
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) xs)
forall sym (idx :: Ctx BaseType) (itp :: BaseType)
       (tp :: BaseType).
IsExprBuilder sym =>
sym
-> ArrayUpdateMap (SymExpr sym) (idx ::> itp) tp
-> SymArray sym (idx ::> itp) tp
-> IO (SymArray sym (idx ::> itp) tp)
forall (idx :: Ctx BaseType) (itp :: BaseType) (tp :: BaseType).
ExprBuilder t st fs
-> ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
-> SymArray (ExprBuilder t st fs) (idx ::> itp) tp
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) tp)
arrayUpdateAtIdxLits ExprBuilder t st fs
sym ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) xs
ArrayUpdateMap (Expr t) (idx ::> itp) xs
m SymArray (ExprBuilder t st fs) (idx ::> itp) xs
Expr t ('BaseArrayType (idx ::> itp) r)
base
      -- When entries are constants, then just evaluate constant.
    | Just Assignment (Expr t) (ctx ::> d)
cns <-  (forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (idx ::> itp) x -> Maybe (Expr t x))
-> forall (x :: Ctx BaseType).
   Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) x
   -> Maybe (Assignment (Expr t) x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC (\ArrayResultWrapper (Expr t) (idx ::> itp) x
a -> Expr t (BaseArrayType (idx ::> itp) x) -> Maybe (Expr t x)
forall (idx :: Ctx BaseType) (bt :: BaseType).
Expr t (BaseArrayType idx bt) -> Maybe (Expr t bt)
forall (e :: BaseType -> Type) (idx :: Ctx BaseType)
       (bt :: BaseType).
IsExpr e =>
e (BaseArrayType idx bt) -> Maybe (e bt)
asConstantArray (ArrayResultWrapper (Expr t) (idx ::> itp) x
-> Expr t (BaseArrayType (idx ::> itp) x)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) (idx ::> itp) x
a)) Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays = do
      Expr t r
r <- ExprBuilder t st fs
-> ExprSymFn t (ctx ::> d) r
-> Assignment (Expr t) (ctx ::> d)
-> IO (Expr t r)
forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
ExprSymFn t (ctx ::> d) r
f Assignment (Expr t) (ctx ::> d)
cns
      case Expr t (BaseArrayType (idx ::> itp) d)
-> BaseTypeRepr (BaseArrayType (idx ::> itp) d)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType (ArrayResultWrapper (Expr t) (idx ::> itp) d
-> Expr t (BaseArrayType (idx ::> itp) d)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays)) of
        BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idxRepr BaseTypeRepr xs
_ -> do
          ExprBuilder t st fs
-> Assignment BaseTypeRepr (idx ::> tp)
-> SymExpr (ExprBuilder t st fs) r
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) r)
forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> Assignment BaseTypeRepr (idx ::> tp)
-> SymExpr sym b
-> IO (SymArray sym (idx ::> tp) b)
forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> Assignment BaseTypeRepr (idx ::> tp)
-> SymExpr (ExprBuilder t st fs) b
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) b)
constantArray ExprBuilder t st fs
sym Assignment BaseTypeRepr (idx ::> tp)
idxRepr SymExpr (ExprBuilder t st fs) r
Expr t r
r

    | Bool
otherwise = do
      let idx :: Assignment BaseTypeRepr (idx ::> itp)
idx = BaseTypeRepr (BaseArrayType (idx ::> itp) d)
-> Assignment BaseTypeRepr (idx ::> itp)
forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
BaseTypeRepr (BaseArrayType (idx ::> itp) d)
-> Assignment BaseTypeRepr (idx ::> itp)
arrayResultIdxType (Expr t (BaseArrayType (idx ::> itp) d)
-> BaseTypeRepr (BaseArrayType (idx ::> itp) d)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType (ArrayResultWrapper (Expr t) (idx ::> itp) d
-> Expr t (BaseArrayType (idx ::> itp) d)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays)))
      ExprBuilder t st fs
-> NonceApp t (Expr t) ('BaseArrayType (idx ::> itp) r)
-> IO (Expr t ('BaseArrayType (idx ::> itp) r))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) ('BaseArrayType (idx ::> itp) r)
 -> IO (Expr t ('BaseArrayType (idx ::> itp) r)))
-> NonceApp t (Expr t) ('BaseArrayType (idx ::> itp) r)
-> IO (Expr t ('BaseArrayType (idx ::> itp) r))
forall a b. (a -> b) -> a -> b
$ ExprSymFn t (ctx ::> d) r
-> Assignment BaseTypeRepr (idx ::> itp)
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> NonceApp t (Expr t) ('BaseArrayType (idx ::> itp) r)
forall t (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
       (idx :: Ctx BaseType) (itp :: BaseType) (e :: BaseType -> Type).
ExprSymFn t (ctx ::> d) r
-> Assignment BaseTypeRepr (idx ::> itp)
-> Assignment (ArrayResultWrapper e (idx ::> itp)) (ctx ::> d)
-> NonceApp t e ('BaseArrayType (idx ::> itp) r)
MapOverArrays SymFn (ExprBuilder t st fs) (ctx ::> d) r
ExprSymFn t (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
idx Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays

  arrayUpdate :: forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
-> SymExpr (ExprBuilder t st fs) b
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) b)
arrayUpdate ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (idx ::> tp) b
arr Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
i SymExpr (ExprBuilder t st fs) b
v
      -- Update at concrete index.
    | Just Assignment IndexLit (idx ::> tp)
ci <- Assignment (Expr t) (idx ::> tp)
-> Maybe (Assignment IndexLit (idx ::> tp))
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
IsExpr e =>
Assignment e ctx -> Maybe (Assignment IndexLit ctx)
asConcreteIndices Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
Assignment (Expr t) (idx ::> tp)
i =
      case Expr t (BaseArrayType (idx ::> tp) b)
-> Maybe (App (Expr t) (BaseArrayType (idx ::> tp) b))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymArray (ExprBuilder t st fs) (idx ::> tp) b
Expr t (BaseArrayType (idx ::> tp) b)
arr of
        Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
idx BaseTypeRepr tp1
tp ArrayUpdateMap (Expr t) (i ::> itp) tp1
m Expr t ('BaseArrayType (i ::> itp) tp1)
def) -> do
          let new_map :: ArrayUpdateMap (Expr t) (idx ::> tp) tp1
new_map =
                case Expr t ('BaseArrayType (i ::> itp) tp1)
-> Maybe (App (Expr t) ('BaseArrayType (i ::> itp) tp1))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t ('BaseArrayType (i ::> itp) tp1)
def of
                  Just (ConstantArray Assignment BaseTypeRepr (i ::> tp1)
_ BaseTypeRepr b
_ Expr t b
cns) | SymExpr (ExprBuilder t st fs) b
Expr t b
v Expr t b -> Expr t b -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t b
cns -> Assignment IndexLit (idx ::> tp)
-> ArrayUpdateMap (Expr t) (idx ::> tp) tp1
-> ArrayUpdateMap (Expr t) (idx ::> tp) tp1
forall (ctx :: Ctx BaseType) (e :: BaseType -> Type)
       (tp :: BaseType).
Assignment IndexLit ctx
-> ArrayUpdateMap e ctx tp -> ArrayUpdateMap e ctx tp
AUM.delete Assignment IndexLit (idx ::> tp)
ci ArrayUpdateMap (Expr t) (idx ::> tp) tp1
ArrayUpdateMap (Expr t) (i ::> itp) tp1
m
                  Maybe (App (Expr t) ('BaseArrayType (i ::> itp) tp1))
_ -> BaseTypeRepr tp1
-> Assignment IndexLit (idx ::> tp)
-> Expr t tp1
-> ArrayUpdateMap (Expr t) (idx ::> tp) tp1
-> ArrayUpdateMap (Expr t) (idx ::> tp) tp1
forall (e :: BaseType -> Type) (tp :: BaseType)
       (ctx :: Ctx BaseType).
(HashableF e, HasAbsValue e) =>
BaseTypeRepr tp
-> Assignment IndexLit ctx
-> e tp
-> ArrayUpdateMap e ctx tp
-> ArrayUpdateMap e ctx tp
AUM.insert BaseTypeRepr tp1
tp Assignment IndexLit (idx ::> tp)
ci SymExpr (ExprBuilder t st fs) b
Expr t tp1
v ArrayUpdateMap (Expr t) (idx ::> tp) tp1
ArrayUpdateMap (Expr t) (i ::> itp) tp1
m
          ExprBuilder t st fs
-> App (Expr t) ('BaseArrayType (i ::> itp) tp1)
-> IO (Expr t ('BaseArrayType (i ::> itp) tp1))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseArrayType (i ::> itp) tp1)
 -> IO (Expr t ('BaseArrayType (i ::> itp) tp1)))
-> App (Expr t) ('BaseArrayType (i ::> itp) tp1)
-> IO (Expr t ('BaseArrayType (i ::> itp) tp1))
forall a b. (a -> b) -> a -> b
$ Assignment BaseTypeRepr (i ::> itp)
-> BaseTypeRepr tp1
-> ArrayUpdateMap (Expr t) (i ::> itp) tp1
-> Expr t ('BaseArrayType (i ::> itp) tp1)
-> App (Expr t) ('BaseArrayType (i ::> itp) tp1)
forall (i :: Ctx BaseType) (itp :: BaseType) (tp1 :: BaseType)
       (e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> itp)
-> BaseTypeRepr tp1
-> ArrayUpdateMap e (i ::> itp) tp1
-> e (BaseArrayType (i ::> itp) tp1)
-> App e (BaseArrayType (i ::> itp) tp1)
ArrayMap Assignment BaseTypeRepr (i ::> itp)
idx BaseTypeRepr tp1
tp ArrayUpdateMap (Expr t) (idx ::> tp) tp1
ArrayUpdateMap (Expr t) (i ::> itp) tp1
new_map Expr t ('BaseArrayType (i ::> itp) tp1)
def
        Maybe (App (Expr t) (BaseArrayType (idx ::> tp) b))
_ -> do
          let idx :: Assignment BaseTypeRepr (idx ::> tp)
idx = (forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp)
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> Assignment BaseTypeRepr x
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
fmapFC Expr t x -> BaseTypeRepr x
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType  Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
Assignment (Expr t) (idx ::> tp)
i
          let bRepr :: BaseTypeRepr b
bRepr = Expr t b -> BaseTypeRepr b
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) b
Expr t b
v
          let new_map :: ArrayUpdateMap (Expr t) (idx ::> tp) b
new_map = BaseTypeRepr b
-> Assignment IndexLit (idx ::> tp)
-> Expr t b
-> ArrayUpdateMap (Expr t) (idx ::> tp) b
forall (e :: BaseType -> Type) (tp :: BaseType)
       (ctx :: Ctx BaseType).
(HashableF e, HasAbsValue e) =>
BaseTypeRepr tp
-> Assignment IndexLit ctx -> e tp -> ArrayUpdateMap e ctx tp
AUM.singleton BaseTypeRepr b
bRepr Assignment IndexLit (idx ::> tp)
ci SymExpr (ExprBuilder t st fs) b
Expr t b
v
          ExprBuilder t st fs
-> App (Expr t) (BaseArrayType (idx ::> tp) b)
-> IO (Expr t (BaseArrayType (idx ::> tp) b))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseArrayType (idx ::> tp) b)
 -> IO (Expr t (BaseArrayType (idx ::> tp) b)))
-> App (Expr t) (BaseArrayType (idx ::> tp) b)
-> IO (Expr t (BaseArrayType (idx ::> tp) b))
forall a b. (a -> b) -> a -> b
$ Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr b
-> ArrayUpdateMap (Expr t) (idx ::> tp) b
-> Expr t (BaseArrayType (idx ::> tp) b)
-> App (Expr t) (BaseArrayType (idx ::> tp) b)
forall (i :: Ctx BaseType) (itp :: BaseType) (tp1 :: BaseType)
       (e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> itp)
-> BaseTypeRepr tp1
-> ArrayUpdateMap e (i ::> itp) tp1
-> e (BaseArrayType (i ::> itp) tp1)
-> App e (BaseArrayType (i ::> itp) tp1)
ArrayMap Assignment BaseTypeRepr (idx ::> tp)
idx BaseTypeRepr b
bRepr ArrayUpdateMap (Expr t) (idx ::> tp) b
new_map SymArray (ExprBuilder t st fs) (idx ::> tp) b
Expr t (BaseArrayType (idx ::> tp) b)
arr
    | Bool
otherwise = do
      let bRepr :: BaseTypeRepr b
bRepr = Expr t b -> BaseTypeRepr b
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) b
Expr t b
v
      ExprBuilder t st fs
-> App (Expr t) (BaseArrayType (idx ::> tp) b)
-> IO (Expr t (BaseArrayType (idx ::> tp) b))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (BaseTypeRepr b
-> Assignment BaseTypeRepr (idx ::> tp)
-> Expr t (BaseArrayType (idx ::> tp) b)
-> Assignment (Expr t) (idx ::> tp)
-> Expr t b
-> App (Expr t) (BaseArrayType (idx ::> tp) b)
forall (b :: BaseType) (i :: Ctx BaseType) (tp1 :: BaseType)
       (e :: BaseType -> Type).
BaseTypeRepr b
-> Assignment BaseTypeRepr (i ::> tp1)
-> e (BaseArrayType (i ::> tp1) b)
-> Assignment e (i ::> tp1)
-> e b
-> App e (BaseArrayType (i ::> tp1) b)
UpdateArray BaseTypeRepr b
bRepr ((forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp)
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> Assignment BaseTypeRepr x
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
fmapFC Expr t x -> BaseTypeRepr x
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
Assignment (Expr t) (idx ::> tp)
i)  SymArray (ExprBuilder t st fs) (idx ::> tp) b
Expr t (BaseArrayType (idx ::> tp) b)
arr Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
Assignment (Expr t) (idx ::> tp)
i SymExpr (ExprBuilder t st fs) b
Expr t b
v)

  arrayLookup :: forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
-> IO (SymExpr (ExprBuilder t st fs) b)
arrayLookup ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (idx ::> tp) b
arr Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
idx =
    ExprBuilder t st fs
-> Expr t (BaseArrayType (idx ::> tp) b)
-> Maybe (Assignment IndexLit (idx ::> tp))
-> Assignment (Expr t) (idx ::> tp)
-> IO (Expr t b)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (idx ::> tp) b
Expr t (BaseArrayType (idx ::> tp) b)
arr (Assignment (Expr t) (idx ::> tp)
-> Maybe (Assignment IndexLit (idx ::> tp))
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
IsExpr e =>
Assignment e ctx -> Maybe (Assignment IndexLit ctx)
asConcreteIndices Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
Assignment (Expr t) (idx ::> tp)
idx) Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
Assignment (Expr t) (idx ::> tp)
idx

  arrayCopy :: forall (w :: Natural) (a :: BaseType).
(1 <= w) =>
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a)
arrayCopy ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
dest_arr SymBV (ExprBuilder t st fs) w
dest_idx SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
src_arr SymBV (ExprBuilder t st fs) w
src_idx SymBV (ExprBuilder t st fs) w
len = case Expr t (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> BaseTypeRepr (BaseArrayType (SingleCtx (BaseBVType w)) a)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
Expr t (BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr of
    (BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
a_repr) -> do
      Expr t (BaseBVType w)
dest_end_idx <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
dest_idx SymBV (ExprBuilder t st fs) w
len
      Expr t (BaseBVType w)
src_end_idx <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
src_idx SymBV (ExprBuilder t st fs) w
len
      ExprBuilder t st fs
-> App (Expr t) ('BaseArrayType (SingleCtx (BaseBVType w)) xs)
-> IO (Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) xs))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (NatRepr w
-> BaseTypeRepr xs
-> Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) xs)
-> Expr t (BaseBVType w)
-> Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) xs)
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) ('BaseArrayType (SingleCtx (BaseBVType w)) xs)
forall (w :: Natural) (a :: BaseType) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> BaseTypeRepr a
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> App e (BaseArrayType (SingleCtx (BaseBVType w)) a)
CopyArray (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
dest_idx) BaseTypeRepr xs
a_repr SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) xs)
dest_arr SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
dest_idx SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) xs)
src_arr SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
src_idx SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
len Expr t (BaseBVType w)
dest_end_idx Expr t (BaseBVType w)
src_end_idx)

  arraySet :: forall (w :: Natural) (a :: BaseType).
(1 <= w) =>
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymExpr (ExprBuilder t st fs) a
-> SymBV (ExprBuilder t st fs) w
-> IO (SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a)
arraySet ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
arr SymBV (ExprBuilder t st fs) w
idx SymExpr (ExprBuilder t st fs) a
val SymBV (ExprBuilder t st fs) w
len = do
    Expr t (BaseBVType w)
end_idx <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
idx SymBV (ExprBuilder t st fs) w
len
    ExprBuilder t st fs
-> App (Expr t) ('BaseArrayType (SingleCtx (BaseBVType w)) a)
-> IO (Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (NatRepr w
-> BaseTypeRepr a
-> Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
-> Expr t (BaseBVType w)
-> Expr t a
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) ('BaseArrayType (SingleCtx (BaseBVType w)) a)
forall (w :: Natural) (a :: BaseType) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> BaseTypeRepr a
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e a
-> e (BaseBVType w)
-> e (BaseBVType w)
-> App e (BaseArrayType (SingleCtx (BaseBVType w)) a)
SetArray (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
idx) (Expr t a -> BaseTypeRepr a
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) a
Expr t a
val) SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
idx SymExpr (ExprBuilder t st fs) a
Expr t a
val SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
len Expr t (BaseBVType w)
end_idx)

  arrayRangeEq :: forall (w :: Natural) (a :: BaseType).
(1 <= w) =>
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
arrayRangeEq ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
x_arr SymBV (ExprBuilder t st fs) w
x_idx SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
y_arr SymBV (ExprBuilder t st fs) w
y_idx SymBV (ExprBuilder t st fs) w
len = case Expr t (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> BaseTypeRepr (BaseArrayType (SingleCtx (BaseBVType w)) a)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
Expr t (BaseArrayType (SingleCtx (BaseBVType w)) a)
x_arr of
    (BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
a_repr) -> do
      Expr t (BaseBVType w)
x_end_idx <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x_idx SymBV (ExprBuilder t st fs) w
len
      Expr t (BaseBVType w)
y_end_idx <- ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y_idx SymBV (ExprBuilder t st fs) w
len
      ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (NatRepr w
-> BaseTypeRepr xs
-> Expr t (BaseArrayType (SingleCtx (BaseBVType w)) xs)
-> Expr t (BaseBVType w)
-> Expr t (BaseArrayType (SingleCtx (BaseBVType w)) xs)
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> Expr t (BaseBVType w)
-> App (Expr t) BaseBoolType
forall (w :: Natural) (a :: BaseType) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> BaseTypeRepr a
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> App e BaseBoolType
EqualArrayRange (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x_idx) BaseTypeRepr xs
a_repr SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
Expr t (BaseArrayType (SingleCtx (BaseBVType w)) xs)
x_arr SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x_idx SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
Expr t (BaseArrayType (SingleCtx (BaseBVType w)) xs)
y_arr SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
y_idx SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
len Expr t (BaseBVType w)
x_end_idx Expr t (BaseBVType w)
y_end_idx)

  -- | Create an array from a map of concrete indices to values.
  arrayUpdateAtIdxLits :: forall (idx :: Ctx BaseType) (itp :: BaseType) (tp :: BaseType).
ExprBuilder t st fs
-> ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
-> SymArray (ExprBuilder t st fs) (idx ::> itp) tp
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) tp)
arrayUpdateAtIdxLits ExprBuilder t st fs
sym ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
m SymArray (ExprBuilder t st fs) (idx ::> itp) tp
def_map = do
    BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idx_tps BaseTypeRepr xs
baseRepr <- BaseTypeRepr (BaseArrayType (idx ::> itp) tp)
-> IO (BaseTypeRepr (BaseArrayType (idx ::> itp) tp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BaseTypeRepr (BaseArrayType (idx ::> itp) tp)
 -> IO (BaseTypeRepr (BaseArrayType (idx ::> itp) tp)))
-> BaseTypeRepr (BaseArrayType (idx ::> itp) tp)
-> IO (BaseTypeRepr (BaseArrayType (idx ::> itp) tp))
forall a b. (a -> b) -> a -> b
$ Expr t (BaseArrayType (idx ::> itp) tp)
-> BaseTypeRepr (BaseArrayType (idx ::> itp) tp)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) (idx ::> itp) tp
Expr t (BaseArrayType (idx ::> itp) tp)
def_map
    let new_map :: ArrayUpdateMap (Expr t) (idx ::> tp) xs
new_map
          | Just (ConstantArray Assignment BaseTypeRepr (i ::> tp1)
_ BaseTypeRepr b
_ Expr t b
default_value) <- Expr t (BaseArrayType (idx ::> itp) tp)
-> Maybe (App (Expr t) (BaseArrayType (idx ::> itp) tp))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymArray (ExprBuilder t st fs) (idx ::> itp) tp
Expr t (BaseArrayType (idx ::> itp) tp)
def_map =
            (Expr t b -> Bool)
-> ArrayUpdateMap (Expr t) (idx ::> itp) b
-> ArrayUpdateMap (Expr t) (idx ::> itp) b
forall (e :: BaseType -> Type) (tp :: BaseType)
       (ctx :: Ctx BaseType).
(e tp -> Bool)
-> ArrayUpdateMap e ctx tp -> ArrayUpdateMap e ctx tp
AUM.filter (Expr t b -> Expr t b -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr t b
default_value) ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
ArrayUpdateMap (Expr t) (idx ::> itp) b
m
          | Bool
otherwise = ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
ArrayUpdateMap (Expr t) (idx ::> tp) xs
m
    if ArrayUpdateMap (Expr t) (idx ::> tp) xs -> Bool
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp -> Bool
AUM.null ArrayUpdateMap (Expr t) (idx ::> tp) xs
new_map then
      Expr t (BaseArrayType (idx ::> itp) tp)
-> IO (Expr t (BaseArrayType (idx ::> itp) tp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymArray (ExprBuilder t st fs) (idx ::> itp) tp
Expr t (BaseArrayType (idx ::> itp) tp)
def_map
     else
      ExprBuilder t st fs
-> App (Expr t) ('BaseArrayType (idx ::> tp) xs)
-> IO (Expr t ('BaseArrayType (idx ::> tp) xs))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseArrayType (idx ::> tp) xs)
 -> IO (Expr t ('BaseArrayType (idx ::> tp) xs)))
-> App (Expr t) ('BaseArrayType (idx ::> tp) xs)
-> IO (Expr t ('BaseArrayType (idx ::> tp) xs))
forall a b. (a -> b) -> a -> b
$ Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr xs
-> ArrayUpdateMap (Expr t) (idx ::> tp) xs
-> Expr t ('BaseArrayType (idx ::> tp) xs)
-> App (Expr t) ('BaseArrayType (idx ::> tp) xs)
forall (i :: Ctx BaseType) (itp :: BaseType) (tp1 :: BaseType)
       (e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> itp)
-> BaseTypeRepr tp1
-> ArrayUpdateMap e (i ::> itp) tp1
-> e (BaseArrayType (i ::> itp) tp1)
-> App e (BaseArrayType (i ::> itp) tp1)
ArrayMap Assignment BaseTypeRepr (idx ::> tp)
idx_tps BaseTypeRepr xs
baseRepr ArrayUpdateMap (Expr t) (idx ::> tp) xs
new_map SymArray (ExprBuilder t st fs) (idx ::> itp) tp
Expr t ('BaseArrayType (idx ::> tp) xs)
def_map

  arrayIte :: forall (idx :: Ctx BaseType) (b :: BaseType).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymArray (ExprBuilder t st fs) idx b
-> SymArray (ExprBuilder t st fs) idx b
-> IO (SymArray (ExprBuilder t st fs) idx b)
arrayIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p SymArray (ExprBuilder t st fs) idx b
x SymArray (ExprBuilder t st fs) idx b
y = do
    Bool
pmo <- OptionSetting BaseBoolType -> IO Bool
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseBoolType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseBoolType
sbPushMuxOps ExprBuilder t st fs
sym)
    if   -- Extract all concrete updates out.
       | Bool -> Bool
not Bool
pmo
       , ArrayMapView ArrayUpdateMap (Expr t) idx b
mx Expr t (BaseArrayType idx b)
x' <- Expr t (BaseArrayType idx b) -> ArrayMapView idx (Expr t) b
forall t (i :: Ctx BaseType) (tp :: BaseType).
Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
viewArrayMap SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
x
       , ArrayMapView ArrayUpdateMap (Expr t) idx b
my Expr t (BaseArrayType idx b)
y' <- Expr t (BaseArrayType idx b) -> ArrayMapView idx (Expr t) b
forall t (i :: Ctx BaseType) (tp :: BaseType).
Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
viewArrayMap SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
y
       , Bool -> Bool
not (ArrayUpdateMap (Expr t) idx b -> Bool
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp -> Bool
AUM.null ArrayUpdateMap (Expr t) idx b
mx) Bool -> Bool -> Bool
|| Bool -> Bool
not (ArrayUpdateMap (Expr t) idx b -> Bool
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp -> Bool
AUM.null ArrayUpdateMap (Expr t) idx b
my) -> do
         case Expr t (BaseArrayType idx b) -> BaseTypeRepr (BaseArrayType idx b)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
x of
           BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idxRepr BaseTypeRepr xs
bRepr -> do
             let both_fn :: Assignment IndexLit (idx ::> tp)
-> Expr t b -> Expr t b -> IO (SymExpr (ExprBuilder t st fs) b)
both_fn Assignment IndexLit (idx ::> tp)
_ Expr t b
u Expr t b
v = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymExpr (ExprBuilder t st fs) b
-> SymExpr (ExprBuilder t st fs) b
-> IO (SymExpr (ExprBuilder t st fs) b)
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
forall (tp :: BaseType).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymExpr (ExprBuilder t st fs) tp
-> SymExpr (ExprBuilder t st fs) tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
baseTypeIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p SymExpr (ExprBuilder t st fs) b
Expr t b
u SymExpr (ExprBuilder t st fs) b
Expr t b
v
                 left_fn :: Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
left_fn Assignment IndexLit (idx ::> tp)
idx Expr t b
u = do
                   Expr t b
v <- ExprBuilder t st fs
-> Expr t (BaseArrayType (idx ::> tp) b)
-> Maybe (Assignment IndexLit (idx ::> tp))
-> Assignment (Expr t) (idx ::> tp)
-> IO (Expr t b)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType idx b)
Expr t (BaseArrayType (idx ::> tp) b)
y' (Assignment IndexLit (idx ::> tp)
-> Maybe (Assignment IndexLit (idx ::> tp))
forall a. a -> Maybe a
Just Assignment IndexLit (idx ::> tp)
idx) (Assignment (Expr t) (idx ::> tp) -> IO (Expr t b))
-> IO (Assignment (Expr t) (idx ::> tp)) -> IO (Expr t b)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Assignment IndexLit (idx ::> tp)
-> IO (Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp))
forall sym (ctx :: Ctx BaseType).
IsExprBuilder sym =>
sym -> Assignment IndexLit ctx -> IO (Assignment (SymExpr sym) ctx)
symbolicIndices ExprBuilder t st fs
sym Assignment IndexLit (idx ::> tp)
idx
                   Assignment IndexLit (idx ::> tp)
-> Expr t b -> Expr t b -> IO (SymExpr (ExprBuilder t st fs) b)
both_fn Assignment IndexLit (idx ::> tp)
idx Expr t b
u Expr t b
v
                 right_fn :: Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
right_fn Assignment IndexLit (idx ::> tp)
idx Expr t b
v = do
                   Expr t b
u <- ExprBuilder t st fs
-> Expr t (BaseArrayType (idx ::> tp) b)
-> Maybe (Assignment IndexLit (idx ::> tp))
-> Assignment (Expr t) (idx ::> tp)
-> IO (Expr t b)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType idx b)
Expr t (BaseArrayType (idx ::> tp) b)
x' (Assignment IndexLit (idx ::> tp)
-> Maybe (Assignment IndexLit (idx ::> tp))
forall a. a -> Maybe a
Just Assignment IndexLit (idx ::> tp)
idx) (Assignment (Expr t) (idx ::> tp) -> IO (Expr t b))
-> IO (Assignment (Expr t) (idx ::> tp)) -> IO (Expr t b)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Assignment IndexLit (idx ::> tp)
-> IO (Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp))
forall sym (ctx :: Ctx BaseType).
IsExprBuilder sym =>
sym -> Assignment IndexLit ctx -> IO (Assignment (SymExpr sym) ctx)
symbolicIndices ExprBuilder t st fs
sym Assignment IndexLit (idx ::> tp)
idx
                   Assignment IndexLit (idx ::> tp)
-> Expr t b -> Expr t b -> IO (SymExpr (ExprBuilder t st fs) b)
both_fn Assignment IndexLit (idx ::> tp)
idx Expr t b
u Expr t b
v
             ArrayUpdateMap (Expr t) (idx ::> tp) xs
mz <- BaseTypeRepr xs
-> (Assignment IndexLit (idx ::> tp)
    -> Expr t xs -> Expr t xs -> IO (Expr t xs))
-> (Assignment IndexLit (idx ::> tp)
    -> Expr t xs -> IO (Expr t xs))
-> (Assignment IndexLit (idx ::> tp)
    -> Expr t xs -> IO (Expr t xs))
-> ArrayUpdateMap (Expr t) (idx ::> tp) xs
-> ArrayUpdateMap (Expr t) (idx ::> tp) xs
-> IO (ArrayUpdateMap (Expr t) (idx ::> tp) xs)
forall (m :: Type -> Type) (g :: BaseType -> Type) (tp :: BaseType)
       (ctx :: Ctx BaseType) (e :: BaseType -> Type)
       (f :: BaseType -> Type).
(Applicative m, HashableF g, HasAbsValue g) =>
BaseTypeRepr tp
-> (Assignment IndexLit ctx -> e tp -> f tp -> m (g tp))
-> (Assignment IndexLit ctx -> e tp -> m (g tp))
-> (Assignment IndexLit ctx -> f tp -> m (g tp))
-> ArrayUpdateMap e ctx tp
-> ArrayUpdateMap f ctx tp
-> m (ArrayUpdateMap g ctx tp)
AUM.mergeM BaseTypeRepr xs
bRepr Assignment IndexLit (idx ::> tp)
-> Expr t b -> Expr t b -> IO (SymExpr (ExprBuilder t st fs) b)
Assignment IndexLit (idx ::> tp)
-> Expr t xs -> Expr t xs -> IO (Expr t xs)
both_fn Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
Assignment IndexLit (idx ::> tp) -> Expr t xs -> IO (Expr t xs)
left_fn Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
Assignment IndexLit (idx ::> tp) -> Expr t xs -> IO (Expr t xs)
right_fn ArrayUpdateMap (Expr t) idx b
ArrayUpdateMap (Expr t) (idx ::> tp) xs
mx ArrayUpdateMap (Expr t) idx b
ArrayUpdateMap (Expr t) (idx ::> tp) xs
my
             Expr t ('BaseArrayType (idx ::> tp) xs)
z' <- ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) b)
forall sym (idx :: Ctx BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymArray sym idx b
-> SymArray sym idx b
-> IO (SymArray sym idx b)
forall (idx :: Ctx BaseType) (b :: BaseType).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymArray (ExprBuilder t st fs) idx b
-> SymArray (ExprBuilder t st fs) idx b
-> IO (SymArray (ExprBuilder t st fs) idx b)
arrayIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p SymArray (ExprBuilder t st fs) (idx ::> tp) b
Expr t (BaseArrayType idx b)
x' SymArray (ExprBuilder t st fs) (idx ::> tp) b
Expr t (BaseArrayType idx b)
y'

             ExprBuilder t st fs
-> App (Expr t) ('BaseArrayType (idx ::> tp) xs)
-> IO (Expr t ('BaseArrayType (idx ::> tp) xs))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseArrayType (idx ::> tp) xs)
 -> IO (Expr t ('BaseArrayType (idx ::> tp) xs)))
-> App (Expr t) ('BaseArrayType (idx ::> tp) xs)
-> IO (Expr t ('BaseArrayType (idx ::> tp) xs))
forall a b. (a -> b) -> a -> b
$ Assignment BaseTypeRepr (idx ::> tp)
-> BaseTypeRepr xs
-> ArrayUpdateMap (Expr t) (idx ::> tp) xs
-> Expr t ('BaseArrayType (idx ::> tp) xs)
-> App (Expr t) ('BaseArrayType (idx ::> tp) xs)
forall (i :: Ctx BaseType) (itp :: BaseType) (tp1 :: BaseType)
       (e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> itp)
-> BaseTypeRepr tp1
-> ArrayUpdateMap e (i ::> itp) tp1
-> e (BaseArrayType (i ::> itp) tp1)
-> App e (BaseArrayType (i ::> itp) tp1)
ArrayMap Assignment BaseTypeRepr (idx ::> tp)
idxRepr BaseTypeRepr xs
bRepr ArrayUpdateMap (Expr t) (idx ::> tp) xs
mz Expr t ('BaseArrayType (idx ::> tp) xs)
z'

       | Bool
otherwise -> ExprBuilder t st fs
-> BoolExpr t
-> Expr t (BaseArrayType idx b)
-> Expr t (BaseArrayType idx b)
-> IO (Expr t (BaseArrayType idx b))
forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
p SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
x SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
y

  arrayEq :: forall (idx :: Ctx BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) idx b
-> SymArray (ExprBuilder t st fs) idx b
-> IO (Pred (ExprBuilder t st fs))
arrayEq ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) idx b
x SymArray (ExprBuilder t st fs) idx b
y
    | SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
x Expr t (BaseArrayType idx b)
-> Expr t (BaseArrayType idx b) -> Bool
forall a. Eq a => a -> a -> Bool
== SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
y =
      BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
    | Bool
otherwise =
      ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! BaseTypeRepr (BaseArrayType idx b)
-> Expr t (BaseArrayType idx b)
-> Expr t (BaseArrayType idx b)
-> App (Expr t) BaseBoolType
forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e BaseBoolType
BaseEq (Expr t (BaseArrayType idx b) -> BaseTypeRepr (BaseArrayType idx b)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
x) SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
x SymArray (ExprBuilder t st fs) idx b
Expr t (BaseArrayType idx b)
y

  arrayTrueOnEntries :: forall (idx :: Ctx BaseType) (itp :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
-> SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
arrayTrueOnEntries ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
f SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
a
    | Just Bool
True <- Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
-> AbstractValue (BaseArrayType (idx ::> itp) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a =
      Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
    | Just (IndicesInRange Assignment OnlyIntRepr (idx '::> itp)
_ Assignment (Expr t) (idx '::> itp)
bnds) <- ExprSymFn t (idx ::> itp) BaseBoolType
-> Maybe (MatlabSolverFn (Expr t) (idx ::> itp) BaseBoolType)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn SymFn (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
ExprSymFn t (idx ::> itp) BaseBoolType
f
    , Just Assignment IntLit (idx '::> itp)
v <- Assignment (Expr t) (idx '::> itp)
-> Maybe (Assignment IntLit (idx '::> itp))
forall t (idx :: Ctx BaseType).
Assignment (Expr t) idx -> Maybe (Assignment IntLit idx)
asIntBounds Assignment (Expr t) (idx '::> itp)
bnds = do
      let h :: Expr t (BaseArrayType (i::>it) BaseBoolType)
            -> BoolExpr t
            -> Ctx.Assignment (Expr t) (i::>it)
            -> IO (BoolExpr t)
          h :: forall (i :: Ctx BaseType) (it :: BaseType).
Expr t (BaseArrayType (i ::> it) BaseBoolType)
-> BoolExpr t -> Assignment (Expr t) (i ::> it) -> IO (BoolExpr t)
h Expr t (BaseArrayType (i ::> it) BaseBoolType)
a0 BoolExpr t
p Assignment (Expr t) (i ::> it)
i = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
p (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (i ::> it) BaseBoolType
-> Assignment (SymExpr (ExprBuilder t st fs)) (i ::> it)
-> IO (Pred (ExprBuilder t st fs))
forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> IO (SymExpr sym b)
forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
-> IO (SymExpr (ExprBuilder t st fs) b)
arrayLookup ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (i ::> it) BaseBoolType
Expr t (BaseArrayType (i ::> it) BaseBoolType)
a0 Assignment (SymExpr (ExprBuilder t st fs)) (i ::> it)
Assignment (Expr t) (i ::> it)
i
      ExprBuilder t st fs
-> (BoolExpr t
    -> Assignment (SymExpr (ExprBuilder t st fs)) (idx '::> itp)
    -> IO (BoolExpr t))
-> BoolExpr t
-> Assignment IntLit (idx '::> itp)
-> IO (BoolExpr t)
forall sym (idx :: Ctx BaseType) r.
IsExprBuilder sym =>
sym
-> (r -> Assignment (SymExpr sym) idx -> IO r)
-> r
-> Assignment IntLit idx
-> IO r
foldIndicesInRangeBounds ExprBuilder t st fs
sym (Expr t (BaseArrayType (idx '::> itp) BaseBoolType)
-> BoolExpr t
-> Assignment (Expr t) (idx '::> itp)
-> IO (BoolExpr t)
forall (i :: Ctx BaseType) (it :: BaseType).
Expr t (BaseArrayType (i ::> it) BaseBoolType)
-> BoolExpr t -> Assignment (Expr t) (i ::> it) -> IO (BoolExpr t)
h SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
Expr t (BaseArrayType (idx '::> itp) BaseBoolType)
a) (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym) Assignment IntLit (idx '::> itp)
v

    | Bool
otherwise =
      ExprBuilder t st fs
-> NonceApp t (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) BaseBoolType -> IO (BoolExpr t))
-> NonceApp t (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprSymFn t (idx ::> itp) BaseBoolType
-> Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
-> NonceApp t (Expr t) BaseBoolType
forall t (idx :: Ctx BaseType) (itp :: BaseType)
       (e :: BaseType -> Type).
ExprSymFn t (idx ::> itp) BaseBoolType
-> e (BaseArrayType (idx ::> itp) BaseBoolType)
-> NonceApp t e BaseBoolType
ArrayTrueOnEntries SymFn (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
ExprSymFn t (idx ::> itp) BaseBoolType
f SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a

  ----------------------------------------------------------------------
  -- Lossless (injective) conversions

  integerToReal :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
integerToReal ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x
    | SemiRingLiteral SemiRingRepr sr
SR.SemiRingIntegerRepr Coefficient sr
i ProgramLoc
l <- SymInteger (ExprBuilder t st fs)
x = Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t BaseRealType -> IO (Expr t BaseRealType))
-> Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a b. (a -> b) -> a -> b
$! SemiRingRepr 'SemiRingReal
-> Coefficient 'SemiRingReal
-> ProgramLoc
-> Expr t (SemiRingBase 'SemiRingReal)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr (Integer -> Rational
forall a. Real a => a -> Rational
toRational Integer
Coefficient sr
i) ProgramLoc
l
    | Just (RealToInteger Expr t BaseRealType
y) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x = Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseRealType
y
    | Bool
otherwise  = ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseIntegerType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseIntegerType -> App e BaseRealType
IntegerToReal SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x)

  realToInteger :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realToInteger ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
      -- Ground case
    | SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t BaseIntegerType -> IO (Expr t BaseIntegerType))
-> Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$! SemiRingRepr 'SemiRingInteger
-> Coefficient 'SemiRingInteger
-> ProgramLoc
-> Expr t (SemiRingBase 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr (Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal Expr t BaseIntegerType
xi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x = Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseIntegerType
xi
      -- Static case
    | Bool
otherwise =
      ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  bvToInteger :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymInteger (ExprBuilder t st fs))
bvToInteger ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
    | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x =
      ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
xv)
      -- bvToInteger (integerToBv x w) == mod x (2^w)
    | Just (IntegerToBV Expr t BaseIntegerType
xi NatRepr w
w) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x =
      ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMod ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
xi (Expr t BaseIntegerType -> IO (Expr t BaseIntegerType))
-> IO (Expr t BaseIntegerType) -> IO (Expr t BaseIntegerType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
2Integer -> Natural -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
    | Bool
otherwise =
      ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> App (Expr t) BaseIntegerType
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> App e BaseIntegerType
BVToInteger SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)

  sbvToInteger :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymInteger (ExprBuilder t st fs))
sbvToInteger ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
    | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x =
      ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (NatRepr w -> BV w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> BV w -> Integer
BV.asSigned (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
xv)
      -- sbvToInteger (integerToBv x w) == mod (x + 2^(w-1)) (2^w) - 2^(w-1)
    | Just (IntegerToBV Expr t BaseIntegerType
xi NatRepr w
w) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x =
      do Expr t BaseIntegerType
halfmod <- ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
2 Integer -> Natural -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1))
         Expr t BaseIntegerType
modulus <- ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
2 Integer -> Natural -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ NatRepr w -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
         Expr t BaseIntegerType
x'      <- ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intAdd ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
xi SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
halfmod
         Expr t BaseIntegerType
z       <- ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMod ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
x' SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
modulus
         ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intSub ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
z SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
halfmod
    | Bool
otherwise =
      ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> App (Expr t) BaseIntegerType
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> App e BaseIntegerType
SBVToInteger SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)

  predToBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> NatRepr w
-> IO (SymBV (ExprBuilder t st fs) w)
predToBV ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p NatRepr w
w
    | Just Bool
b <- BoolExpr t -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
BoolExpr t
p =
        if Bool
b then ExprBuilder t st fs
-> NatRepr w -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvOne ExprBuilder t st fs
sym NatRepr w
w else ExprBuilder t st fs
-> NatRepr w -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural) sym.
(1 <= w, IsExprBuilder sym) =>
sym -> NatRepr w -> IO (SymBV sym w)
bvZero ExprBuilder t st fs
sym NatRepr w
w
    | Bool
otherwise =
       case NatRepr w -> NatRepr 1 -> NatCases w 1
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
w (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) of
         NatCases w 1
NatCaseEQ   -> ExprBuilder t st fs
-> App (Expr t) ('BaseBVType 1) -> IO (Expr t ('BaseBVType 1))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (NatRepr 1 -> BoolExpr t -> App (Expr t) ('BaseBVType 1)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e BaseBoolType -> App e ('BaseBVType w)
BVFill (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) Pred (ExprBuilder t st fs)
BoolExpr t
p)
         NatCaseGT LeqProof (1 + 1) w
LeqProof -> ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) 1
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
w (Expr t ('BaseBVType 1) -> IO (Expr t (BaseBVType w)))
-> IO (Expr t ('BaseBVType 1)) -> IO (Expr t (BaseBVType w))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> App (Expr t) ('BaseBVType 1) -> IO (Expr t ('BaseBVType 1))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (NatRepr 1 -> BoolExpr t -> App (Expr t) ('BaseBVType 1)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e BaseBoolType -> App e ('BaseBVType w)
BVFill (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) Pred (ExprBuilder t st fs)
BoolExpr t
p)
         NatCaseLT LeqProof (w + 1) 1
LeqProof -> String -> IO (Expr t (BaseBVType w))
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"impossible case in predToBV"

  integerToBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> NatRepr w
-> IO (SymBV (ExprBuilder t st fs) w)
integerToBV ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
xr NatRepr w
w
    | SemiRingLiteral SemiRingRepr sr
SR.SemiRingIntegerRepr Coefficient sr
i ProgramLoc
_ <- SymInteger (ExprBuilder t st fs)
xr =
      ExprBuilder t st fs
-> NatRepr w
-> BV w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient sr
i)

    | Just (BVToInteger Expr t (BaseBVType w)
r) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
xr =
      case NatRepr w -> NatRepr w -> NatCases w w
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
r) NatRepr w
w of
        NatCaseLT LeqProof (w + 1) w
LeqProof -> ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
r
        NatCases w w
NatCaseEQ   -> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseBVType w)
r
        NatCaseGT LeqProof (w + 1) w
LeqProof -> ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (r :: Natural) (w :: Natural).
(1 <= r, (r + 1) <= w) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc ExprBuilder t st fs
sym NatRepr w
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
r

    | Just (SBVToInteger Expr t (BaseBVType w)
r) <- Expr t BaseIntegerType -> Maybe (App (Expr t) BaseIntegerType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
xr =
      case NatRepr w -> NatRepr w -> NatCases w w
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
r) NatRepr w
w of
        NatCaseLT LeqProof (w + 1) w
LeqProof -> ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
r
        NatCases w w
NatCaseEQ   -> Expr t (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseBVType w)
r
        NatCaseGT LeqProof (w + 1) w
LeqProof -> ExprBuilder t st fs
-> NatRepr w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (r :: Natural) (w :: Natural).
(1 <= r, (r + 1) <= w) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) r)
forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc ExprBuilder t st fs
sym NatRepr w
w SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
r

    | Bool
otherwise =
      ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseIntegerType -> NatRepr w -> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e BaseIntegerType -> NatRepr w -> App e ('BaseBVType w)
IntegerToBV SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
xr NatRepr w
w)

  realRound :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realRound ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
      -- Ground case
    | SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SymInteger (ExprBuilder t st fs)
 -> IO (SymInteger (ExprBuilder t st fs)))
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ SemiRingRepr 'SemiRingInteger
-> Coefficient 'SemiRingInteger
-> ProgramLoc
-> Expr t (SemiRingBase 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr (Rational -> Integer
forall a. RealFrac a => a -> Integer
roundAway Rational
Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal Expr t BaseIntegerType
xi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x = Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseIntegerType
xi
      -- Static case
    | Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (Expr t BaseRealType -> AbstractValue BaseRealType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x) =
      ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)
      -- Unsimplified case
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RoundReal SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realRoundEven :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realRoundEven ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
      -- Ground case
    | SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SymInteger (ExprBuilder t st fs)
 -> IO (SymInteger (ExprBuilder t st fs)))
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ SemiRingRepr 'SemiRingInteger
-> Coefficient 'SemiRingInteger
-> ProgramLoc
-> Expr t (SemiRingBase 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr (Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Rational
Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal Expr t BaseIntegerType
xi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x = Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseIntegerType
xi
      -- Static case
    | Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (Expr t BaseRealType -> AbstractValue BaseRealType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x) =
      ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)
      -- Unsimplified case
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RoundEvenReal SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realFloor :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realFloor ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
      -- Ground case
    | SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SymInteger (ExprBuilder t st fs)
 -> IO (SymInteger (ExprBuilder t st fs)))
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ SemiRingRepr 'SemiRingInteger
-> Coefficient 'SemiRingInteger
-> ProgramLoc
-> Expr t (SemiRingBase 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr (Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal Expr t BaseIntegerType
xi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x = Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseIntegerType
xi
      -- Static case
    | Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (Expr t BaseRealType -> AbstractValue BaseRealType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x) =
      ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)
      -- Unsimplified case
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
FloorReal SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realCeil :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realCeil ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
      -- Ground case
    | SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SymInteger (ExprBuilder t st fs)
 -> IO (SymInteger (ExprBuilder t st fs)))
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ SemiRingRepr 'SemiRingInteger
-> Coefficient 'SemiRingInteger
-> ProgramLoc
-> Expr t (SemiRingBase 'SemiRingInteger)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingInteger
SR.SemiRingIntegerRepr (Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Rational
Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal Expr t BaseIntegerType
xi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x = Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseIntegerType
xi
      -- Static case
    | Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (Expr t BaseRealType -> AbstractValue BaseRealType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x) =
      ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)
      -- Unsimplified case
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) BaseIntegerType -> IO (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseIntegerType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
CeilReal SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  ----------------------------------------------------------------------
  -- Real operations

  realLit :: ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
realLit ExprBuilder t st fs
sb Rational
r = do
    ProgramLoc
l <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sb
    Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SemiRingRepr 'SemiRingReal
-> Coefficient 'SemiRingReal
-> ProgramLoc
-> Expr t (SemiRingBase 'SemiRingReal)
forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr Rational
Coefficient 'SemiRingReal
r ProgramLoc
l)

  realZero :: ExprBuilder t st fs -> SymReal (ExprBuilder t st fs)
realZero = ExprBuilder t st fs -> SymReal (ExprBuilder t st fs)
ExprBuilder t st fs -> Expr t BaseRealType
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> RealExpr t
sbZero

  realEq :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
realEq ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
      -- Use range check
    | Just Bool
b <- RealAbstractValue -> RealAbstractValue -> Maybe Bool
ravCheckEq (Expr t BaseRealType -> AbstractValue BaseRealType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x) (Expr t BaseRealType -> AbstractValue BaseRealType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y)
    = Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

      -- Reduce to integer equality, when possible
    | Just (IntegerToReal Expr t BaseIntegerType
xi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x
    , Just (IntegerToReal Expr t BaseIntegerType
yi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y
    = ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
xi SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
yi

    | Just (IntegerToReal Expr t BaseIntegerType
xi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x
    , SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
yr ProgramLoc
_ <- SymReal (ExprBuilder t st fs)
y
    = if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
Coefficient sr
yr Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
         then ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
xi (Expr t BaseIntegerType -> IO (BoolExpr t))
-> IO (Expr t BaseIntegerType) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
Coefficient sr
yr)
         else BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)

    | SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
xr ProgramLoc
_ <- SymReal (ExprBuilder t st fs)
x
    , Just (IntegerToReal Expr t BaseIntegerType
yi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y
    = if Rational -> Integer
forall a. Ratio a -> a
denominator Rational
Coefficient sr
xr Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1
         then ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
yi (Expr t BaseIntegerType -> IO (BoolExpr t))
-> IO (Expr t BaseIntegerType) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
Coefficient sr
xr)
         else BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)

    | Bool
otherwise
    = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingReal
-> (Expr t (SemiRingBase 'SemiRingReal)
    -> Expr t (SemiRingBase 'SemiRingReal) -> IO (BoolExpr t))
-> Expr t (SemiRingBase 'SemiRingReal)
-> Expr t (SemiRingBase 'SemiRingReal)
-> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> (Expr t (SemiRingBase sr)
    -> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t BaseBoolType)
semiRingEq ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr (ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq ExprBuilder t st fs
sym) SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
x SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
y

  realLe :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
realLe ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
      -- Use range check
    | Just Bool
b <- RealAbstractValue -> RealAbstractValue -> Maybe Bool
ravCheckLe (Expr t BaseRealType -> AbstractValue BaseRealType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x) (Expr t BaseRealType -> AbstractValue BaseRealType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y)
    = Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

      -- Reduce to integer inequality, when possible
    | Just (IntegerToReal Expr t BaseIntegerType
xi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x
    , Just (IntegerToReal Expr t BaseIntegerType
yi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y
    = ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
xi SymInteger (ExprBuilder t st fs)
Expr t BaseIntegerType
yi

      -- if the upper range is a constant, do an integer comparison
      -- with @floor(y)@
    | Just (IntegerToReal Expr t BaseIntegerType
xi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x
    , SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
yr ProgramLoc
_ <- SymReal (ExprBuilder t st fs)
y
    = IO (IO (BoolExpr t)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe ExprBuilder t st fs
sym (Expr t BaseIntegerType
 -> Expr t BaseIntegerType -> IO (BoolExpr t))
-> IO (Expr t BaseIntegerType)
-> IO (Expr t BaseIntegerType -> IO (BoolExpr t))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t BaseIntegerType
xi IO (Expr t BaseIntegerType -> IO (BoolExpr t))
-> IO (Expr t BaseIntegerType) -> IO (IO (BoolExpr t))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
Coefficient sr
yr))

      -- if the lower range is a constant, do an integer comparison
      -- with @ceiling(x)@
    | SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
xr ProgramLoc
_ <- SymReal (ExprBuilder t st fs)
x
    , Just (IntegerToReal Expr t BaseIntegerType
yi) <- Expr t BaseRealType -> Maybe (App (Expr t) BaseRealType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y
    = IO (IO (BoolExpr t)) -> IO (BoolExpr t)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe ExprBuilder t st fs
sym (Expr t BaseIntegerType
 -> Expr t BaseIntegerType -> IO (BoolExpr t))
-> IO (Expr t BaseIntegerType)
-> IO (Expr t BaseIntegerType -> IO (BoolExpr t))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Rational
Coefficient sr
xr) IO (Expr t BaseIntegerType -> IO (BoolExpr t))
-> IO (Expr t BaseIntegerType) -> IO (IO (BoolExpr t))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t BaseIntegerType
yi)

    | Bool
otherwise
    = ExprBuilder t st fs
-> OrderedSemiRingRepr 'SemiRingReal
-> (Expr t (SemiRingBase 'SemiRingReal)
    -> Expr t (SemiRingBase 'SemiRingReal) -> IO (BoolExpr t))
-> Expr t (SemiRingBase 'SemiRingReal)
-> Expr t (SemiRingBase 'SemiRingReal)
-> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> (Expr t (SemiRingBase sr)
    -> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t BaseBoolType)
semiRingLe ExprBuilder t st fs
sym OrderedSemiRingRepr 'SemiRingReal
SR.OrderedSemiRingRealRepr (ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLe ExprBuilder t st fs
sym) SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
x SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
y

  realIte :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingReal
-> BoolExpr t
-> Expr t (SemiRingBase 'SemiRingReal)
-> Expr t (SemiRingBase 'SemiRingReal)
-> IO (Expr t (SemiRingBase 'SemiRingReal))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr Pred (ExprBuilder t st fs)
BoolExpr t
c SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
x SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
y

  realNeg :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realNeg ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingReal
-> Coefficient 'SemiRingReal
-> Expr t (SemiRingBase 'SemiRingReal)
-> IO (Expr t (SemiRingBase 'SemiRingReal))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr (-Rational
1) SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
x

  realAdd :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realAdd ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingReal
-> Expr t (SemiRingBase 'SemiRingReal)
-> Expr t (SemiRingBase 'SemiRingReal)
-> IO (Expr t (SemiRingBase 'SemiRingReal))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
x SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
y

  realMul :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realMul ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y = ExprBuilder t st fs
-> SemiRingRepr 'SemiRingReal
-> Expr t (SemiRingBase 'SemiRingReal)
-> Expr t (SemiRingBase 'SemiRingReal)
-> IO (Expr t (SemiRingBase 'SemiRingReal))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
x SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
y

  realDiv :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realDiv ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
    | Just Rational
0 <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x =
      Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x
    | Just Rational
xd <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x, Just Rational
yd <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y, Rational
yd Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0 = do
      ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Rational
xd Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
yd)
      -- Handle division by a constant.
    | Just Rational
yd <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y, Rational
yd Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0 = do
      ExprBuilder t st fs
-> SemiRingRepr 'SemiRingReal
-> Coefficient 'SemiRingReal
-> Expr t (SemiRingBase 'SemiRingReal)
-> IO (Expr t (SemiRingBase 'SemiRingReal))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr (Rational
1 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
yd) SymReal (ExprBuilder t st fs)
Expr t (SemiRingBase 'SemiRingReal)
x
    | Bool
otherwise =
      ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseRealType -> IO (Expr t BaseRealType))
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall a b. (a -> b) -> a -> b
$ Expr t BaseRealType
-> Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> e BaseRealType -> App e BaseRealType
RealDiv SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y

  isInteger :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
isInteger ExprBuilder t st fs
sb SymReal (ExprBuilder t st fs)
x
    | Just Rational
r <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x = Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sb (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
1)
    | Just Bool
b <- RealAbstractValue -> Maybe Bool
ravIsInteger (Expr t BaseRealType -> AbstractValue BaseRealType
forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x) = Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sb Bool
b
    | Bool
otherwise = ExprBuilder t st fs -> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (App (Expr t) BaseBoolType -> IO (BoolExpr t))
-> App (Expr t) BaseBoolType -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$ Expr t BaseRealType -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseBoolType
RealIsInteger SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x

  realSqrt :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realSqrt ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x = do
    let sqrt_dbl :: Double -> Double
        sqrt_dbl :: Double -> Double
sqrt_dbl = Double -> Double
forall a. Floating a => a -> a
sqrt
    case SymReal (ExprBuilder t st fs)
x of
      SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
_
        | Rational
Coefficient sr
r Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealSqrt SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)
        | Just Rational
w <- Rational -> Maybe Rational
tryRationalSqrt Rational
Coefficient sr
r -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
w
        | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
sqrt_dbl (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
Coefficient sr
r)))
      SymReal (ExprBuilder t st fs)
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealSqrt SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realSpecialFunction :: forall (args :: Ctx Type).
ExprBuilder t st fs
-> SpecialFunction args
-> Assignment
     (SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
-> IO (SymReal (ExprBuilder t st fs))
realSpecialFunction ExprBuilder t st fs
sym SpecialFunction args
fn Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
Assignment (SpecialFnArg (Expr t) BaseRealType) args
Empty
    | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym =
        case SpecialFunction args
fn of
          SpecialFunction args
SFn.Pi -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double
forall a. Floating a => a
pi :: Double))
          -- TODO, other constants

          SpecialFunction args
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (SpecialFunction args
-> SpecialFnArgs (Expr t) BaseRealType args
-> App (Expr t) BaseRealType
forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (Assignment (SpecialFnArg (Expr t) BaseRealType) args
-> SpecialFnArgs (Expr t) BaseRealType args
forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs Assignment (SpecialFnArg (Expr t) BaseRealType) args
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Empty))

  realSpecialFunction ExprBuilder t st fs
sym SpecialFunction args
fn args :: Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args@(Assignment (SpecialFnArg (Expr t) BaseRealType) ctx
Empty :> SFn.SpecialFnArg Expr t BaseRealType
x)
    | Just Rational
c <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational Expr t BaseRealType
x =
        case SpecialFunction args
fn of
          SpecialFunction args
SFn.Sin
            | Rational
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
0
            | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
sin (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Cos
            | Rational
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
            | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
cos (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Sinh
            | Rational
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
0
            | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
sinh (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Cosh
            | Rational
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
            | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
cosh (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Exp
            | Rational
c Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
            | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
exp (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Log
            | Rational
c Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0, ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
log (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (SpecialFunction args
-> SpecialFnArgs (Expr t) BaseRealType args
-> App (Expr t) BaseRealType
forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (Assignment (SpecialFnArg (Expr t) BaseRealType) args
-> SpecialFnArgs (Expr t) BaseRealType args
forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
Assignment (SpecialFnArg (Expr t) BaseRealType) args
args))

  realSpecialFunction ExprBuilder t st fs
sym SpecialFunction args
fn args :: Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args@(Assignment (SpecialFnArg (Expr t) BaseRealType) ctx
Empty :> SFn.SpecialFnArg Expr t BaseRealType
x :> SFn.SpecialFnArg Expr t BaseRealType
y)
    | Just Rational
xc <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational Expr t BaseRealType
x,
      Just Rational
yc <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational Expr t BaseRealType
y =
        case SpecialFunction args
fn of
          SpecialFunction args
SFn.Arctan2
            | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 (Rational -> Double
toDouble Rational
xc) (Rational -> Double
toDouble Rational
yc)))
          SpecialFunction args
SFn.Pow
            | Rational
yc Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
            | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym ->
              ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Rational -> Double
toDouble Rational
xc Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Rational -> Double
toDouble Rational
yc))
          SpecialFunction args
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (SpecialFunction args
-> SpecialFnArgs (Expr t) BaseRealType args
-> App (Expr t) BaseRealType
forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (Assignment (SpecialFnArg (Expr t) BaseRealType) args
-> SpecialFnArgs (Expr t) BaseRealType args
forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
Assignment (SpecialFnArg (Expr t) BaseRealType) args
args))

  realSpecialFunction ExprBuilder t st fs
sym SpecialFunction args
fn Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args = ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (SpecialFunction args
-> SpecialFnArgs (Expr t) BaseRealType args
-> App (Expr t) BaseRealType
forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (Assignment (SpecialFnArg (Expr t) BaseRealType) args
-> SpecialFnArgs (Expr t) BaseRealType args
forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
Assignment (SpecialFnArg (Expr t) BaseRealType) args
args))

  ----------------------------------------------------------------------
  -- IEEE-754 floating-point operations

  floatLit :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
f =
    do ProgramLoc
l <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
       Expr t ('BaseFloatType fpp) -> IO (Expr t ('BaseFloatType fpp))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t ('BaseFloatType fpp) -> IO (Expr t ('BaseFloatType fpp)))
-> Expr t ('BaseFloatType fpp) -> IO (Expr t ('BaseFloatType fpp))
forall a b. (a -> b) -> a -> b
$! FloatPrecisionRepr fpp
-> BigFloat -> ProgramLoc -> Expr t ('BaseFloatType fpp)
forall (fpp :: FloatPrecision) t.
FloatPrecisionRepr fpp
-> BigFloat -> ProgramLoc -> Expr t ('BaseFloatType fpp)
FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
f ProgramLoc
l

  floatPZero :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatPZero ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymExpr (ExprBuilder t st fs) (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfPosZero
  floatNZero :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNZero ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymExpr (ExprBuilder t st fs) (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfNegZero
  floatNaN :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNaN   ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymExpr (ExprBuilder t st fs) (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfNaN
  floatPInf :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatPInf  ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymExpr (ExprBuilder t st fs) (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfPosInf
  floatNInf :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNInf  ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymExpr (ExprBuilder t st fs) (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfNegInf

  floatNeg :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNeg ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BigFloat -> BigFloat
BF.bfNeg BigFloat
x)
  floatNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (FloatPrecisionRepr fpp
 -> Expr t (BaseFloatType fpp) -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> e (BaseFloatType fpp) -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOp FloatPrecisionRepr fpp
-> Expr t (BaseFloatType fpp) -> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp)
FloatNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatAbs :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatAbs ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BigFloat -> BigFloat
BF.bfAbs BigFloat
x)
  floatAbs ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (FloatPrecisionRepr fpp
 -> Expr t (BaseFloatType fpp) -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> e (BaseFloatType fpp) -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOp FloatPrecisionRepr fpp
-> Expr t (BaseFloatType fpp) -> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp)
FloatAbs ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatSqrt :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatSqrt ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) =
    ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp ((BigFloat, Status) -> BigFloat
forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> (BigFloat, Status)
BF.bfSqrt (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x))
  floatSqrt ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x = (FloatPrecisionRepr fpp
 -> RoundingMode
 -> Expr t (BaseFloatType fpp)
 -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> RoundingMode
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOpR FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatSqrt ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatAdd :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatAdd ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
    ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp ((BigFloat, Status) -> BigFloat
forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfAdd (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y))
  floatAdd ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = (FloatPrecisionRepr fpp
 -> RoundingMode
 -> Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp)
 -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> RoundingMode
 -> e (BaseFloatType fpp)
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatAdd ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatSub :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatSub ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
    ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp ((BigFloat, Status) -> BigFloat
forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfSub (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y ))
  floatSub ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = (FloatPrecisionRepr fpp
 -> RoundingMode
 -> Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp)
 -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> RoundingMode
 -> e (BaseFloatType fpp)
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatSub ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatMul :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatMul ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
    ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp ((BigFloat, Status) -> BigFloat
forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfMul (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y))
  floatMul ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = (FloatPrecisionRepr fpp
 -> RoundingMode
 -> Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp)
 -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> RoundingMode
 -> e (BaseFloatType fpp)
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatMul ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatDiv :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatDiv ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
    ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp ((BigFloat, Status) -> BigFloat
forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfDiv (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y))
  floatDiv ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = (FloatPrecisionRepr fpp
 -> RoundingMode
 -> Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp)
 -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> RoundingMode
 -> e (BaseFloatType fpp)
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatDiv ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatRem :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatRem ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
    ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp ((BigFloat, Status) -> BigFloat
forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfRem (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
RNE) BigFloat
x BigFloat
y))
  floatRem ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = (FloatPrecisionRepr fpp
 -> Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp)
 -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> e (BaseFloatType fpp)
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOp FloatPrecisionRepr fpp
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatRem ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatFMA :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatFMA ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
z ProgramLoc
_) =
    ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp ((BigFloat, Status) -> BigFloat
forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfFMA (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y BigFloat
z))
  floatFMA ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
z =
    let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = Expr t (BaseFloatType fpp) -> BaseTypeRepr (BaseFloatType fpp)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x in ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseFloatType fpp)
 -> IO (Expr t (BaseFloatType fpp)))
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatFMA FloatPrecisionRepr fpp
fpp RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
z

  floatEq :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatEq ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! (BigFloat -> BigFloat -> Ordering
BF.bfCompare BigFloat
x BigFloat
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ)
  floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
    | SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x Expr t (BaseFloatType fpp) -> Expr t (BaseFloatType fpp) -> Bool
forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y = BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (BoolExpr t -> IO (BoolExpr t)) -> BoolExpr t -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
    | Bool
otherwise = (Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
 -> e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicBinOp (BaseTypeRepr (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> App (Expr t) BaseBoolType
forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e BaseBoolType
BaseEq (Expr t (BaseFloatType fpp) -> BaseTypeRepr (BaseFloatType fpp)
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x)) ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatNe :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatNe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y

  floatFpEq :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatFpEq ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! (BigFloat
x BigFloat -> BigFloat -> Bool
forall a. Eq a => a -> a -> Bool
== BigFloat
y)
  floatFpEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
    | SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x Expr t (BaseFloatType fpp) -> Expr t (BaseFloatType fpp) -> Bool
forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
    | Bool
otherwise = (Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
 -> e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicBinOp Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e BaseBoolType
FloatFpEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatLe :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLe ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! (BigFloat
x BigFloat -> BigFloat -> Bool
forall a. Ord a => a -> a -> Bool
<= BigFloat
y)
  floatLe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
    | SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x Expr t (BaseFloatType fpp) -> Expr t (BaseFloatType fpp) -> Bool
forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym (BoolExpr t -> IO (BoolExpr t))
-> IO (BoolExpr t) -> IO (BoolExpr t)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
    | Bool
otherwise = (Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
 -> e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicBinOp Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e BaseBoolType
FloatLe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatLt :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLt ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! (BigFloat
x BigFloat -> BigFloat -> Bool
forall a. Ord a => a -> a -> Bool
< BigFloat
y)
  floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
    | SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x Expr t (BaseFloatType fpp) -> Expr t (BaseFloatType fpp) -> Bool
forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y = Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs)))
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym
    | Bool
otherwise = (Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
 -> e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicBinOp Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e BaseBoolType
FloatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatGe :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatGe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x
  floatGt :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatGt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x
  floatIte :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = ExprBuilder t st fs
-> BoolExpr t
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
c SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y

  floatIsNaN :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNaN ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsNaN BigFloat
x
  floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicUnOp Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseBoolType
FloatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatIsInf :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsInf ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsInf BigFloat
x
  floatIsInf ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicUnOp Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseBoolType
FloatIsInf ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatIsZero :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsZero ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsZero BigFloat
x
  floatIsZero ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicUnOp Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseBoolType
FloatIsZero ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatIsPos :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsPos ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsPos BigFloat
x
  floatIsPos ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicUnOp Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseBoolType
FloatIsPos ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatIsNeg :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNeg ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsNeg BigFloat
x
  floatIsNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicUnOp Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseBoolType
FloatIsNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatIsSubnorm :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsSubnorm ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! BFOpts -> BigFloat -> Bool
BF.bfIsSubnormal (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
RNE) BigFloat
x
  floatIsSubnorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicUnOp Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseBoolType
FloatIsSubnorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatIsNorm :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNorm ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) =
    BoolExpr t -> IO (BoolExpr t)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (BoolExpr t -> IO (BoolExpr t))
-> (Bool -> BoolExpr t) -> Bool -> IO (BoolExpr t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st fs -> Bool -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Bool -> IO (BoolExpr t)) -> Bool -> IO (BoolExpr t)
forall a b. (a -> b) -> a -> b
$! BFOpts -> BigFloat -> Bool
BF.bfIsNormal (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
RNE) BigFloat
x
  floatIsNorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType)
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (BoolExpr t)
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicUnOp Expr t (BaseFloatType fpp) -> App (Expr t) BaseBoolType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseBoolType
FloatIsNorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatCast :: forall (fpp :: FloatPrecision) (fpp' :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp'
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatCast ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
    ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymExpr (ExprBuilder t st fs) (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp ((BigFloat, Status) -> BigFloat
forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> (BigFloat, Status)
BF.bfRoundFloat (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x))
  floatCast ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymFloat (ExprBuilder t st fs) fpp'
x
    | FloatingPointPrecisionRepr NatRepr eb
eb NatRepr sb
sb <- FloatPrecisionRepr fpp
fpp
    , Just (FloatCast (FloatingPointPrecisionRepr NatRepr eb
eb' NatRepr sb
sb') RoundingMode
_ Expr t (BaseFloatType fpp')
fval) <- Expr t (BaseFloatType fpp')
-> Maybe (App (Expr t) (BaseFloatType fpp'))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymFloat (ExprBuilder t st fs) fpp'
Expr t (BaseFloatType fpp')
x
    , NatRepr eb -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr eb
eb Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr eb -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr eb
eb'
    , NatRepr sb -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr sb
sb Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr sb -> Natural
forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr sb
sb'
    , Just BaseFloatType fpp :~: BaseFloatType fpp'
Refl <- BaseTypeRepr (BaseFloatType fpp)
-> BaseTypeRepr (BaseFloatType fpp')
-> Maybe (BaseFloatType fpp :~: BaseFloatType fpp')
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality (FloatPrecisionRepr fpp -> BaseTypeRepr (BaseFloatType fpp)
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp) (Expr t (BaseFloatType fpp') -> BaseTypeRepr (BaseFloatType fpp')
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t (BaseFloatType fpp')
fval)
    = Expr t (BaseFloatType fpp') -> IO (Expr t (BaseFloatType fpp'))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseFloatType fpp')
fval
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseFloatType fpp)
 -> IO (Expr t (BaseFloatType fpp)))
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseFloatType fpp')
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type)
       (fpp' :: FloatPrecision).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp')
-> App e ('BaseFloatType fpp)
FloatCast FloatPrecisionRepr fpp
fpp RoundingMode
r SymFloat (ExprBuilder t st fs) fpp'
Expr t (BaseFloatType fpp')
x

  floatRound :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatRound ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) =
    ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (FloatPrecisionRepr fpp -> RoundingMode -> BigFloat -> BigFloat
forall (fpp :: FloatPrecision).
HasCallStack =>
FloatPrecisionRepr fpp -> RoundingMode -> BigFloat -> BigFloat
floatRoundToInt FloatPrecisionRepr fpp
fpp RoundingMode
r BigFloat
x)
  floatRound ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x = (FloatPrecisionRepr fpp
 -> RoundingMode
 -> Expr t (BaseFloatType fpp)
 -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> RoundingMode
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOpR FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatRound ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

  floatFromBinary :: forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st fs
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV (ExprBuilder t st fs) (eb + sb)
-> IO
     (SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st fs
sym FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp SymBV (ExprBuilder t st fs) (eb + sb)
x
    | Just BV (eb + sb)
bv <- Expr t (BaseBVType (eb + sb)) -> Maybe (BV (eb + sb))
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) (eb + sb)
Expr t (BaseBVType (eb + sb))
x
    = ExprBuilder t st fs
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> BigFloat
-> IO
     (SymExpr
        (ExprBuilder t st fs)
        (BaseFloatType (FloatingPointPrecision eb sb)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp (BFOpts -> Integer -> BigFloat
BF.bfFromBits (FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp RoundingMode
RNE) (BV (eb + sb) -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV (eb + sb)
bv))
    | Just (FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp' Expr t (BaseFloatType (FloatingPointPrecision eb sb))
fval) <- Expr t (BaseBVType (eb + sb))
-> Maybe (App (Expr t) (BaseBVType (eb + sb)))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) (eb + sb)
Expr t (BaseBVType (eb + sb))
x
    , Just FloatingPointPrecision eb sb :~: FloatingPointPrecision eb sb
Refl <- FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> Maybe
     (FloatingPointPrecision eb sb :~: FloatingPointPrecision eb sb)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: FloatPrecision) (b :: FloatPrecision).
FloatPrecisionRepr a -> FloatPrecisionRepr b -> Maybe (a :~: b)
testEquality FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp'
    = Expr t (BaseFloatType (FloatingPointPrecision eb sb))
-> IO (Expr t (BaseFloatType (FloatingPointPrecision eb sb)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseFloatType (FloatingPointPrecision eb sb))
fval
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseFloatType (FloatingPointPrecision eb sb))
-> IO (Expr t (BaseFloatType (FloatingPointPrecision eb sb)))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseFloatType (FloatingPointPrecision eb sb))
 -> IO (Expr t (BaseFloatType (FloatingPointPrecision eb sb))))
-> App (Expr t) (BaseFloatType (FloatingPointPrecision eb sb))
-> IO (Expr t (BaseFloatType (FloatingPointPrecision eb sb)))
forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> Expr t (BaseBVType (eb + sb))
-> App (Expr t) (BaseFloatType (FloatingPointPrecision eb sb))
forall (eb :: Natural) (sb :: Natural) (e :: BaseType -> Type).
(2 <= eb, 2 <= sb) =>
FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> e (BaseBVType (eb + sb))
-> App e ('BaseFloatType (FloatingPointPrecision eb sb))
FloatFromBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp SymBV (ExprBuilder t st fs) (eb + sb)
Expr t (BaseBVType (eb + sb))
x

  floatToBinary :: forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
-> IO (SymBV (ExprBuilder t st fs) (eb + sb))
floatToBinary ExprBuilder t st fs
sym (FloatExpr fpp :: FloatPrecisionRepr fpp
fpp@(FloatingPointPrecisionRepr NatRepr eb
eb NatRepr sb
sb) BigFloat
x ProgramLoc
_)
    | Just LeqProof 1 (eb + sb)
LeqProof <- NatRepr (eb + sb) -> Maybe (LeqProof 1 (eb + sb))
forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (NatRepr eb -> NatRepr sb -> NatRepr (eb + sb)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr eb
eb NatRepr sb
sb) =
        ExprBuilder t st fs
-> NatRepr (eb + sb)
-> BV (eb + sb)
-> IO (SymExpr (ExprBuilder t st fs) ('BaseBVType (eb + sb)))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (NatRepr eb -> NatRepr sb -> NatRepr (eb + sb)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr eb
eb NatRepr sb
sb) (NatRepr (eb + sb) -> Integer -> BV (eb + sb)
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV (NatRepr eb -> NatRepr sb -> NatRepr (eb + sb)
forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr eb
eb NatRepr sb
sb) (BFOpts -> BigFloat -> Integer
BF.bfToBits (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
RNE) BigFloat
x))
  floatToBinary ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
x = case Expr t (BaseFloatType (FloatingPointPrecision eb sb))
-> BaseTypeRepr (BaseFloatType (FloatingPointPrecision eb sb))
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
Expr t (BaseFloatType (FloatingPointPrecision eb sb))
x of
    BaseFloatRepr FloatPrecisionRepr fpp
fpp | LeqProof 1 (eb + sb)
LeqProof <- FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> LeqProof 1 (eb + sb)
forall (eb' :: Natural) (sb' :: Natural).
FloatPrecisionRepr (FloatingPointPrecision eb' sb')
-> LeqProof 1 (eb' + sb')
lemmaFloatPrecisionIsPos FloatPrecisionRepr fpp
FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp ->
      ExprBuilder t st fs
-> App (Expr t) ('BaseBVType (eb + sb))
-> IO (Expr t ('BaseBVType (eb + sb)))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) ('BaseBVType (eb + sb))
 -> IO (Expr t ('BaseBVType (eb + sb))))
-> App (Expr t) ('BaseBVType (eb + sb))
-> IO (Expr t ('BaseBVType (eb + sb)))
forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> Expr t (BaseFloatType (FloatingPointPrecision eb sb))
-> App (Expr t) ('BaseBVType (eb + sb))
forall (eb :: Natural) (sb :: Natural) (e :: BaseType -> Type).
(2 <= eb, 2 <= sb, 1 <= (eb + sb)) =>
FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> e (BaseFloatType (FloatingPointPrecision eb sb))
-> App e ('BaseBVType (eb + sb))
FloatToBinary FloatPrecisionRepr fpp
FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
Expr t (BaseFloatType (FloatingPointPrecision eb sb))
x

  floatMin :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatMin ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y =
    (ExprBuilder t st fs
 -> Pred (ExprBuilder t st fs)
 -> Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp)
 -> IO (Expr t (BaseFloatType fpp)))
-> ExprBuilder t st fs
-> [(IO (Pred (ExprBuilder t st fs)),
     IO (Expr t (BaseFloatType fpp)))]
-> IO (Expr t (BaseFloatType fpp))
-> IO (Expr t (BaseFloatType fpp))
forall sym v.
IsExprBuilder sym =>
(sym -> Pred sym -> v -> v -> IO v)
-> sym -> [(IO (Pred sym), IO v)] -> IO v -> IO v
iteList ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatIte ExprBuilder t st fs
sym
      [ (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x, Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y)
      , (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y, Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x)
      , (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x)
      , (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x , Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y)
      , (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x) -- NB logical equality, not IEEE 754 equality
      ]
      -- The only way to get here is if x and y are zeros
      -- with different sign.
      -- Return one of the two values nondeterministicly.
      (do BoolExpr t
b <- ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
emptySymbol BaseTypeRepr BaseBoolType
BaseBoolRepr
          ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
b SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y)

  floatMax :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatMax ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y =
    (ExprBuilder t st fs
 -> Pred (ExprBuilder t st fs)
 -> Expr t (BaseFloatType fpp)
 -> Expr t (BaseFloatType fpp)
 -> IO (Expr t (BaseFloatType fpp)))
-> ExprBuilder t st fs
-> [(IO (Pred (ExprBuilder t st fs)),
     IO (Expr t (BaseFloatType fpp)))]
-> IO (Expr t (BaseFloatType fpp))
-> IO (Expr t (BaseFloatType fpp))
forall sym v.
IsExprBuilder sym =>
(sym -> Pred sym -> v -> v -> IO v)
-> sym -> [(IO (Pred sym), IO v)] -> IO v -> IO v
iteList ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Expr t (BaseFloatType fpp)
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatIte ExprBuilder t st fs
sym
      [ (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x, Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y)
      , (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y, Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x)
      , (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
y)
      , (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x , Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x)
      , (ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , Expr t (BaseFloatType fpp) -> IO (Expr t (BaseFloatType fpp))
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x) -- NB logical equality, not IEEE 754 equality
      ]
      -- The only way to get here is if x and y are zeros
      -- with different sign.
      -- Return one of the two values nondeterministicly.
      (do BoolExpr t
b <- ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
emptySymbol BaseTypeRepr BaseBoolType
BaseBoolRepr
          ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
BoolExpr t
b SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y)

  bvToFloat :: forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV (ExprBuilder t st fs) w
-> IO (SymFloat (ExprBuilder t st fs) fpp)
bvToFloat ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymBV (ExprBuilder t st fs) w
x
    | Just BV w
bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymExpr (ExprBuilder t st fs) (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BFOpts -> Integer -> BigFloat
floatFromInteger (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) (BV w -> Integer
forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
bv))
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseFloatType fpp)
forall (w :: Natural) (fpp :: FloatPrecision)
       (e :: BaseType -> Type).
(1 <= w) =>
FloatPrecisionRepr fpp
-> RoundingMode -> e (BaseBVType w) -> App e ('BaseFloatType fpp)
BVToFloat FloatPrecisionRepr fpp
fpp RoundingMode
r SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)

  sbvToFloat :: forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV (ExprBuilder t st fs) w
-> IO (SymFloat (ExprBuilder t st fs) fpp)
sbvToFloat ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymBV (ExprBuilder t st fs) w
x
    | Just BV w
bv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (w :: Natural). Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymExpr (ExprBuilder t st fs) (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BFOpts -> Integer -> BigFloat
floatFromInteger (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) (NatRepr w -> BV w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> BV w -> Integer
BV.asSigned (Expr t (BaseBVType w) -> NatRepr w
forall (w :: Natural). Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
bv))
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t (BaseBVType w)
-> App (Expr t) (BaseFloatType fpp)
forall (w :: Natural) (fpp :: FloatPrecision)
       (e :: BaseType -> Type).
(1 <= w) =>
FloatPrecisionRepr fpp
-> RoundingMode -> e (BaseBVType w) -> App e ('BaseFloatType fpp)
SBVToFloat FloatPrecisionRepr fpp
fpp RoundingMode
r SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)

  realToFloat :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymReal (ExprBuilder t st fs)
-> IO (SymFloat (ExprBuilder t st fs) fpp)
realToFloat ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymReal (ExprBuilder t st fs)
x
    | Just Rational
x' <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymExpr (ExprBuilder t st fs) (BaseFloatType fpp))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BFOpts -> Rational -> BigFloat
floatFromRational (FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) Rational
x')
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (FloatPrecisionRepr fpp
-> RoundingMode
-> Expr t BaseRealType
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode -> e BaseRealType -> App e ('BaseFloatType fpp)
RealToFloat FloatPrecisionRepr fpp
fpp RoundingMode
r SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  floatToBV :: forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymBV (ExprBuilder t st fs) w)
floatToBV ExprBuilder t st fs
sym NatRepr w
w RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x
    | FloatExpr FloatPrecisionRepr fpp
_ BigFloat
bf ProgramLoc
_ <- SymFloat (ExprBuilder t st fs) fpp
x
    , Just Integer
i <- RoundingMode -> BigFloat -> Maybe Integer
floatToInteger RoundingMode
r BigFloat
bf
    , Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
    = ExprBuilder t st fs
-> NatRepr w
-> BV w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)

    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (NatRepr w
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type)
       (fpp :: FloatPrecision).
(1 <= w) =>
NatRepr w
-> RoundingMode -> e (BaseFloatType fpp) -> App e ('BaseBVType w)
FloatToBV NatRepr w
w RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x)

  floatToSBV :: forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymBV (ExprBuilder t st fs) w)
floatToSBV ExprBuilder t st fs
sym NatRepr w
w RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x
    | FloatExpr FloatPrecisionRepr fpp
_ BigFloat
bf ProgramLoc
_ <- SymFloat (ExprBuilder t st fs) fpp
x
    , Just Integer
i <- RoundingMode -> BigFloat -> Maybe Integer
floatToInteger RoundingMode
r BigFloat
bf
    , NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
    = ExprBuilder t st fs
-> NatRepr w
-> BV w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)

    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (Expr t (BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (NatRepr w
-> RoundingMode
-> Expr t (BaseFloatType fpp)
-> App (Expr t) (BaseBVType w)
forall (w :: Natural) (e :: BaseType -> Type)
       (fpp :: FloatPrecision).
(1 <= w) =>
NatRepr w
-> RoundingMode -> e (BaseFloatType fpp) -> App e ('BaseBVType w)
FloatToSBV NatRepr w
w RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x)

  floatToReal :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymReal (ExprBuilder t st fs))
floatToReal ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
    | FloatExpr FloatPrecisionRepr fpp
_ BigFloat
bf ProgramLoc
_ <- SymFloat (ExprBuilder t st fs) fpp
x
    , Just Rational
q <- BigFloat -> Maybe Rational
floatToRational BigFloat
bf
    = ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
q

    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t (BaseFloatType fpp) -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseRealType
FloatToReal SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x)

  floatSpecialFunction :: forall (fpp :: FloatPrecision) (args :: Ctx Type).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> SpecialFunction args
-> Assignment
     (SpecialFnArg (SymExpr (ExprBuilder t st fs)) (BaseFloatType fpp))
     args
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatSpecialFunction ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp SpecialFunction args
fn Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) (BaseFloatType fpp))
  args
args =
    ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (FloatPrecisionRepr fpp
-> SpecialFunction args
-> SpecialFnArgs (Expr t) (BaseFloatType fpp) args
-> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (args :: Ctx Type)
       (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> SpecialFunction args
-> SpecialFnArgs e (BaseFloatType fpp) args
-> App e (BaseFloatType fpp)
FloatSpecialFunction FloatPrecisionRepr fpp
fpp SpecialFunction args
fn (Assignment (SpecialFnArg (Expr t) (BaseFloatType fpp)) args
-> SpecialFnArgs (Expr t) (BaseFloatType fpp) args
forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) (BaseFloatType fpp))
  args
Assignment (SpecialFnArg (Expr t) (BaseFloatType fpp)) args
args))

  ----------------------------------------------------------------------
  -- Cplx operations

  mkComplex :: ExprBuilder t st fs
-> Complex (SymReal (ExprBuilder t st fs))
-> IO (SymCplx (ExprBuilder t st fs))
mkComplex ExprBuilder t st fs
sym Complex (SymReal (ExprBuilder t st fs))
c = ExprBuilder t st fs
-> App (Expr t) 'BaseComplexType -> IO (Expr t 'BaseComplexType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Complex (Expr t BaseRealType) -> App (Expr t) 'BaseComplexType
forall (e :: BaseType -> Type).
Complex (e BaseRealType) -> App e 'BaseComplexType
Cplx Complex (SymReal (ExprBuilder t st fs))
Complex (Expr t BaseRealType)
c)

  getRealPart :: ExprBuilder t st fs
-> SymCplx (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
getRealPart ExprBuilder t st fs
_ SymCplx (ExprBuilder t st fs)
e
    | Just (Cplx (Expr t BaseRealType
r :+ Expr t BaseRealType
_)) <- Expr t 'BaseComplexType -> Maybe (App (Expr t) 'BaseComplexType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymCplx (ExprBuilder t st fs)
Expr t 'BaseComplexType
e = Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseRealType
r
  getRealPart ExprBuilder t st fs
sym SymCplx (ExprBuilder t st fs)
x =
    ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t 'BaseComplexType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
RealPart SymCplx (ExprBuilder t st fs)
Expr t 'BaseComplexType
x)

  getImagPart :: ExprBuilder t st fs
-> SymCplx (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
getImagPart ExprBuilder t st fs
_ SymCplx (ExprBuilder t st fs)
e
    | Just (Cplx (Expr t BaseRealType
_ :+ Expr t BaseRealType
i)) <- Expr t 'BaseComplexType -> Maybe (App (Expr t) 'BaseComplexType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymCplx (ExprBuilder t st fs)
Expr t 'BaseComplexType
e = Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseRealType
i
  getImagPart ExprBuilder t st fs
sym SymCplx (ExprBuilder t st fs)
x =
    ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t 'BaseComplexType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
ImagPart SymCplx (ExprBuilder t st fs)
Expr t 'BaseComplexType
x)

  cplxGetParts :: ExprBuilder t st fs
-> SymCplx (ExprBuilder t st fs)
-> IO (Complex (SymReal (ExprBuilder t st fs)))
cplxGetParts ExprBuilder t st fs
_ SymCplx (ExprBuilder t st fs)
e
    | Just (Cplx Complex (Expr t BaseRealType)
c) <- Expr t 'BaseComplexType -> Maybe (App (Expr t) 'BaseComplexType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymCplx (ExprBuilder t st fs)
Expr t 'BaseComplexType
e = Complex (Expr t BaseRealType) -> IO (Complex (Expr t BaseRealType))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Complex (Expr t BaseRealType)
c
  cplxGetParts ExprBuilder t st fs
sym SymCplx (ExprBuilder t st fs)
x =
    Expr t BaseRealType
-> Expr t BaseRealType -> Complex (Expr t BaseRealType)
forall a. a -> a -> Complex a
(:+) (Expr t BaseRealType
 -> Expr t BaseRealType -> Complex (Expr t BaseRealType))
-> IO (Expr t BaseRealType)
-> IO (Expr t BaseRealType -> Complex (Expr t BaseRealType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t 'BaseComplexType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
RealPart SymCplx (ExprBuilder t st fs)
Expr t 'BaseComplexType
x)
         IO (Expr t BaseRealType -> Complex (Expr t BaseRealType))
-> IO (Expr t BaseRealType) -> IO (Complex (Expr t BaseRealType))
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t 'BaseComplexType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
ImagPart SymCplx (ExprBuilder t st fs)
Expr t 'BaseComplexType
x)



inSameBVSemiRing :: Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> Maybe (Some SR.BVFlavorRepr)
inSameBVSemiRing :: forall t (w :: Natural).
Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (Some BVFlavorRepr)
inSameBVSemiRing Expr t (BaseBVType w)
x Expr t (BaseBVType w)
y
  | Just (SemiRingSum WeightedSum (Expr t) sr
s1) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseBVType w)
x
  , Just (SemiRingSum WeightedSum (Expr t) sr
s2) <- Expr t (BaseBVType w) -> Maybe (App (Expr t) (BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseBVType w)
y
  , SR.SemiRingBVRepr BVFlavorRepr fv
flv1 NatRepr w
_w <- WeightedSum (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s1
  , SR.SemiRingBVRepr BVFlavorRepr fv
flv2 NatRepr w
_w <- WeightedSum (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s2
  , Just fv :~: fv
Refl <- BVFlavorRepr fv -> BVFlavorRepr fv -> Maybe (fv :~: fv)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BVFlavor) (b :: BVFlavor).
BVFlavorRepr a -> BVFlavorRepr b -> Maybe (a :~: b)
testEquality BVFlavorRepr fv
flv1 BVFlavorRepr fv
flv2
  = Some BVFlavorRepr -> Maybe (Some BVFlavorRepr)
forall a. a -> Maybe a
Just (BVFlavorRepr fv -> Some BVFlavorRepr
forall k (f :: k -> Type) (x :: k). f x -> Some f
Some BVFlavorRepr fv
flv1)

  | Bool
otherwise
  = Maybe (Some BVFlavorRepr)
forall a. Maybe a
Nothing

floatIEEEArithBinOp
  :: (e ~ Expr t)
  => (  FloatPrecisionRepr fpp
     -> e (BaseFloatType fpp)
     -> e (BaseFloatType fpp)
     -> App e (BaseFloatType fpp)
     )
  -> ExprBuilder t st fs
  -> e (BaseFloatType fpp)
  -> e (BaseFloatType fpp)
  -> IO (e (BaseFloatType fpp))
floatIEEEArithBinOp :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> e (BaseFloatType fpp)
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOp FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor ExprBuilder t st fs
sym e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y =
  let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = e (BaseFloatType fpp) -> BaseTypeRepr (BaseFloatType fpp)
forall (tp :: BaseType). e tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseFloatType fpp)
 -> IO (Expr t (BaseFloatType fpp)))
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor FloatPrecisionRepr fpp
fpp e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y
floatIEEEArithBinOpR
  :: (e ~ Expr t)
  => (  FloatPrecisionRepr fpp
     -> RoundingMode
     -> e (BaseFloatType fpp)
     -> e (BaseFloatType fpp)
     -> App e (BaseFloatType fpp)
     )
  -> ExprBuilder t st fs
  -> RoundingMode
  -> e (BaseFloatType fpp)
  -> e (BaseFloatType fpp)
  -> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> RoundingMode
 -> e (BaseFloatType fpp)
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor ExprBuilder t st fs
sym RoundingMode
r e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y =
  let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = e (BaseFloatType fpp) -> BaseTypeRepr (BaseFloatType fpp)
forall (tp :: BaseType). e tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseFloatType fpp)
 -> IO (Expr t (BaseFloatType fpp)))
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor FloatPrecisionRepr fpp
fpp RoundingMode
r e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y
floatIEEEArithUnOp
  :: (e ~ Expr t)
  => (  FloatPrecisionRepr fpp
     -> e (BaseFloatType fpp)
     -> App e (BaseFloatType fpp)
     )
  -> ExprBuilder t st fs
  -> e (BaseFloatType fpp)
  -> IO (e (BaseFloatType fpp))
floatIEEEArithUnOp :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> e (BaseFloatType fpp) -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOp FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp)
ctor ExprBuilder t st fs
sym e (BaseFloatType fpp)
x =
  let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = e (BaseFloatType fpp) -> BaseTypeRepr (BaseFloatType fpp)
forall (tp :: BaseType). e tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseFloatType fpp)
 -> IO (Expr t (BaseFloatType fpp)))
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp)
ctor FloatPrecisionRepr fpp
fpp e (BaseFloatType fpp)
x
floatIEEEArithUnOpR
  :: (e ~ Expr t)
  => (  FloatPrecisionRepr fpp
     -> RoundingMode
     -> e (BaseFloatType fpp)
     -> App e (BaseFloatType fpp)
     )
  -> ExprBuilder t st fs
  -> RoundingMode
  -> e (BaseFloatType fpp)
  -> IO (e (BaseFloatType fpp))
floatIEEEArithUnOpR :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> RoundingMode
 -> e (BaseFloatType fpp)
 -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOpR FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor ExprBuilder t st fs
sym RoundingMode
r e (BaseFloatType fpp)
x =
  let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = e (BaseFloatType fpp) -> BaseTypeRepr (BaseFloatType fpp)
forall (tp :: BaseType). e tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in ExprBuilder t st fs
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseFloatType fpp)
 -> IO (Expr t (BaseFloatType fpp)))
-> App (Expr t) (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor FloatPrecisionRepr fpp
fpp RoundingMode
r e (BaseFloatType fpp)
x


floatIEEELogicBinOp
  :: (e ~ Expr t)
  => (e (BaseFloatType fpp) -> e (BaseFloatType fpp) -> App e BaseBoolType)
  -> ExprBuilder t st fs
  -> e (BaseFloatType fpp)
  -> e (BaseFloatType fpp)
  -> IO (e BaseBoolType)
floatIEEELogicBinOp :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
 -> e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicBinOp e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e BaseBoolType
ctor ExprBuilder t st fs
sym e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y = ExprBuilder t st fs
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType))
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e BaseBoolType
ctor e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y
floatIEEELogicUnOp
  :: (e ~ Expr t)
  => (e (BaseFloatType fpp) -> App e BaseBoolType)
  -> ExprBuilder t st fs
  -> e (BaseFloatType fpp)
  -> IO (e BaseBoolType)
floatIEEELogicUnOp :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicUnOp e (BaseFloatType fpp) -> App e BaseBoolType
ctor ExprBuilder t st fs
sym e (BaseFloatType fpp)
x = ExprBuilder t st fs
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType))
-> App (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ e (BaseFloatType fpp) -> App e BaseBoolType
ctor e (BaseFloatType fpp)
x


----------------------------------------------------------------------
-- Float interpretations

type instance SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi =
  BaseRealType

instance IsInterpretedFloatExprBuilder (ExprBuilder t st (Flags FloatReal)) where
  iFloatPZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatPZero ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ = SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
 -> IO
      (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi))
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
  iFloatNZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatNZero ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ = SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
 -> IO
      (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi))
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
  iFloatNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatNaN ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ = String -> IO (Expr t BaseRealType)
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"NaN cannot be represented as a real value."
  iFloatPInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatPInf ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ = String -> IO (Expr t BaseRealType)
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"+Infinity cannot be represented as a real value."
  iFloatNInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatNInf ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ = String -> IO (Expr t BaseRealType)
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"-Infinity cannot be represented as a real value."
  iFloatLitRational :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> Rational
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatLitRational ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ = ExprBuilder t st (Flags FloatReal)
-> Rational -> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym
  iFloatLitSingle :: ExprBuilder t st (Flags FloatReal)
-> Float
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatReal)) SingleFloat)
iFloatLitSingle ExprBuilder t st (Flags FloatReal)
sym = ExprBuilder t st (Flags FloatReal)
-> Rational -> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym (Rational -> IO (Expr t BaseRealType))
-> (Float -> Rational) -> Float -> IO (Expr t BaseRealType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Rational
forall a. Real a => a -> Rational
toRational
  iFloatLitDouble :: ExprBuilder t st (Flags FloatReal)
-> Double
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatReal)) DoubleFloat)
iFloatLitDouble ExprBuilder t st (Flags FloatReal)
sym = ExprBuilder t st (Flags FloatReal)
-> Rational -> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym (Rational -> IO (Expr t BaseRealType))
-> (Double -> Rational) -> Double -> IO (Expr t BaseRealType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational
  iFloatLitLongDouble :: ExprBuilder t st (Flags FloatReal)
-> X86_80Val
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatReal)) X86_80Float)
iFloatLitLongDouble ExprBuilder t st (Flags FloatReal)
sym X86_80Val
x =
     case X86_80Val -> Maybe Rational
fp80ToRational X86_80Val
x of
       Maybe Rational
Nothing -> String -> IO (Expr t BaseRealType)
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
"80-bit floating point value does not represent a rational number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ X86_80Val -> String
forall a. Show a => a -> String
show X86_80Val
x)
       Just Rational
r  -> ExprBuilder t st (Flags FloatReal)
-> Rational -> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym Rational
r
  iFloatNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatNeg = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatReal))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymReal sym)
realNeg
  iFloatAbs :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatAbs = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatReal))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymReal sym)
realAbs
  iFloatSqrt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatSqrt ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymReal sym)
realSqrt ExprBuilder t st (Flags FloatReal)
sym
  iFloatAdd :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatAdd ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realAdd ExprBuilder t st (Flags FloatReal)
sym
  iFloatSub :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatSub ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realSub ExprBuilder t st (Flags FloatReal)
sym
  iFloatMul :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatMul ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realMul ExprBuilder t st (Flags FloatReal)
sym
  iFloatDiv :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatDiv ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realDiv ExprBuilder t st (Flags FloatReal)
sym
  iFloatRem :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatRem = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatReal))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realMod
  iFloatMin :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatMin ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y = do
    Expr t BaseBoolType
c <- ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLe ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
    ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realIte ExprBuilder t st (Flags FloatReal)
sym Pred (ExprBuilder t st (Flags FloatReal))
Expr t BaseBoolType
c SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
  iFloatMax :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatMax ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y = do
    Expr t BaseBoolType
c <- ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGe ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
    ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realIte ExprBuilder t st (Flags FloatReal)
sym Pred (ExprBuilder t st (Flags FloatReal))
Expr t BaseBoolType
c SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
  iFloatFMA :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatFMA ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
z = do
    Expr t BaseRealType
tmp <- (ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realMul ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y)
    ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realAdd ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
Expr t BaseRealType
tmp SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
z
  iFloatEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatEq = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq
  iFloatNe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatNe = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realNe
  iFloatFpEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatFpEq = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq
  iFloatFpApart :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatFpApart = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realNe
  iFloatLe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatLe = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLe
  iFloatLt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatLt = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLt
  iFloatGe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatGe = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGe
  iFloatGt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatGt = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGt
  iFloatIte :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatIte = ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatReal))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatReal))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realIte
  iFloatIsNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsNaN ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
_ = Pred (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st (Flags FloatReal))
 -> IO (Pred (ExprBuilder t st (Flags FloatReal))))
-> Pred (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st (Flags FloatReal)
sym
  iFloatIsInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsInf ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
_ = Pred (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st (Flags FloatReal))
 -> IO (Pred (ExprBuilder t st (Flags FloatReal))))
-> Pred (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st (Flags FloatReal)
sym
  iFloatIsZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsZero ExprBuilder t st (Flags FloatReal)
sym = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq ExprBuilder t st (Flags FloatReal)
sym (SymReal (ExprBuilder t st (Flags FloatReal))
 -> SymReal (ExprBuilder t st (Flags FloatReal))
 -> IO (Pred (ExprBuilder t st (Flags FloatReal))))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
  iFloatIsPos :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsPos ExprBuilder t st (Flags FloatReal)
sym = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLt ExprBuilder t st (Flags FloatReal)
sym (SymReal (ExprBuilder t st (Flags FloatReal))
 -> SymReal (ExprBuilder t st (Flags FloatReal))
 -> IO (Pred (ExprBuilder t st (Flags FloatReal))))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
  iFloatIsNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsNeg ExprBuilder t st (Flags FloatReal)
sym = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGt ExprBuilder t st (Flags FloatReal)
sym (SymReal (ExprBuilder t st (Flags FloatReal))
 -> SymReal (ExprBuilder t st (Flags FloatReal))
 -> IO (Pred (ExprBuilder t st (Flags FloatReal))))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
  iFloatIsSubnorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsSubnorm ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
_ = Pred (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Pred (ExprBuilder t st (Flags FloatReal))
 -> IO (Pred (ExprBuilder t st (Flags FloatReal))))
-> Pred (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st (Flags FloatReal)
sym
  iFloatIsNorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsNorm ExprBuilder t st (Flags FloatReal)
sym = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realNe ExprBuilder t st (Flags FloatReal)
sym (SymReal (ExprBuilder t st (Flags FloatReal))
 -> SymReal (ExprBuilder t st (Flags FloatReal))
 -> IO (Pred (ExprBuilder t st (Flags FloatReal))))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
  iFloatCast :: forall (fi :: FloatInfo) (fi' :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi'
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatCast ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ RoundingMode
_ = SymExpr
  (ExprBuilder t st (Flags FloatReal))
  (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi')
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatReal))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
  iFloatRound :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatRound ExprBuilder t st (Flags FloatReal)
sym RoundingMode
r SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x =
    ExprBuilder t st (Flags FloatReal)
-> SymInteger (ExprBuilder t st (Flags FloatReal))
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> IO (SymReal sym)
integerToReal ExprBuilder t st (Flags FloatReal)
sym (Expr t BaseIntegerType -> IO (Expr t BaseRealType))
-> IO (Expr t BaseIntegerType) -> IO (Expr t BaseRealType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< case RoundingMode
r of
      RoundingMode
RNA -> ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymInteger (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realRound ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
      RoundingMode
RTP -> ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymInteger (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realCeil ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
      RoundingMode
RTN -> ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymInteger (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realFloor ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
      RoundingMode
RTZ -> do
        Expr t BaseBoolType
is_pos <- ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLt ExprBuilder t st (Flags FloatReal)
sym (ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym) SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
        (ExprBuilder t st (Flags FloatReal)
 -> Pred (ExprBuilder t st (Flags FloatReal))
 -> Expr t BaseIntegerType
 -> Expr t BaseIntegerType
 -> IO (Expr t BaseIntegerType))
-> ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
-> IO (Expr t BaseIntegerType)
-> IO (Expr t BaseIntegerType)
-> IO (Expr t BaseIntegerType)
forall sym v.
IsExprBuilder sym =>
(sym -> Pred sym -> v -> v -> IO v)
-> sym -> Pred sym -> IO v -> IO v -> IO v
iteM ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
-> SymInteger (ExprBuilder t st (Flags FloatReal))
-> SymInteger (ExprBuilder t st (Flags FloatReal))
-> IO (SymInteger (ExprBuilder t st (Flags FloatReal)))
ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
-> Expr t BaseIntegerType
-> Expr t BaseIntegerType
-> IO (Expr t BaseIntegerType)
forall sym.
IsExprBuilder sym =>
sym
-> Pred sym
-> SymInteger sym
-> SymInteger sym
-> IO (SymInteger sym)
intIte ExprBuilder t st (Flags FloatReal)
sym Pred (ExprBuilder t st (Flags FloatReal))
Expr t BaseBoolType
is_pos (ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymInteger (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realFloor ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x) (ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymInteger (ExprBuilder t st (Flags FloatReal)))
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realCeil ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x)
      RoundingMode
RNE -> String -> IO (Expr t BaseIntegerType)
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Unsupported rond to nearest even for real values."
  iFloatFromBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> SymBV
     (ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatFromBinary ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ SymBV (ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi)
x
    | Just (FnApp ExprSymFn t args (BaseBVType (FloatInfoToBitWidth fi))
fn Assignment (Expr t) args
args) <- Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Maybe
     (NonceApp t (Expr t) (BaseBVType (FloatInfoToBitWidth fi)))
forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp SymBV (ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi)
Expr t (BaseBVType (FloatInfoToBitWidth fi))
x
    , Text
"uninterpreted_real_to_float_binary" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== SolverSymbol -> Text
solverSymbolAsText (ExprSymFn t args (BaseBVType (FloatInfoToBitWidth fi))
-> SolverSymbol
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName ExprSymFn t args (BaseBVType (FloatInfoToBitWidth fi))
fn)
    , UninterpFnInfo Assignment BaseTypeRepr args
param_types (BaseBVRepr NatRepr w
_) <- ExprSymFn t args (BaseBVType (FloatInfoToBitWidth fi))
-> SymFnInfo t args (BaseBVType (FloatInfoToBitWidth fi))
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args (BaseBVType (FloatInfoToBitWidth fi))
fn
    , (Assignment BaseTypeRepr ctx
Ctx.Empty Ctx.:> BaseTypeRepr tp
BaseRealRepr) <- Assignment BaseTypeRepr args
param_types
    , (Assignment (Expr t) ctx
Ctx.Empty Ctx.:> Expr t tp
rval) <- Assignment (Expr t) args
args
    = Expr t tp -> IO (Expr t tp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t tp
rval
    | Bool
otherwise = ExprBuilder t st (Flags FloatReal)
-> String
-> Assignment
     (SymExpr (ExprBuilder t st (Flags FloatReal)))
     (EmptyCtx ::> BaseBVType (FloatInfoToBitWidth fi))
-> BaseTypeRepr BaseRealType
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkFreshUninterpFnApp ExprBuilder t st (Flags FloatReal)
sym
                                       String
"uninterpreted_real_from_float_binary"
                                       (Assignment (Expr t) EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty Assignment (Expr t) EmptyCtx
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Assignment
     (Expr t) (EmptyCtx ::> BaseBVType (FloatInfoToBitWidth fi))
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymBV (ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi)
Expr t (BaseBVType (FloatInfoToBitWidth fi))
x)
                                       BaseTypeRepr BaseRealType
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
  iFloatToBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO
     (SymBV
        (ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi))
iFloatToBinary ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
fi SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x =
    ExprBuilder t st (Flags FloatReal)
-> String
-> Assignment
     (SymExpr (ExprBuilder t st (Flags FloatReal)))
     (EmptyCtx '::> BaseRealType)
-> BaseTypeRepr ('BaseBVType (FloatInfoToBitWidth fi))
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatReal))
        ('BaseBVType (FloatInfoToBitWidth fi)))
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkFreshUninterpFnApp ExprBuilder t st (Flags FloatReal)
sym
                         String
"uninterpreted_real_to_float_binary"
                         (Assignment (Expr t) EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty Assignment (Expr t) EmptyCtx
-> Expr t BaseRealType
-> Assignment (Expr t) (EmptyCtx '::> BaseRealType)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
Expr t BaseRealType
x)
                         (FloatInfoRepr fi
-> BaseTypeRepr ('BaseBVType (FloatInfoToBitWidth fi))
forall (fi :: FloatInfo).
FloatInfoRepr fi
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
floatInfoToBVTypeRepr FloatInfoRepr fi
fi)
  iBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatReal)) w
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iBVToFloat ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ RoundingMode
_ = ExprBuilder t st (Flags FloatReal)
-> SymExpr (ExprBuilder t st (Flags FloatReal)) ('BaseBVType w)
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> SymBV (ExprBuilder t st (Flags FloatReal)) w
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymReal sym)
uintToReal ExprBuilder t st (Flags FloatReal)
sym
  iSBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatReal)) w
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iSBVToFloat ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ RoundingMode
_ = ExprBuilder t st (Flags FloatReal)
-> SymExpr (ExprBuilder t st (Flags FloatReal)) ('BaseBVType w)
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> SymBV (ExprBuilder t st (Flags FloatReal)) w
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymReal sym)
sbvToReal ExprBuilder t st (Flags FloatReal)
sym
  iRealToFloat :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iRealToFloat ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ RoundingMode
_ = SymReal (ExprBuilder t st (Flags FloatReal))
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatReal))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
  iFloatToBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatReal)) w)
iFloatToBV ExprBuilder t st (Flags FloatReal)
sym NatRepr w
w RoundingMode
_ SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> NatRepr w
-> IO (SymExpr (ExprBuilder t st (Flags FloatReal)) (BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> NatRepr w
-> IO (SymBV (ExprBuilder t st (Flags FloatReal)) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymReal sym -> NatRepr w -> IO (SymBV sym w)
realToBV ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x NatRepr w
w
  iFloatToSBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatReal)) w)
iFloatToSBV ExprBuilder t st (Flags FloatReal)
sym NatRepr w
w RoundingMode
_ SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x = ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> NatRepr w
-> IO (SymExpr (ExprBuilder t st (Flags FloatReal)) (BaseBVType w))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> NatRepr w
-> IO (SymBV (ExprBuilder t st (Flags FloatReal)) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymReal sym -> NatRepr w -> IO (SymBV sym w)
realToSBV ExprBuilder t st (Flags FloatReal)
sym SymReal (ExprBuilder t st (Flags FloatReal))
SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x NatRepr w
w
  iFloatToReal :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
iFloatToReal ExprBuilder t st (Flags FloatReal)
_ = SymExpr
  (ExprBuilder t st (Flags FloatReal))
  (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
  iFloatSpecialFunction :: forall (fi :: FloatInfo) (args :: Ctx Type).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> SpecialFunction args
-> Assignment
     (SpecialFnArg
        (SymExpr (ExprBuilder t st (Flags FloatReal)))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
     args
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatSpecialFunction ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ SpecialFunction args
fn Assignment
  (SpecialFnArg
     (SymExpr (ExprBuilder t st (Flags FloatReal)))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
  args
args = ExprBuilder t st (Flags FloatReal)
-> SpecialFunction args
-> Assignment
     (SpecialFnArg
        (SymExpr (ExprBuilder t st (Flags FloatReal))) BaseRealType)
     args
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
forall sym (args :: Ctx Type).
IsExprBuilder sym =>
sym
-> SpecialFunction args
-> Assignment (SpecialFnArg (SymExpr sym) BaseRealType) args
-> IO (SymReal sym)
forall (args :: Ctx Type).
ExprBuilder t st (Flags FloatReal)
-> SpecialFunction args
-> Assignment
     (SpecialFnArg
        (SymExpr (ExprBuilder t st (Flags FloatReal))) BaseRealType)
     args
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
realSpecialFunction ExprBuilder t st (Flags FloatReal)
sym SpecialFunction args
fn Assignment
  (SpecialFnArg
     (SymExpr (ExprBuilder t st (Flags FloatReal))) BaseRealType)
  args
Assignment
  (SpecialFnArg
     (SymExpr (ExprBuilder t st (Flags FloatReal)))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
  args
args
  iFloatBaseTypeRepr :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ = BaseTypeRepr BaseRealType
BaseTypeRepr
  (SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

type instance SymInterpretedFloatType (ExprBuilder t st (Flags FloatUninterpreted)) fi =
  BaseBVType (FloatInfoToBitWidth fi)

instance IsInterpretedFloatExprBuilder (ExprBuilder t st (Flags FloatUninterpreted)) where
  iFloatPZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatPZero ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_pzero" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> (FloatInfoRepr fi
    -> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi)))
-> FloatInfoRepr fi
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
  iFloatNZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatNZero ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_nzero" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> (FloatInfoRepr fi
    -> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi)))
-> FloatInfoRepr fi
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
  iFloatNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatNaN ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_nan" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> (FloatInfoRepr fi
    -> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi)))
-> FloatInfoRepr fi
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
  iFloatPInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatPInf ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_pinf" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> (FloatInfoRepr fi
    -> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi)))
-> FloatInfoRepr fi
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
  iFloatNInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatNInf ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_ninf" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> (FloatInfoRepr fi
    -> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi)))
-> FloatInfoRepr fi
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
  iFloatLitRational :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> Rational
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatLitRational ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr fi
fi Rational
x = ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatUninterpreted))
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatUninterpreted))
        (SymInterpretedFloatType
           (ExprBuilder t st (Flags FloatUninterpreted)) fi))
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal sym
-> IO (SymInterpretedFloat sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatUninterpreted))
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iRealToFloat ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr fi
fi RoundingMode
RNE (Expr t BaseRealType
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> IO (Expr t BaseRealType)
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st (Flags FloatUninterpreted)
-> Rational
-> IO (SymReal (ExprBuilder t st (Flags FloatUninterpreted)))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatUninterpreted)
sym Rational
x
  iFloatLitSingle :: ExprBuilder t st (Flags FloatUninterpreted)
-> Float
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) SingleFloat)
iFloatLitSingle ExprBuilder t st (Flags FloatUninterpreted)
sym Float
x =
    ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr SingleFloat
-> SymBV
     (ExprBuilder t st (Flags FloatUninterpreted))
     (FloatInfoToBitWidth SingleFloat)
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) SingleFloat)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SymBV sym (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> SymBV
     (ExprBuilder t st (Flags FloatUninterpreted))
     (FloatInfoToBitWidth fi)
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr SingleFloat
SingleFloatRepr
      (Expr t ('BaseBVType 32) -> IO (Expr t ('BaseBVType 32)))
-> IO (Expr t ('BaseBVType 32)) -> IO (Expr t ('BaseBVType 32))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr 32
-> BV 32
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) 32)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr w
-> BV w
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatUninterpreted)
sym NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (BV 32
 -> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) 32))
-> BV 32
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) 32)
forall a b. (a -> b) -> a -> b
$ Word32 -> BV 32
BV.word32 (Word32 -> BV 32) -> Word32 -> BV 32
forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 Float
x)
  iFloatLitDouble :: ExprBuilder t st (Flags FloatUninterpreted)
-> Double
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) DoubleFloat)
iFloatLitDouble ExprBuilder t st (Flags FloatUninterpreted)
sym Double
x =
    ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr DoubleFloat
-> SymBV
     (ExprBuilder t st (Flags FloatUninterpreted))
     (FloatInfoToBitWidth DoubleFloat)
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) DoubleFloat)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SymBV sym (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> SymBV
     (ExprBuilder t st (Flags FloatUninterpreted))
     (FloatInfoToBitWidth fi)
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr DoubleFloat
DoubleFloatRepr
      (Expr t ('BaseBVType 64) -> IO (Expr t ('BaseBVType 64)))
-> IO (Expr t ('BaseBVType 64)) -> IO (Expr t ('BaseBVType 64))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr 64
-> BV 64
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) 64)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr w
-> BV w
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatUninterpreted)
sym NatRepr 64
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (BV 64
 -> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) 64))
-> BV 64
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) 64)
forall a b. (a -> b) -> a -> b
$ Word64 -> BV 64
BV.word64 (Word64 -> BV 64) -> Word64 -> BV 64
forall a b. (a -> b) -> a -> b
$ Double -> Word64
castDoubleToWord64 Double
x)
  iFloatLitLongDouble :: ExprBuilder t st (Flags FloatUninterpreted)
-> X86_80Val
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) X86_80Float)
iFloatLitLongDouble ExprBuilder t st (Flags FloatUninterpreted)
sym X86_80Val
x =
    ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr X86_80Float
-> SymBV
     (ExprBuilder t st (Flags FloatUninterpreted))
     (FloatInfoToBitWidth X86_80Float)
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) X86_80Float)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SymBV sym (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> SymBV
     (ExprBuilder t st (Flags FloatUninterpreted))
     (FloatInfoToBitWidth fi)
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr X86_80Float
X86_80FloatRepr
      (Expr t ('BaseBVType 80) -> IO (Expr t ('BaseBVType 80)))
-> IO (Expr t ('BaseBVType 80)) -> IO (Expr t ('BaseBVType 80))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr 80
-> BV 80
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) 80)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr w
-> BV w
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatUninterpreted)
sym NatRepr 80
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (BV 80
 -> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) 80))
-> BV 80
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) 80)
forall a b. (a -> b) -> a -> b
$ NatRepr 80 -> Integer -> BV 80
forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr 80
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (Integer -> BV 80) -> Integer -> BV 80
forall a b. (a -> b) -> a -> b
$ X86_80Val -> Integer
fp80ToBits X86_80Val
x)

  iFloatNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatNeg = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e bt)
floatUninterpArithUnOp String
"uninterpreted_float_neg"
  iFloatAbs :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatAbs = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e bt)
floatUninterpArithUnOp String
"uninterpreted_float_abs"
  iFloatSqrt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatSqrt = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> RoundingMode -> e bt -> IO (e bt)
floatUninterpArithUnOpR String
"uninterpreted_float_sqrt"
  iFloatAdd :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatAdd = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
"uninterpreted_float_add"
  iFloatSub :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatSub = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
"uninterpreted_float_sub"
  iFloatMul :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatMul = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
"uninterpreted_float_mul"
  iFloatDiv :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatDiv = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
"uninterpreted_float_div"
  iFloatRem :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatRem = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp String
"uninterpreted_float_rem"
  iFloatMin :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatMin = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp String
"uninterpreted_float_min"
  iFloatMax :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatMax = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp String
"uninterpreted_float_max"
  iFloatFMA :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatFMA ExprBuilder t st (Flags FloatUninterpreted)
sym RoundingMode
r SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
y SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
z = do
    let ret_type :: BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
ret_type = Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
forall (tp :: BaseType). Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
Expr t (BaseBVType (FloatInfoToBitWidth fi))
x
    Expr t BaseIntegerType
r_arg <- ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> IO (SymInteger (ExprBuilder t st (Flags FloatUninterpreted)))
forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt ExprBuilder t st (Flags FloatUninterpreted)
sym RoundingMode
r
    ExprBuilder t st (Flags FloatUninterpreted)
-> String
-> Assignment
     (SymExpr (ExprBuilder t st (Flags FloatUninterpreted)))
     ((((EmptyCtx '::> BaseIntegerType)
        ::> BaseBVType (FloatInfoToBitWidth fi))
       ::> BaseBVType (FloatInfoToBitWidth fi))
      ::> BaseBVType (FloatInfoToBitWidth fi))
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatUninterpreted))
        (BaseBVType (FloatInfoToBitWidth fi)))
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st (Flags FloatUninterpreted)
sym
                    String
"uninterpreted_float_fma"
                    (Assignment (Expr t) EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty Assignment (Expr t) EmptyCtx
-> Expr t BaseIntegerType
-> Assignment (Expr t) (EmptyCtx '::> BaseIntegerType)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> Expr t BaseIntegerType
r_arg Assignment (Expr t) (EmptyCtx '::> BaseIntegerType)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Assignment
     (Expr t)
     ((EmptyCtx '::> BaseIntegerType)
      ::> BaseBVType (FloatInfoToBitWidth fi))
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
Expr t (BaseBVType (FloatInfoToBitWidth fi))
x Assignment
  (Expr t)
  ((EmptyCtx '::> BaseIntegerType)
   ::> BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Assignment
     (Expr t)
     (((EmptyCtx '::> BaseIntegerType)
       ::> BaseBVType (FloatInfoToBitWidth fi))
      ::> BaseBVType (FloatInfoToBitWidth fi))
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
Expr t (BaseBVType (FloatInfoToBitWidth fi))
y Assignment
  (Expr t)
  (((EmptyCtx '::> BaseIntegerType)
    ::> BaseBVType (FloatInfoToBitWidth fi))
   ::> BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Assignment
     (Expr t)
     ((((EmptyCtx '::> BaseIntegerType)
        ::> BaseBVType (FloatInfoToBitWidth fi))
       ::> BaseBVType (FloatInfoToBitWidth fi))
      ::> BaseBVType (FloatInfoToBitWidth fi))
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
Expr t (BaseBVType (FloatInfoToBitWidth fi))
z)
                    BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
ret_type
  iFloatEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatEq = ExprBuilder t st (Flags FloatUninterpreted)
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (BaseBVType (FloatInfoToBitWidth fi))
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
ExprBuilder t st (Flags FloatUninterpreted)
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym -> SymExpr sym tp -> SymExpr sym tp -> IO (Pred sym)
forall (tp :: BaseType).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymExpr (ExprBuilder t st (Flags FloatUninterpreted)) tp
-> SymExpr (ExprBuilder t st (Flags FloatUninterpreted)) tp
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
isEq
  iFloatNe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatNe ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
y = ExprBuilder t st (Flags FloatUninterpreted)
-> Pred (ExprBuilder t st (Flags FloatUninterpreted))
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st (Flags FloatUninterpreted)
sym (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExprBuilder t st (Flags FloatUninterpreted)
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (BaseBVType (FloatInfoToBitWidth fi))
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym -> SymExpr sym tp -> SymExpr sym tp -> IO (Pred sym)
forall (tp :: BaseType).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymExpr (ExprBuilder t st (Flags FloatUninterpreted)) tp
-> SymExpr (ExprBuilder t st (Flags FloatUninterpreted)) tp
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
isEq ExprBuilder t st (Flags FloatUninterpreted)
sym SymExpr
  (ExprBuilder t st (Flags FloatUninterpreted))
  (BaseBVType (FloatInfoToBitWidth fi))
SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymExpr
  (ExprBuilder t st (Flags FloatUninterpreted))
  (BaseBVType (FloatInfoToBitWidth fi))
SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
y
  iFloatFpEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatFpEq = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_fp_eq"
  iFloatFpApart :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatFpApart = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_fp_apart"
  iFloatLe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatLe = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_le"
  iFloatLt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatLt = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_lt"
  iFloatGe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatGe ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
y = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_le" ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
Expr t (BaseBVType (FloatInfoToBitWidth fi))
y SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
Expr t (BaseBVType (FloatInfoToBitWidth fi))
x
  iFloatGt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatGt ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
y = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_lt" ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
Expr t (BaseBVType (FloatInfoToBitWidth fi))
y SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
Expr t (BaseBVType (FloatInfoToBitWidth fi))
x
  iFloatIte :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> Pred (ExprBuilder t st (Flags FloatUninterpreted))
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatIte = ExprBuilder t st (Flags FloatUninterpreted)
-> Pred (ExprBuilder t st (Flags FloatUninterpreted))
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (BaseBVType (FloatInfoToBitWidth fi))
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (BaseBVType (FloatInfoToBitWidth fi))
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatUninterpreted))
        (BaseBVType (FloatInfoToBitWidth fi)))
ExprBuilder t st (Flags FloatUninterpreted)
-> Pred (ExprBuilder t st (Flags FloatUninterpreted))
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatUninterpreted))
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatUninterpreted))
        (SymInterpretedFloatType
           (ExprBuilder t st (Flags FloatUninterpreted)) fi))
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
forall (tp :: BaseType).
ExprBuilder t st (Flags FloatUninterpreted)
-> Pred (ExprBuilder t st (Flags FloatUninterpreted))
-> SymExpr (ExprBuilder t st (Flags FloatUninterpreted)) tp
-> SymExpr (ExprBuilder t st (Flags FloatUninterpreted)) tp
-> IO (SymExpr (ExprBuilder t st (Flags FloatUninterpreted)) tp)
baseTypeIte
  iFloatIsNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsNaN = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_nan"
  iFloatIsInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsInf = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_inf"
  iFloatIsZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsZero = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_zero"
  iFloatIsPos :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsPos = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_pos"
  iFloatIsNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsNeg = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_neg"
  iFloatIsSubnorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsSubnorm = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_subnorm"
  iFloatIsNorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsNorm = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t BaseBoolType)
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_norm"
  iFloatCast :: forall (fi :: FloatInfo) (fi' :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi'
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatCast ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi'))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_float_cast" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
 -> RoundingMode
 -> Expr t (BaseBVType (FloatInfoToBitWidth fi'))
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> (FloatInfoRepr fi
    -> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi)))
-> FloatInfoRepr fi
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi'))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
  iFloatRound :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatRound = String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> RoundingMode -> e bt -> IO (e bt)
floatUninterpArithUnOpR String
"uninterpreted_float_round"
  iFloatFromBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> SymBV
     (ExprBuilder t st (Flags FloatUninterpreted))
     (FloatInfoToBitWidth fi)
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
_ FloatInfoRepr fi
_ = SymExpr
  (ExprBuilder t st (Flags FloatUninterpreted))
  ('BaseBVType (FloatInfoToBitWidth fi))
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatUninterpreted))
        (SymInterpretedFloatType
           (ExprBuilder t st (Flags FloatUninterpreted)) fi))
Expr t ('BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t ('BaseBVType (FloatInfoToBitWidth fi)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
  iFloatToBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
     (SymBV
        (ExprBuilder t st (Flags FloatUninterpreted))
        (FloatInfoToBitWidth fi))
iFloatToBinary ExprBuilder t st (Flags FloatUninterpreted)
_ FloatInfoRepr fi
_ = SymExpr
  (ExprBuilder t st (Flags FloatUninterpreted))
  (SymInterpretedFloatType
     (ExprBuilder t st (Flags FloatUninterpreted)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatUninterpreted))
        ('BaseBVType (FloatInfoToBitWidth fi)))
Expr t ('BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t ('BaseBVType (FloatInfoToBitWidth fi)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return
  iBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iBVToFloat ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> RoundingMode
-> Expr t ('BaseBVType w)
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_bv_to_float" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
 -> RoundingMode
 -> Expr t ('BaseBVType w)
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> (FloatInfoRepr fi
    -> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi)))
-> FloatInfoRepr fi
-> RoundingMode
-> Expr t ('BaseBVType w)
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
  iSBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iSBVToFloat ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> RoundingMode
-> Expr t ('BaseBVType w)
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_sbv_to_float" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
 -> RoundingMode
 -> Expr t ('BaseBVType w)
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> (FloatInfoRepr fi
    -> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi)))
-> FloatInfoRepr fi
-> RoundingMode
-> Expr t ('BaseBVType w)
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
  iRealToFloat :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatUninterpreted))
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iRealToFloat ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> RoundingMode
-> Expr t BaseRealType
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_real_to_float" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
 -> RoundingMode
 -> Expr t BaseRealType
 -> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi))))
-> (FloatInfoRepr fi
    -> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi)))
-> FloatInfoRepr fi
-> RoundingMode
-> Expr t BaseRealType
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
  iFloatToBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w)
iFloatToBV ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr ('BaseBVType w)
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t ('BaseBVType w))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_float_to_bv" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr ('BaseBVType w)
 -> RoundingMode
 -> Expr t (BaseBVType (FloatInfoToBitWidth fi))
 -> IO (Expr t ('BaseBVType w)))
-> (NatRepr w -> BaseTypeRepr ('BaseBVType w))
-> NatRepr w
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t ('BaseBVType w))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr w -> BaseTypeRepr ('BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr
  iFloatToSBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w)
iFloatToSBV ExprBuilder t st (Flags FloatUninterpreted)
sym =
    String
-> ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr ('BaseBVType w)
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t ('BaseBVType w))
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_float_to_sbv" ExprBuilder t st (Flags FloatUninterpreted)
sym (BaseTypeRepr ('BaseBVType w)
 -> RoundingMode
 -> Expr t (BaseBVType (FloatInfoToBitWidth fi))
 -> IO (Expr t ('BaseBVType w)))
-> (NatRepr w -> BaseTypeRepr ('BaseBVType w))
-> NatRepr w
-> RoundingMode
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> IO (Expr t ('BaseBVType w))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NatRepr w -> BaseTypeRepr ('BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr
  iFloatToReal :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
     (ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (SymReal (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatToReal ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
x =
    ExprBuilder t st (Flags FloatUninterpreted)
-> String
-> Assignment
     (SymExpr (ExprBuilder t st (Flags FloatUninterpreted)))
     (EmptyCtx ::> BaseBVType (FloatInfoToBitWidth fi))
-> BaseTypeRepr BaseRealType
-> IO (SymReal (ExprBuilder t st (Flags FloatUninterpreted)))
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st (Flags FloatUninterpreted)
sym
                    String
"uninterpreted_float_to_real"
                    (Assignment (Expr t) EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty Assignment (Expr t) EmptyCtx
-> Expr t (BaseBVType (FloatInfoToBitWidth fi))
-> Assignment
     (Expr t) (EmptyCtx ::> BaseBVType (FloatInfoToBitWidth fi))
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
Expr t (BaseBVType (FloatInfoToBitWidth fi))
x)
                    BaseTypeRepr BaseRealType
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

  iFloatSpecialFunction :: forall (fi :: FloatInfo) (args :: Ctx Type).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> SpecialFunction args
-> Assignment
     (SpecialFnArg
        (SymExpr (ExprBuilder t st (Flags FloatUninterpreted)))
        (SymInterpretedFloatType
           (ExprBuilder t st (Flags FloatUninterpreted)) fi))
     args
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatSpecialFunction ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr fi
fi SpecialFunction args
fn Assignment
  (SpecialFnArg
     (SymExpr (ExprBuilder t st (Flags FloatUninterpreted)))
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi))
  args
args =
    ExprBuilder t st (Flags FloatUninterpreted)
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
-> SpecialFunction args
-> Assignment
     (SpecialFnArg (Expr t) (BaseBVType (FloatInfoToBitWidth fi))) args
-> IO (Expr t (BaseBVType (FloatInfoToBitWidth fi)))
forall (e :: BaseType -> Type) t (sf :: Type -> Type) tfs
       (bt :: BaseType) (args :: Ctx Type).
(e ~ Expr t) =>
ExprBuilder t sf tfs
-> BaseTypeRepr bt
-> SpecialFunction args
-> Assignment (SpecialFnArg e bt) args
-> IO (e bt)
floatUninterpSpecialFn ExprBuilder t st (Flags FloatUninterpreted)
sym (ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr fi
fi) SpecialFunction args
fn Assignment
  (SpecialFnArg
     (SymExpr (ExprBuilder t st (Flags FloatUninterpreted)))
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi))
  args
Assignment
  (SpecialFnArg (Expr t) (BaseBVType (FloatInfoToBitWidth fi))) args
args

  iFloatBaseTypeRepr :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
_ = FloatInfoRepr fi
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType
        (ExprBuilder t st (Flags FloatUninterpreted)) fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
floatInfoToBVTypeRepr

floatUninterpArithBinOp
  :: (e ~ Expr t) => String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp String
fn ExprBuilder t st fs
sym e bt
x e bt
y =
  let ret_type :: BaseTypeRepr bt
ret_type = e bt -> BaseTypeRepr bt
forall (tp :: BaseType). e tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
  in  ExprBuilder t st fs
-> String
-> Assignment
     (SymExpr (ExprBuilder t st fs)) ((EmptyCtx ::> bt) ::> bt)
-> BaseTypeRepr bt
-> IO (SymExpr (ExprBuilder t st fs) bt)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (Assignment e EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty Assignment e EmptyCtx -> e bt -> Assignment e (EmptyCtx ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x Assignment e (EmptyCtx ::> bt)
-> e bt -> Assignment e ((EmptyCtx ::> bt) ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
y) BaseTypeRepr bt
ret_type

floatUninterpSpecialFn
  :: (e ~ Expr t)
  => ExprBuilder t sf tfs
  -> BaseTypeRepr bt
  -> SFn.SpecialFunction args
  -> Assignment (SFn.SpecialFnArg e bt) args
  -> IO (e bt)
floatUninterpSpecialFn :: forall (e :: BaseType -> Type) t (sf :: Type -> Type) tfs
       (bt :: BaseType) (args :: Ctx Type).
(e ~ Expr t) =>
ExprBuilder t sf tfs
-> BaseTypeRepr bt
-> SpecialFunction args
-> Assignment (SpecialFnArg e bt) args
-> IO (e bt)
floatUninterpSpecialFn ExprBuilder t sf tfs
sym BaseTypeRepr bt
btr SpecialFunction args
fn Assignment (SpecialFnArg e bt) args
Ctx.Empty =
  do SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol (String
"uninterpreted_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SpecialFunction args -> String
forall a. Show a => a -> String
show SpecialFunction args
fn)
     ExprSymFn t EmptyCtx bt
fn' <- ExprBuilder t sf tfs
-> SolverSymbol
-> Assignment BaseTypeRepr EmptyCtx
-> BaseTypeRepr bt
-> (ExprBuilder t sf tfs
    -> SolverSymbol
    -> Assignment BaseTypeRepr EmptyCtx
    -> BaseTypeRepr bt
    -> IO (SymFn (ExprBuilder t sf tfs) EmptyCtx bt))
-> IO (SymFn (ExprBuilder t sf tfs) EmptyCtx bt)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
    -> SolverSymbol
    -> Assignment BaseTypeRepr args
    -> BaseTypeRepr ret
    -> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn ExprBuilder t sf tfs
sym SolverSymbol
fn_name Assignment BaseTypeRepr EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty BaseTypeRepr bt
btr ExprBuilder t sf tfs
-> SolverSymbol
-> Assignment BaseTypeRepr EmptyCtx
-> BaseTypeRepr bt
-> IO (SymFn (ExprBuilder t sf tfs) EmptyCtx bt)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t sf tfs
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn (ExprBuilder t sf tfs) args ret)
freshTotalUninterpFn
     ExprBuilder t sf tfs
-> SymFn (ExprBuilder t sf tfs) EmptyCtx bt
-> Assignment (SymExpr (ExprBuilder t sf tfs)) EmptyCtx
-> IO (SymExpr (ExprBuilder t sf tfs) bt)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t sf tfs
-> SymFn (ExprBuilder t sf tfs) args ret
-> Assignment (SymExpr (ExprBuilder t sf tfs)) args
-> IO (SymExpr (ExprBuilder t sf tfs) ret)
applySymFn ExprBuilder t sf tfs
sym SymFn (ExprBuilder t sf tfs) EmptyCtx bt
ExprSymFn t EmptyCtx bt
fn' Assignment (SymExpr (ExprBuilder t sf tfs)) EmptyCtx
Assignment (Expr t) EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty

floatUninterpSpecialFn ExprBuilder t sf tfs
sym BaseTypeRepr bt
btr SpecialFunction args
fn (Assignment (SpecialFnArg e bt) ctx
Ctx.Empty Ctx.:> SFn.SpecialFnArg e bt
x) =
  do SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol (String
"uninterpreted_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SpecialFunction args -> String
forall a. Show a => a -> String
show SpecialFunction args
fn)
     ExprSymFn t (EmptyCtx ::> bt) bt
fn' <- ExprBuilder t sf tfs
-> SolverSymbol
-> Assignment BaseTypeRepr (EmptyCtx ::> bt)
-> BaseTypeRepr bt
-> (ExprBuilder t sf tfs
    -> SolverSymbol
    -> Assignment BaseTypeRepr (EmptyCtx ::> bt)
    -> BaseTypeRepr bt
    -> IO (SymFn (ExprBuilder t sf tfs) (EmptyCtx ::> bt) bt))
-> IO (SymFn (ExprBuilder t sf tfs) (EmptyCtx ::> bt) bt)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
    -> SolverSymbol
    -> Assignment BaseTypeRepr args
    -> BaseTypeRepr ret
    -> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn ExprBuilder t sf tfs
sym SolverSymbol
fn_name (Assignment BaseTypeRepr EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty Assignment BaseTypeRepr EmptyCtx
-> BaseTypeRepr bt -> Assignment BaseTypeRepr (EmptyCtx ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> BaseTypeRepr bt
btr) BaseTypeRepr bt
btr ExprBuilder t sf tfs
-> SolverSymbol
-> Assignment BaseTypeRepr (EmptyCtx ::> bt)
-> BaseTypeRepr bt
-> IO (SymFn (ExprBuilder t sf tfs) (EmptyCtx ::> bt) bt)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t sf tfs
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn (ExprBuilder t sf tfs) args ret)
freshTotalUninterpFn
     ExprBuilder t sf tfs
-> SymFn (ExprBuilder t sf tfs) (EmptyCtx ::> bt) bt
-> Assignment (SymExpr (ExprBuilder t sf tfs)) (EmptyCtx ::> bt)
-> IO (SymExpr (ExprBuilder t sf tfs) bt)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t sf tfs
-> SymFn (ExprBuilder t sf tfs) args ret
-> Assignment (SymExpr (ExprBuilder t sf tfs)) args
-> IO (SymExpr (ExprBuilder t sf tfs) ret)
applySymFn ExprBuilder t sf tfs
sym SymFn (ExprBuilder t sf tfs) (EmptyCtx ::> bt) bt
ExprSymFn t (EmptyCtx ::> bt) bt
fn' (Assignment e EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty Assignment e EmptyCtx -> e bt -> Assignment e (EmptyCtx ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x)

floatUninterpSpecialFn ExprBuilder t sf tfs
sym BaseTypeRepr bt
btr SpecialFunction args
fn (Assignment (SpecialFnArg e bt) ctx
Ctx.Empty Ctx.:> SFn.SpecialFnArg e bt
x Ctx.:> SFn.SpecialFnArg e bt
y) =
  do SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol (String
"uninterpreted_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ SpecialFunction args -> String
forall a. Show a => a -> String
show SpecialFunction args
fn)
     ExprSymFn t ((EmptyCtx ::> bt) ::> bt) bt
fn' <- ExprBuilder t sf tfs
-> SolverSymbol
-> Assignment BaseTypeRepr ((EmptyCtx ::> bt) ::> bt)
-> BaseTypeRepr bt
-> (ExprBuilder t sf tfs
    -> SolverSymbol
    -> Assignment BaseTypeRepr ((EmptyCtx ::> bt) ::> bt)
    -> BaseTypeRepr bt
    -> IO (SymFn (ExprBuilder t sf tfs) ((EmptyCtx ::> bt) ::> bt) bt))
-> IO (SymFn (ExprBuilder t sf tfs) ((EmptyCtx ::> bt) ::> bt) bt)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
    -> SolverSymbol
    -> Assignment BaseTypeRepr args
    -> BaseTypeRepr ret
    -> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn ExprBuilder t sf tfs
sym SolverSymbol
fn_name (Assignment BaseTypeRepr EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty Assignment BaseTypeRepr EmptyCtx
-> BaseTypeRepr bt -> Assignment BaseTypeRepr (EmptyCtx ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> BaseTypeRepr bt
btr Assignment BaseTypeRepr (EmptyCtx ::> bt)
-> BaseTypeRepr bt
-> Assignment BaseTypeRepr ((EmptyCtx ::> bt) ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> BaseTypeRepr bt
btr) BaseTypeRepr bt
btr ExprBuilder t sf tfs
-> SolverSymbol
-> Assignment BaseTypeRepr ((EmptyCtx ::> bt) ::> bt)
-> BaseTypeRepr bt
-> IO (SymFn (ExprBuilder t sf tfs) ((EmptyCtx ::> bt) ::> bt) bt)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t sf tfs
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn (ExprBuilder t sf tfs) args ret)
freshTotalUninterpFn
     ExprBuilder t sf tfs
-> SymFn (ExprBuilder t sf tfs) ((EmptyCtx ::> bt) ::> bt) bt
-> Assignment
     (SymExpr (ExprBuilder t sf tfs)) ((EmptyCtx ::> bt) ::> bt)
-> IO (SymExpr (ExprBuilder t sf tfs) bt)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t sf tfs
-> SymFn (ExprBuilder t sf tfs) args ret
-> Assignment (SymExpr (ExprBuilder t sf tfs)) args
-> IO (SymExpr (ExprBuilder t sf tfs) ret)
applySymFn ExprBuilder t sf tfs
sym SymFn (ExprBuilder t sf tfs) ((EmptyCtx ::> bt) ::> bt) bt
ExprSymFn t ((EmptyCtx ::> bt) ::> bt) bt
fn' (Assignment e EmptyCtx
forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty Assignment e EmptyCtx -> e bt -> Assignment e (EmptyCtx ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x Assignment e (EmptyCtx ::> bt)
-> e bt -> Assignment e ((EmptyCtx ::> bt) ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
y)

floatUninterpSpecialFn ExprBuilder t sf tfs
_sym BaseTypeRepr bt
_btr SpecialFunction args
fn Assignment (SpecialFnArg e bt) args
_args =
  String -> IO (e bt)
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> IO (e bt)) -> String -> IO (e bt)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Special function with unexpected arity", SpecialFunction args -> String
forall a. Show a => a -> String
show SpecialFunction args
fn]

floatUninterpArithBinOpR
  :: (e ~ Expr t)
  => String
  -> ExprBuilder t st fs
  -> RoundingMode
  -> e bt
  -> e bt
  -> IO (e bt)
floatUninterpArithBinOpR :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
fn ExprBuilder t st fs
sym RoundingMode
r e bt
x e bt
y = do
  let ret_type :: BaseTypeRepr bt
ret_type = e bt -> BaseTypeRepr bt
forall (tp :: BaseType). e tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
  e BaseIntegerType
r_arg <- ExprBuilder t st fs
-> RoundingMode -> IO (SymInteger (ExprBuilder t st fs))
forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt ExprBuilder t st fs
sym RoundingMode
r
  ExprBuilder t st fs
-> String
-> Assignment
     (SymExpr (ExprBuilder t st fs))
     (((EmptyCtx '::> BaseIntegerType) ::> bt) ::> bt)
-> BaseTypeRepr bt
-> IO (SymExpr (ExprBuilder t st fs) bt)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (Assignment e EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty Assignment e EmptyCtx
-> e BaseIntegerType
-> Assignment e (EmptyCtx '::> BaseIntegerType)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e BaseIntegerType
r_arg Assignment e (EmptyCtx '::> BaseIntegerType)
-> e bt -> Assignment e ((EmptyCtx '::> BaseIntegerType) ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x Assignment e ((EmptyCtx '::> BaseIntegerType) ::> bt)
-> e bt
-> Assignment e (((EmptyCtx '::> BaseIntegerType) ::> bt) ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
y) BaseTypeRepr bt
ret_type

floatUninterpArithUnOp
  :: (e ~ Expr t) => String -> ExprBuilder t st fs -> e bt -> IO (e bt)
floatUninterpArithUnOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e bt)
floatUninterpArithUnOp String
fn ExprBuilder t st fs
sym e bt
x =
  let ret_type :: BaseTypeRepr bt
ret_type = e bt -> BaseTypeRepr bt
forall (tp :: BaseType). e tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
  in  ExprBuilder t st fs
-> String
-> Assignment (SymExpr (ExprBuilder t st fs)) (EmptyCtx ::> bt)
-> BaseTypeRepr bt
-> IO (SymExpr (ExprBuilder t st fs) bt)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (Assignment e EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty Assignment e EmptyCtx -> e bt -> Assignment e (EmptyCtx ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x) BaseTypeRepr bt
ret_type
floatUninterpArithUnOpR
  :: (e ~ Expr t)
  => String
  -> ExprBuilder t st fs
  -> RoundingMode
  -> e bt
  -> IO (e bt)
floatUninterpArithUnOpR :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> RoundingMode -> e bt -> IO (e bt)
floatUninterpArithUnOpR String
fn ExprBuilder t st fs
sym RoundingMode
r e bt
x = do
  let ret_type :: BaseTypeRepr bt
ret_type = e bt -> BaseTypeRepr bt
forall (tp :: BaseType). e tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
  e BaseIntegerType
r_arg <- ExprBuilder t st fs
-> RoundingMode -> IO (SymInteger (ExprBuilder t st fs))
forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt ExprBuilder t st fs
sym RoundingMode
r
  ExprBuilder t st fs
-> String
-> Assignment
     (SymExpr (ExprBuilder t st fs))
     ((EmptyCtx '::> BaseIntegerType) ::> bt)
-> BaseTypeRepr bt
-> IO (SymExpr (ExprBuilder t st fs) bt)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (Assignment e EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty Assignment e EmptyCtx
-> e BaseIntegerType
-> Assignment e (EmptyCtx '::> BaseIntegerType)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e BaseIntegerType
r_arg Assignment e (EmptyCtx '::> BaseIntegerType)
-> e bt -> Assignment e ((EmptyCtx '::> BaseIntegerType) ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x) BaseTypeRepr bt
ret_type

floatUninterpArithCt
  :: (e ~ Expr t)
  => String
  -> ExprBuilder t st fs
  -> BaseTypeRepr bt
  -> IO (e bt)
floatUninterpArithCt :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
fn ExprBuilder t st fs
sym BaseTypeRepr bt
ret_type =
  ExprBuilder t st fs
-> String
-> Assignment (SymExpr (ExprBuilder t st fs)) EmptyCtx
-> BaseTypeRepr bt
-> IO (SymExpr (ExprBuilder t st fs) bt)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn Assignment (SymExpr (ExprBuilder t st fs)) EmptyCtx
Assignment (Expr t) EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty BaseTypeRepr bt
ret_type

floatUninterpLogicBinOp
  :: (e ~ Expr t)
  => String
  -> ExprBuilder t st fs
  -> e bt
  -> e bt
  -> IO (e BaseBoolType)
floatUninterpLogicBinOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e BaseBoolType)
floatUninterpLogicBinOp String
fn ExprBuilder t st fs
sym e bt
x e bt
y =
  ExprBuilder t st fs
-> String
-> Assignment
     (SymExpr (ExprBuilder t st fs)) ((EmptyCtx ::> bt) ::> bt)
-> BaseTypeRepr BaseBoolType
-> IO (SymExpr (ExprBuilder t st fs) BaseBoolType)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (Assignment e EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty Assignment e EmptyCtx -> e bt -> Assignment e (EmptyCtx ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x Assignment e (EmptyCtx ::> bt)
-> e bt -> Assignment e ((EmptyCtx ::> bt) ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
y) BaseTypeRepr BaseBoolType
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

floatUninterpLogicUnOp
  :: (e ~ Expr t)
  => String
  -> ExprBuilder t st fs
  -> e bt
  -> IO (e BaseBoolType)
floatUninterpLogicUnOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e BaseBoolType)
floatUninterpLogicUnOp String
fn ExprBuilder t st fs
sym e bt
x =
  ExprBuilder t st fs
-> String
-> Assignment (SymExpr (ExprBuilder t st fs)) (EmptyCtx ::> bt)
-> BaseTypeRepr BaseBoolType
-> IO (SymExpr (ExprBuilder t st fs) BaseBoolType)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (Assignment e EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty Assignment e EmptyCtx -> e bt -> Assignment e (EmptyCtx ::> bt)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x) BaseTypeRepr BaseBoolType
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr

floatUninterpCastOp
  :: (e ~ Expr t)
  => String
  -> ExprBuilder t st fs
  -> BaseTypeRepr bt
  -> RoundingMode
  -> e bt'
  -> IO (e bt)
floatUninterpCastOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
       (bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
fn ExprBuilder t st fs
sym BaseTypeRepr bt
ret_type RoundingMode
r e bt'
x = do
  e BaseIntegerType
r_arg <- ExprBuilder t st fs
-> RoundingMode -> IO (SymInteger (ExprBuilder t st fs))
forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt ExprBuilder t st fs
sym RoundingMode
r
  ExprBuilder t st fs
-> String
-> Assignment
     (SymExpr (ExprBuilder t st fs))
     ((EmptyCtx '::> BaseIntegerType) ::> bt')
-> BaseTypeRepr bt
-> IO (SymExpr (ExprBuilder t st fs) bt)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (Assignment e EmptyCtx
forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty Assignment e EmptyCtx
-> e BaseIntegerType
-> Assignment e (EmptyCtx '::> BaseIntegerType)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e BaseIntegerType
r_arg Assignment e (EmptyCtx '::> BaseIntegerType)
-> e bt' -> Assignment e ((EmptyCtx '::> BaseIntegerType) ::> bt')
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt'
x) BaseTypeRepr bt
ret_type

roundingModeToSymInt
  :: (sym ~ ExprBuilder t st fs) => sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt :: forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt sym
sym = sym -> Integer -> IO (SymExpr sym BaseIntegerType)
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym (Integer -> IO (Expr t BaseIntegerType))
-> (RoundingMode -> Integer)
-> RoundingMode
-> IO (Expr t BaseIntegerType)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer)
-> (RoundingMode -> Int) -> RoundingMode -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoundingMode -> Int
forall a. Enum a => a -> Int
fromEnum


type instance SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi =
  BaseFloatType (FloatInfoToPrecision fi)

instance IsInterpretedFloatExprBuilder (ExprBuilder t st (Flags FloatIEEE)) where
  iFloatPZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatPZero ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatPZero ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iFloatNZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatNZero ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatNZero ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iFloatNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatNaN ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatNaN ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iFloatPInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatPInf ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatPInf ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iFloatNInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatNInf ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatNInf ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iFloatLitRational :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> Rational
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatLitRational ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> Rational
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> Rational -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> Rational
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatLitRational ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> Rational
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> Rational
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iFloatLitSingle :: ExprBuilder t st (Flags FloatIEEE)
-> Float
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatIEEE)) SingleFloat)
iFloatLitSingle ExprBuilder t st (Flags FloatIEEE)
sym Float
x =
    ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision 8 24)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (8 + 24)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision 8 24))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision eb sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatPrecisionRepr (FloatingPointPrecision 8 24)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
      (Expr t ('BaseBVType (8 + 24))
 -> IO (Expr t ('BaseFloatType (FloatingPointPrecision 8 24))))
-> IO (Expr t ('BaseBVType (8 + 24)))
-> IO (Expr t ('BaseFloatType (FloatingPointPrecision 8 24)))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ExprBuilder t st (Flags FloatIEEE)
-> NatRepr 32
-> BV 32
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) 32)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> BV w
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatIEEE)
sym NatRepr 32
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (BV 32 -> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) 32))
-> BV 32 -> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) 32)
forall a b. (a -> b) -> a -> b
$ Word32 -> BV 32
BV.word32 (Word32 -> BV 32) -> Word32 -> BV 32
forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 Float
x)
  iFloatLitDouble :: ExprBuilder t st (Flags FloatIEEE)
-> Double
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatIEEE)) DoubleFloat)
iFloatLitDouble ExprBuilder t st (Flags FloatIEEE)
sym Double
x =
    ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision 11 53)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (11 + 53)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision 11 53))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision eb sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatPrecisionRepr (FloatingPointPrecision 11 53)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
      (Expr t ('BaseBVType (11 + 53))
 -> IO (Expr t ('BaseFloatType (FloatingPointPrecision 11 53))))
-> IO (Expr t ('BaseBVType (11 + 53)))
-> IO (Expr t ('BaseFloatType (FloatingPointPrecision 11 53)))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ExprBuilder t st (Flags FloatIEEE)
-> NatRepr 64
-> BV 64
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) 64)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> BV w
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatIEEE)
sym NatRepr 64
forall (n :: Natural). KnownNat n => NatRepr n
knownNat (BV 64 -> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) 64))
-> BV 64 -> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) 64)
forall a b. (a -> b) -> a -> b
$ Word64 -> BV 64
BV.word64 (Word64 -> BV 64) -> Word64 -> BV 64
forall a b. (a -> b) -> a -> b
$ Double -> Word64
castDoubleToWord64 Double
x)
  iFloatLitLongDouble :: ExprBuilder t st (Flags FloatIEEE)
-> X86_80Val
-> IO
     (SymInterpretedFloat
        (ExprBuilder t st (Flags FloatIEEE)) X86_80Float)
iFloatLitLongDouble ExprBuilder t st (Flags FloatIEEE)
sym (X86_80Val Word16
e Word64
s) = do
    Expr t (BaseBVType 16)
el <- ExprBuilder t st (Flags FloatIEEE)
-> NatRepr 16
-> BV 16
-> IO
     (SymExpr (ExprBuilder t st (Flags FloatIEEE)) (BaseBVType 16))
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> BV w
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatIEEE)
sym (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @16) (BV 16
 -> IO
      (SymExpr (ExprBuilder t st (Flags FloatIEEE)) (BaseBVType 16)))
-> BV 16
-> IO
     (SymExpr (ExprBuilder t st (Flags FloatIEEE)) (BaseBVType 16))
forall a b. (a -> b) -> a -> b
$ Word16 -> BV 16
BV.word16 Word16
e
    Expr t ('BaseBVType 64)
sl <- ExprBuilder t st (Flags FloatIEEE)
-> NatRepr 64
-> BV 64
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) 64)
forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> BV w
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatIEEE)
sym (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @64) (BV 64 -> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) 64))
-> BV 64 -> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) 64)
forall a b. (a -> b) -> a -> b
$ Word64 -> BV 64
BV.word64 Word64
s
    Expr t (BaseBVType (16 + 64))
fl <- ExprBuilder t st (Flags FloatIEEE)
-> SymExpr (ExprBuilder t st (Flags FloatIEEE)) (BaseBVType 16)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) 64
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (16 + 64))
forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st (Flags FloatIEEE)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) u
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) v
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (u + v))
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st (Flags FloatIEEE)
sym SymExpr (ExprBuilder t st (Flags FloatIEEE)) (BaseBVType 16)
Expr t (BaseBVType 16)
el SymBV (ExprBuilder t st (Flags FloatIEEE)) 64
Expr t ('BaseBVType 64)
sl
    ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision 15 65)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (15 + 65)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision 15 65))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision eb sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatPrecisionRepr (FloatingPointPrecision 15 65)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (15 + 65)
Expr t (BaseBVType (16 + 64))
fl
    -- n.b. This may not be valid semantically for operations
    -- performed on 80-bit values, but it allows them to be present in
    -- formulas.
  iFloatNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatNeg = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatNeg
  iFloatAbs :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatAbs = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatAbs
  iFloatSqrt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatSqrt = ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> RoundingMode -> SymFloat sym fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatSqrt
  iFloatAdd :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatAdd = ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatAdd
  iFloatSub :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatSub = ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatSub
  iFloatMul :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatMul = ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatMul
  iFloatDiv :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatDiv = ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatDiv
  iFloatRem :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatRem = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatRem
  iFloatMin :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatMin = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatMin
  iFloatMax :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatMax = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatMax
  iFloatFMA :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatFMA = ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatFMA
  iFloatEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatEq = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatEq
  iFloatNe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatNe = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatNe
  iFloatFpEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatFpEq = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatFpEq
  iFloatFpApart :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatFpApart = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatFpApart
  iFloatLe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatLe = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatLe
  iFloatLt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatLt = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatLt
  iFloatGe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatGe = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatGe
  iFloatGt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatGt = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatGt
  iFloatIte :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> Pred (ExprBuilder t st (Flags FloatIEEE))
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatIte = ExprBuilder t st (Flags FloatIEEE)
-> Pred (ExprBuilder t st (Flags FloatIEEE))
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> Pred (ExprBuilder t st (Flags FloatIEEE))
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> Pred (ExprBuilder t st (Flags FloatIEEE))
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatIte
  iFloatIsNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsNaN = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatIsNaN
  iFloatIsInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsInf = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatIsInf
  iFloatIsZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsZero = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatIsZero
  iFloatIsPos :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsPos = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatIsPos
  iFloatIsNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsNeg = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatIsNeg
  iFloatIsSubnorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsSubnorm = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatIsSubnorm
  iFloatIsNorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsNorm = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
floatIsNorm
  iFloatCast :: forall (fi :: FloatInfo) (fi' :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi'
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatCast ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi')
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall sym (fpp :: FloatPrecision) (fpp' :: FloatPrecision).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymFloat sym fpp'
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision) (fpp' :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp'
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatCast ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> RoundingMode
 -> Expr t ('BaseFloatType (FloatInfoToPrecision fi'))
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> RoundingMode
-> Expr t ('BaseFloatType (FloatInfoToPrecision fi'))
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iFloatRound :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatRound = ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO
     (SymExpr
        (ExprBuilder t st (Flags FloatIEEE))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> RoundingMode -> SymFloat sym fpp -> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatRound
  iFloatFromBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> SymBV
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatInfoRepr fi
fi SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x = case FloatInfoRepr fi
fi of
    FloatInfoRepr fi
HalfFloatRepr         -> ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision 5 11)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (5 + 11)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision 5 11))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision eb sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatPrecisionRepr (FloatingPointPrecision 5 11)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (5 + 11)
SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
    FloatInfoRepr fi
SingleFloatRepr       -> ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision 8 24)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (8 + 24)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision 8 24))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision eb sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatPrecisionRepr (FloatingPointPrecision 8 24)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (8 + 24)
SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
    FloatInfoRepr fi
DoubleFloatRepr       -> ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision 11 53)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (11 + 53)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision 11 53))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision eb sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatPrecisionRepr (FloatingPointPrecision 11 53)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (11 + 53)
SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
    FloatInfoRepr fi
QuadFloatRepr         -> ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision 15 113)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (15 + 113)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision 15 113))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE))
        (FloatingPointPrecision eb sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatPrecisionRepr (FloatingPointPrecision 15 113)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (15 + 113)
SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
    FloatInfoRepr fi
X86_80FloatRepr       -> String
-> IO (Expr t ('BaseFloatType (FloatingPointPrecision 15 65)))
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"x86_80 is not an IEEE-754 format."
    FloatInfoRepr fi
DoubleDoubleFloatRepr -> String
-> IO
     (Expr t (BaseFloatType (FloatInfoToPrecision 'DoubleDoubleFloat)))
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"double-double is not an IEEE-754 format."
  iFloatToBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO
     (SymBV
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi))
iFloatToBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatInfoRepr fi
fi SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x = case FloatInfoRepr fi
fi of
    FloatInfoRepr fi
HalfFloatRepr         -> ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision 5 11)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (5 + 11))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision eb sb)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st (Flags FloatIEEE)
sym SymFloat
  (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision 5 11)
SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
    FloatInfoRepr fi
SingleFloatRepr       -> ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision 8 24)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (8 + 24))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision eb sb)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st (Flags FloatIEEE)
sym SymFloat
  (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision 8 24)
SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
    FloatInfoRepr fi
DoubleFloatRepr       -> ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision 11 53)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (11 + 53))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision eb sb)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st (Flags FloatIEEE)
sym SymFloat
  (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision 11 53)
SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
    FloatInfoRepr fi
QuadFloatRepr         -> ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE))
     (FloatingPointPrecision 15 113)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (15 + 113))
forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatingPointPrecision eb sb)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) (eb + sb))
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st (Flags FloatIEEE)
sym SymFloat
  (ExprBuilder t st (Flags FloatIEEE))
  (FloatingPointPrecision 15 113)
SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
    FloatInfoRepr fi
X86_80FloatRepr       -> String -> IO (Expr t ('BaseBVType 80))
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"x86_80 is not an IEEE-754 format."
    FloatInfoRepr fi
DoubleDoubleFloatRepr -> String -> IO (Expr t (BaseBVType 128))
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"double-double is not an IEEE-754 format."
  iBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) w
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iBVToFloat ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> RoundingMode
-> SymExpr (ExprBuilder t st (Flags FloatIEEE)) ('BaseBVType w)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) w
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV sym w
-> IO (SymFloat sym fpp)
bvToFloat ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> RoundingMode
 -> Expr t ('BaseBVType w)
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> RoundingMode
-> Expr t ('BaseBVType w)
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iSBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) w
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iSBVToFloat ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> RoundingMode
-> SymExpr (ExprBuilder t st (Flags FloatIEEE)) ('BaseBVType w)
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) w
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV sym w
-> IO (SymFloat sym fpp)
sbvToFloat ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> RoundingMode
 -> Expr t ('BaseBVType w)
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> RoundingMode
-> Expr t ('BaseBVType w)
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iRealToFloat :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatIEEE))
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iRealToFloat ExprBuilder t st (Flags FloatIEEE)
sym = ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatIEEE))
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymReal sym
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatIEEE))
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
realToFloat ExprBuilder t st (Flags FloatIEEE)
sym (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> RoundingMode
 -> Expr t BaseRealType
 -> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi))))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> RoundingMode
-> Expr t BaseRealType
-> IO (Expr t ('BaseFloatType (FloatInfoToPrecision fi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
  iFloatToBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
iFloatToBV = ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> NatRepr w
-> RoundingMode
-> SymFloat sym fpp
-> IO (SymBV sym w)
floatToBV
  iFloatToSBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
iFloatToSBV = ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> NatRepr w
-> RoundingMode
-> SymFloat sym fpp
-> IO (SymBV sym w)
floatToSBV
  iFloatToReal :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymReal (ExprBuilder t st (Flags FloatIEEE)))
iFloatToReal = ExprBuilder t st (Flags FloatIEEE)
-> SymFloat
     (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi)
-> IO (SymReal (ExprBuilder t st (Flags FloatIEEE)))
ExprBuilder t st (Flags FloatIEEE)
-> SymExpr
     (ExprBuilder t st (Flags FloatIEEE))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
-> IO (SymReal (ExprBuilder t st (Flags FloatIEEE)))
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymReal sym)
forall (fpp :: FloatPrecision).
ExprBuilder t st (Flags FloatIEEE)
-> SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp
-> IO (SymReal (ExprBuilder t st (Flags FloatIEEE)))
floatToReal
  iFloatSpecialFunction :: forall (fi :: FloatInfo) (args :: Ctx Type).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> SpecialFunction args
-> Assignment
     (SpecialFnArg
        (SymExpr (ExprBuilder t st (Flags FloatIEEE)))
        (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
     args
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatSpecialFunction ExprBuilder t st (Flags FloatIEEE)
sym FloatInfoRepr fi
fi SpecialFunction args
fn Assignment
  (SpecialFnArg
     (SymExpr (ExprBuilder t st (Flags FloatIEEE)))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
  args
args =
    ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr (FloatInfoToPrecision fi)
-> SpecialFunction args
-> Assignment
     (SpecialFnArg
        (SymExpr (ExprBuilder t st (Flags FloatIEEE)))
        (BaseFloatType (FloatInfoToPrecision fi)))
     args
-> IO
     (SymFloat
        (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToPrecision fi))
forall sym (fpp :: FloatPrecision) (args :: Ctx Type).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> SpecialFunction args
-> Assignment (SpecialFnArg (SymExpr sym) (BaseFloatType fpp)) args
-> IO (SymFloat sym fpp)
forall (fpp :: FloatPrecision) (args :: Ctx Type).
ExprBuilder t st (Flags FloatIEEE)
-> FloatPrecisionRepr fpp
-> SpecialFunction args
-> Assignment
     (SpecialFnArg
        (SymExpr (ExprBuilder t st (Flags FloatIEEE))) (BaseFloatType fpp))
     args
-> IO (SymFloat (ExprBuilder t st (Flags FloatIEEE)) fpp)
floatSpecialFunction ExprBuilder t st (Flags FloatIEEE)
sym (FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr FloatInfoRepr fi
fi) SpecialFunction args
fn Assignment
  (SpecialFnArg
     (SymExpr (ExprBuilder t st (Flags FloatIEEE)))
     (BaseFloatType (FloatInfoToPrecision fi)))
  args
Assignment
  (SpecialFnArg
     (SymExpr (ExprBuilder t st (Flags FloatIEEE)))
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
  args
args
  iFloatBaseTypeRepr :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> BaseTypeRepr
     (SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatIEEE)
_ = FloatPrecisionRepr (FloatInfoToPrecision fi)
-> BaseTypeRepr ('BaseFloatType (FloatInfoToPrecision fi))
forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr (FloatPrecisionRepr (FloatInfoToPrecision fi)
 -> BaseTypeRepr ('BaseFloatType (FloatInfoToPrecision fi)))
-> (FloatInfoRepr fi
    -> FloatPrecisionRepr (FloatInfoToPrecision fi))
-> FloatInfoRepr fi
-> BaseTypeRepr ('BaseFloatType (FloatInfoToPrecision fi))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr


instance IsSymExprBuilder (ExprBuilder t st fs) where
  freshConstant :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp = do
    ExprBoundVar t tp
v <- ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp VarKind
UninterpVarKind Maybe (AbstractValue tp)
forall a. Maybe a
Nothing
    ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (ExprBoundVar t tp -> SymbolBinding t
forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t tp
v)
    Expr t tp -> IO (Expr t tp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t tp -> IO (Expr t tp)) -> Expr t tp -> IO (Expr t tp)
forall a b. (a -> b) -> a -> b
$! ExprBoundVar t tp -> Expr t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t tp
v

  freshBoundedBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SolverSymbol
-> NatRepr w
-> Maybe Natural
-> Maybe Natural
-> IO (SymBV (ExprBuilder t st fs) w)
freshBoundedBV ExprBuilder t st fs
sym SolverSymbol
nm NatRepr w
w Maybe Natural
Nothing Maybe Natural
Nothing = ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr ('BaseBVType w)
-> IO (SymExpr (ExprBuilder t st fs) ('BaseBVType w))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
nm (NatRepr w -> BaseTypeRepr ('BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w)
  freshBoundedBV ExprBuilder t st fs
sym SolverSymbol
nm NatRepr w
w Maybe Natural
mlo Maybe Natural
mhi =
    do Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
boundsOK (InvalidRange -> IO ()
forall e a. Exception e => e -> IO a
Ex.throwIO (BaseTypeRepr ('BaseBVType w)
-> Maybe (ConcreteValue ('BaseBVType w))
-> Maybe (ConcreteValue ('BaseBVType w))
-> InvalidRange
forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange (NatRepr w -> BaseTypeRepr ('BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) ((Natural -> Integer) -> Maybe Natural -> Maybe Integer
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Maybe Natural
mlo) ((Natural -> Integer) -> Maybe Natural -> Maybe Integer
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Maybe Natural
mhi)))
       ExprBoundVar t ('BaseBVType w)
v <- ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr ('BaseBVType w)
-> VarKind
-> Maybe (AbstractValue ('BaseBVType w))
-> IO (ExprBoundVar t ('BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm (NatRepr w -> BaseTypeRepr ('BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) VarKind
UninterpVarKind (BVDomain w -> Maybe (BVDomain w)
forall a. a -> Maybe a
Just (BVDomain w -> Maybe (BVDomain w))
-> BVDomain w -> Maybe (BVDomain w)
forall a b. (a -> b) -> a -> b
$! (NatRepr w -> Integer -> Integer -> BVDomain w
forall (w :: Natural).
NatRepr w -> Integer -> Integer -> BVDomain w
BVD.range NatRepr w
w Integer
lo Integer
hi))
       ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (ExprBoundVar t ('BaseBVType w) -> SymbolBinding t
forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t ('BaseBVType w)
v)
       Expr t ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t ('BaseBVType w) -> IO (Expr t ('BaseBVType w)))
-> Expr t ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$! ExprBoundVar t ('BaseBVType w) -> Expr t ('BaseBVType w)
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t ('BaseBVType w)
v
   where
   boundsOK :: Bool
boundsOK = Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
hi Bool -> Bool -> Bool
&& NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lo Bool -> Bool -> Bool
&& Integer
hi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
   lo :: Integer
lo = Integer -> (Natural -> Integer) -> Maybe Natural -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w) Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Maybe Natural
mlo
   hi :: Integer
hi = Integer -> (Natural -> Integer) -> Maybe Natural -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NatRepr w -> Integer
forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w) Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Maybe Natural
mhi

  freshBoundedSBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SolverSymbol
-> NatRepr w
-> Maybe Integer
-> Maybe Integer
-> IO (SymBV (ExprBuilder t st fs) w)
freshBoundedSBV ExprBuilder t st fs
sym SolverSymbol
nm NatRepr w
w Maybe Integer
Nothing Maybe Integer
Nothing = ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr ('BaseBVType w)
-> IO (SymExpr (ExprBuilder t st fs) ('BaseBVType w))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
nm (NatRepr w -> BaseTypeRepr ('BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w)
  freshBoundedSBV ExprBuilder t st fs
sym SolverSymbol
nm NatRepr w
w Maybe Integer
mlo Maybe Integer
mhi =
    do Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
boundsOK (InvalidRange -> IO ()
forall e a. Exception e => e -> IO a
Ex.throwIO (BaseTypeRepr ('BaseBVType w)
-> Maybe (ConcreteValue ('BaseBVType w))
-> Maybe (ConcreteValue ('BaseBVType w))
-> InvalidRange
forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange (NatRepr w -> BaseTypeRepr ('BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) Maybe Integer
Maybe (ConcreteValue ('BaseBVType w))
mlo Maybe Integer
Maybe (ConcreteValue ('BaseBVType w))
mhi))
       ExprBoundVar t ('BaseBVType w)
v <- ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr ('BaseBVType w)
-> VarKind
-> Maybe (AbstractValue ('BaseBVType w))
-> IO (ExprBoundVar t ('BaseBVType w))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm (NatRepr w -> BaseTypeRepr ('BaseBVType w)
forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) VarKind
UninterpVarKind (BVDomain w -> Maybe (BVDomain w)
forall a. a -> Maybe a
Just (BVDomain w -> Maybe (BVDomain w))
-> BVDomain w -> Maybe (BVDomain w)
forall a b. (a -> b) -> a -> b
$! (NatRepr w -> Integer -> Integer -> BVDomain w
forall (w :: Natural).
NatRepr w -> Integer -> Integer -> BVDomain w
BVD.range NatRepr w
w Integer
lo Integer
hi))
       ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (ExprBoundVar t ('BaseBVType w) -> SymbolBinding t
forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t ('BaseBVType w)
v)
       Expr t ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t ('BaseBVType w) -> IO (Expr t ('BaseBVType w)))
-> Expr t ('BaseBVType w) -> IO (Expr t ('BaseBVType w))
forall a b. (a -> b) -> a -> b
$! ExprBoundVar t ('BaseBVType w) -> Expr t ('BaseBVType w)
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t ('BaseBVType w)
v
   where
   boundsOK :: Bool
boundsOK = Integer
lo Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
hi Bool -> Bool -> Bool
&& NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lo Bool -> Bool -> Bool
&& Integer
hi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
   lo :: Integer
lo = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe (NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w) Maybe Integer
mlo
   hi :: Integer
hi = Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe (NatRepr w -> Integer
forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w) Maybe Integer
mhi

  freshBoundedInt :: ExprBuilder t st fs
-> SolverSymbol
-> Maybe Integer
-> Maybe Integer
-> IO (SymInteger (ExprBuilder t st fs))
freshBoundedInt ExprBuilder t st fs
sym SolverSymbol
nm Maybe Integer
mlo Maybe Integer
mhi =
    do Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Maybe Integer -> Maybe Integer -> Bool
forall {a}. Ord a => Maybe a -> Maybe a -> Bool
boundsOK Maybe Integer
mlo Maybe Integer
mhi) (InvalidRange -> IO ()
forall e a. Exception e => e -> IO a
Ex.throwIO (BaseTypeRepr BaseIntegerType
-> Maybe (ConcreteValue BaseIntegerType)
-> Maybe (ConcreteValue BaseIntegerType)
-> InvalidRange
forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange BaseTypeRepr BaseIntegerType
BaseIntegerRepr Maybe Integer
Maybe (ConcreteValue BaseIntegerType)
mlo Maybe Integer
Maybe (ConcreteValue BaseIntegerType)
mhi))
       ExprBoundVar t BaseIntegerType
v <- ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr BaseIntegerType
-> VarKind
-> Maybe (AbstractValue BaseIntegerType)
-> IO (ExprBoundVar t BaseIntegerType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr BaseIntegerType
BaseIntegerRepr VarKind
UninterpVarKind (Maybe Integer -> Maybe Integer -> Maybe (ValueRange Integer)
forall {tp}. Maybe tp -> Maybe tp -> Maybe (ValueRange tp)
absVal Maybe Integer
mlo Maybe Integer
mhi)
       ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (ExprBoundVar t BaseIntegerType -> SymbolBinding t
forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t BaseIntegerType
v)
       Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t BaseIntegerType -> IO (Expr t BaseIntegerType))
-> Expr t BaseIntegerType -> IO (Expr t BaseIntegerType)
forall a b. (a -> b) -> a -> b
$! ExprBoundVar t BaseIntegerType -> Expr t BaseIntegerType
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t BaseIntegerType
v
   where
   boundsOK :: Maybe a -> Maybe a -> Bool
boundsOK (Just a
lo) (Just a
hi) = a
lo a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi
   boundsOK Maybe a
_ Maybe a
_ = Bool
True

   absVal :: Maybe tp -> Maybe tp -> Maybe (ValueRange tp)
absVal Maybe tp
Nothing Maybe tp
Nothing = Maybe (ValueRange tp)
forall a. Maybe a
Nothing
   absVal (Just tp
lo) Maybe tp
Nothing = ValueRange tp -> Maybe (ValueRange tp)
forall a. a -> Maybe a
Just (ValueRange tp -> Maybe (ValueRange tp))
-> ValueRange tp -> Maybe (ValueRange tp)
forall a b. (a -> b) -> a -> b
$! ValueBound tp -> ValueBound tp -> ValueRange tp
forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (tp -> ValueBound tp
forall tp. tp -> ValueBound tp
Inclusive tp
lo) ValueBound tp
forall tp. ValueBound tp
Unbounded
   absVal Maybe tp
Nothing (Just tp
hi) = ValueRange tp -> Maybe (ValueRange tp)
forall a. a -> Maybe a
Just (ValueRange tp -> Maybe (ValueRange tp))
-> ValueRange tp -> Maybe (ValueRange tp)
forall a b. (a -> b) -> a -> b
$! ValueBound tp -> ValueBound tp -> ValueRange tp
forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange ValueBound tp
forall tp. ValueBound tp
Unbounded (tp -> ValueBound tp
forall tp. tp -> ValueBound tp
Inclusive tp
hi)
   absVal (Just tp
lo) (Just tp
hi) = ValueRange tp -> Maybe (ValueRange tp)
forall a. a -> Maybe a
Just (ValueRange tp -> Maybe (ValueRange tp))
-> ValueRange tp -> Maybe (ValueRange tp)
forall a b. (a -> b) -> a -> b
$! ValueBound tp -> ValueBound tp -> ValueRange tp
forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (tp -> ValueBound tp
forall tp. tp -> ValueBound tp
Inclusive tp
lo) (tp -> ValueBound tp
forall tp. tp -> ValueBound tp
Inclusive tp
hi)

  freshBoundedReal :: ExprBuilder t st fs
-> SolverSymbol
-> Maybe Rational
-> Maybe Rational
-> IO (SymReal (ExprBuilder t st fs))
freshBoundedReal ExprBuilder t st fs
sym SolverSymbol
nm Maybe Rational
mlo Maybe Rational
mhi =
    do Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (Maybe Rational -> Maybe Rational -> Bool
forall {a}. Ord a => Maybe a -> Maybe a -> Bool
boundsOK Maybe Rational
mlo Maybe Rational
mhi) (InvalidRange -> IO ()
forall e a. Exception e => e -> IO a
Ex.throwIO (BaseTypeRepr BaseRealType
-> Maybe (ConcreteValue BaseRealType)
-> Maybe (ConcreteValue BaseRealType)
-> InvalidRange
forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange BaseTypeRepr BaseRealType
BaseRealRepr Maybe Rational
Maybe (ConcreteValue BaseRealType)
mlo Maybe Rational
Maybe (ConcreteValue BaseRealType)
mhi))
       ExprBoundVar t BaseRealType
v <- ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr BaseRealType
-> VarKind
-> Maybe (AbstractValue BaseRealType)
-> IO (ExprBoundVar t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr BaseRealType
BaseRealRepr VarKind
UninterpVarKind (Maybe Rational -> Maybe Rational -> Maybe RealAbstractValue
absVal Maybe Rational
mlo Maybe Rational
mhi)
       ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (ExprBoundVar t BaseRealType -> SymbolBinding t
forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t BaseRealType
v)
       Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t BaseRealType -> IO (Expr t BaseRealType))
-> Expr t BaseRealType -> IO (Expr t BaseRealType)
forall a b. (a -> b) -> a -> b
$! ExprBoundVar t BaseRealType -> Expr t BaseRealType
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t BaseRealType
v
   where
   boundsOK :: Maybe a -> Maybe a -> Bool
boundsOK (Just a
lo) (Just a
hi) = a
lo a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi
   boundsOK Maybe a
_ Maybe a
_ = Bool
True

   absVal :: Maybe Rational -> Maybe Rational -> Maybe RealAbstractValue
absVal Maybe Rational
Nothing Maybe Rational
Nothing = Maybe RealAbstractValue
forall a. Maybe a
Nothing
   absVal (Just Rational
lo) Maybe Rational
Nothing = RealAbstractValue -> Maybe RealAbstractValue
forall a. a -> Maybe a
Just (RealAbstractValue -> Maybe RealAbstractValue)
-> RealAbstractValue -> Maybe RealAbstractValue
forall a b. (a -> b) -> a -> b
$! ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (ValueBound Rational -> ValueBound Rational -> ValueRange Rational
forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (Rational -> ValueBound Rational
forall tp. tp -> ValueBound tp
Inclusive Rational
lo) ValueBound Rational
forall tp. ValueBound tp
Unbounded) Maybe Bool
forall a. Maybe a
Nothing
   absVal Maybe Rational
Nothing (Just Rational
hi) = RealAbstractValue -> Maybe RealAbstractValue
forall a. a -> Maybe a
Just (RealAbstractValue -> Maybe RealAbstractValue)
-> RealAbstractValue -> Maybe RealAbstractValue
forall a b. (a -> b) -> a -> b
$! ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (ValueBound Rational -> ValueBound Rational -> ValueRange Rational
forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange ValueBound Rational
forall tp. ValueBound tp
Unbounded (Rational -> ValueBound Rational
forall tp. tp -> ValueBound tp
Inclusive Rational
hi)) Maybe Bool
forall a. Maybe a
Nothing
   absVal (Just Rational
lo) (Just Rational
hi) = RealAbstractValue -> Maybe RealAbstractValue
forall a. a -> Maybe a
Just (RealAbstractValue -> Maybe RealAbstractValue)
-> RealAbstractValue -> Maybe RealAbstractValue
forall a b. (a -> b) -> a -> b
$! ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (ValueBound Rational -> ValueBound Rational -> ValueRange Rational
forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (Rational -> ValueBound Rational
forall tp. tp -> ValueBound tp
Inclusive Rational
lo) (Rational -> ValueBound Rational
forall tp. tp -> ValueBound tp
Inclusive Rational
hi)) Maybe Bool
forall a. Maybe a
Nothing

  freshLatch :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
freshLatch ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp = do
    ExprBoundVar t tp
v <- ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp VarKind
LatchVarKind Maybe (AbstractValue tp)
forall a. Maybe a
Nothing
    ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (ExprBoundVar t tp -> SymbolBinding t
forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t tp
v)
    Expr t tp -> IO (Expr t tp)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t tp -> IO (Expr t tp)) -> Expr t tp -> IO (Expr t tp)
forall a b. (a -> b) -> a -> b
$! ExprBoundVar t tp -> Expr t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t tp
v

  exprUninterpConstants :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SymExpr (ExprBuilder t st fs) tp
-> Set (Some (BoundVar (ExprBuilder t st fs)))
exprUninterpConstants ExprBuilder t st fs
_sym SymExpr (ExprBuilder t st fs) tp
expr =
    ((forall s. ST s (CollectedVarInfo t)) -> CollectedVarInfo t
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (CollectedVarInfo t)) -> CollectedVarInfo t)
-> (forall s. ST s (CollectedVarInfo t)) -> CollectedVarInfo t
forall a b. (a -> b) -> a -> b
$ VarRecorder s t () -> ST s (CollectedVarInfo t)
forall s t. VarRecorder s t () -> ST s (CollectedVarInfo t)
VI.collectVarInfo (VarRecorder s t () -> ST s (CollectedVarInfo t))
-> VarRecorder s t () -> ST s (CollectedVarInfo t)
forall a b. (a -> b) -> a -> b
$ Scope -> Expr t tp -> VarRecorder s t ()
forall t (tp :: BaseType) s.
Scope -> Expr t tp -> VarRecorder s t ()
VI.recordExprVars Scope
VI.ExistsOnly SymExpr (ExprBuilder t st fs) tp
Expr t tp
expr) CollectedVarInfo t
-> Getting
     (Set (Some (ExprBoundVar t)))
     (CollectedVarInfo t)
     (Set (Some (ExprBoundVar t)))
-> Set (Some (ExprBoundVar t))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (Some (ExprBoundVar t)))
  (CollectedVarInfo t)
  (Set (Some (ExprBoundVar t)))
forall t (f :: Type -> Type).
Functor f =>
(Set (Some (ExprBoundVar t)) -> f (Set (Some (ExprBoundVar t))))
-> CollectedVarInfo t -> f (CollectedVarInfo t)
VI.uninterpConstants

  freshBoundVar :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (BoundVar (ExprBuilder t st fs) tp)
freshBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp =
    ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp VarKind
QuantifierVarKind Maybe (AbstractValue tp)
forall a. Maybe a
Nothing

  varExpr :: forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> SymExpr (ExprBuilder t st fs) tp
varExpr ExprBuilder t st fs
_ = BoundVar (ExprBuilder t st fs) tp
-> SymExpr (ExprBuilder t st fs) tp
ExprBoundVar t tp -> Expr t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr

  forallPred :: forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forallPred ExprBuilder t st fs
sym BoundVar (ExprBuilder t st fs) tp
bv Pred (ExprBuilder t st fs)
e = ExprBuilder t st fs
-> NonceApp t (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) BaseBoolType -> IO (Expr t BaseBoolType))
-> NonceApp t (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBoundVar t tp
-> Expr t BaseBoolType -> NonceApp t (Expr t) BaseBoolType
forall t (tp1 :: BaseType) (e :: BaseType -> Type).
ExprBoundVar t tp1 -> e BaseBoolType -> NonceApp t e BaseBoolType
Forall BoundVar (ExprBuilder t st fs) tp
ExprBoundVar t tp
bv Pred (ExprBuilder t st fs)
Expr t BaseBoolType
e

  existsPred :: forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
existsPred ExprBuilder t st fs
sym BoundVar (ExprBuilder t st fs) tp
bv Pred (ExprBuilder t st fs)
e = ExprBuilder t st fs
-> NonceApp t (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) BaseBoolType -> IO (Expr t BaseBoolType))
-> NonceApp t (Expr t) BaseBoolType -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ ExprBoundVar t tp
-> Expr t BaseBoolType -> NonceApp t (Expr t) BaseBoolType
forall t (tp1 :: BaseType) (e :: BaseType -> Type).
ExprBoundVar t tp1 -> e BaseBoolType -> NonceApp t e BaseBoolType
Exists BoundVar (ExprBuilder t st fs) tp
ExprBoundVar t tp
bv Pred (ExprBuilder t st fs)
Expr t BaseBoolType
e

  ----------------------------------------------------------------------
  -- SymFn operations.

  -- | Create a function defined in terms of previous functions.
  definedFn :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> Assignment (BoundVar (ExprBuilder t st fs)) args
-> SymExpr (ExprBuilder t st fs) ret
-> UnfoldPolicy
-> IO (SymFn (ExprBuilder t st fs) args ret)
definedFn ExprBuilder t st fs
sym SolverSymbol
fn_name Assignment (BoundVar (ExprBuilder t st fs)) args
bound_vars SymExpr (ExprBuilder t st fs) ret
result UnfoldPolicy
policy = do
    ProgramLoc
l <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
    Nonce t (args ::> ret)
n <- ExprBuilder t st fs -> IO (Nonce t (args ::> ret))
forall t (st :: Type -> Type) fs (ctx :: Ctx BaseType).
ExprBuilder t st fs -> IO (Nonce t ctx)
sbFreshSymFnNonce ExprBuilder t st fs
sym
    let fn :: ExprSymFn t args ret
fn = ExprSymFn { symFnId :: Nonce t (args ::> ret)
symFnId   = Nonce t (args ::> ret)
n
                         , symFnName :: SolverSymbol
symFnName = SolverSymbol
fn_name
                         , symFnInfo :: SymFnInfo t args ret
symFnInfo = Assignment (ExprBoundVar t) args
-> Expr t ret -> UnfoldPolicy -> SymFnInfo t args ret
forall t (args :: Ctx BaseType) (ret :: BaseType).
Assignment (ExprBoundVar t) args
-> Expr t ret -> UnfoldPolicy -> SymFnInfo t args ret
DefinedFnInfo Assignment (BoundVar (ExprBuilder t st fs)) args
Assignment (ExprBoundVar t) args
bound_vars SymExpr (ExprBuilder t st fs) ret
Expr t ret
result UnfoldPolicy
policy
                         , symFnLoc :: ProgramLoc
symFnLoc  = ProgramLoc
l
                         }
    ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
fn_name (ExprSymFn t args ret -> SymbolBinding t
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymbolBinding t
FnSymbolBinding ExprSymFn t args ret
fn)
    ExprSymFn t args ret -> IO (ExprSymFn t args ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t args ret
fn

  freshTotalUninterpFn :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn (ExprBuilder t st fs) args ret)
freshTotalUninterpFn ExprBuilder t st fs
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type = do
    Nonce t (args ::> ret)
n <- ExprBuilder t st fs -> IO (Nonce t (args ::> ret))
forall t (st :: Type -> Type) fs (ctx :: Ctx BaseType).
ExprBuilder t st fs -> IO (Nonce t ctx)
sbFreshSymFnNonce ExprBuilder t st fs
sym
    ProgramLoc
l <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
    let fn :: ExprSymFn t args ret
fn = ExprSymFn { symFnId :: Nonce t (args ::> ret)
symFnId = Nonce t (args ::> ret)
n
                         , symFnName :: SolverSymbol
symFnName = SolverSymbol
fn_name
                         , symFnInfo :: SymFnInfo t args ret
symFnInfo = Assignment BaseTypeRepr args
-> BaseTypeRepr ret -> SymFnInfo t args ret
forall t (args :: Ctx BaseType) (ret :: BaseType).
Assignment BaseTypeRepr args
-> BaseTypeRepr ret -> SymFnInfo t args ret
UninterpFnInfo Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type
                         , symFnLoc :: ProgramLoc
symFnLoc = ProgramLoc
l
                         }
    ExprSymFn t args ret
-> IO (ExprSymFn t args ret) -> IO (ExprSymFn t args ret)
forall a b. a -> b -> b
seq ExprSymFn t args ret
fn (IO (ExprSymFn t args ret) -> IO (ExprSymFn t args ret))
-> IO (ExprSymFn t args ret) -> IO (ExprSymFn t args ret)
forall a b. (a -> b) -> a -> b
$ do
    ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
fn_name (ExprSymFn t args ret -> SymbolBinding t
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymbolBinding t
FnSymbolBinding ExprSymFn t args ret
fn)
    ExprSymFn t args ret -> IO (ExprSymFn t args ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t args ret
fn

  applySymFn :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) args ret
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
applySymFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) args ret
fn Assignment (SymExpr (ExprBuilder t st fs)) args
args = do
   case ExprSymFn t args ret -> SymFnInfo t args ret
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
fn of
     DefinedFnInfo Assignment (ExprBoundVar t) args
bound_vars Expr t ret
e UnfoldPolicy
policy
       | UnfoldPolicy -> Assignment (Expr t) args -> Bool
forall (e :: BaseType -> Type) (args :: Ctx BaseType).
IsExpr e =>
UnfoldPolicy -> Assignment e args -> Bool
shouldUnfold UnfoldPolicy
policy Assignment (SymExpr (ExprBuilder t st fs)) args
Assignment (Expr t) args
args ->
           ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
forall t (st :: Type -> Type) fs (ret :: BaseType)
       (args :: Ctx BaseType).
ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
evalBoundVars ExprBuilder t st fs
sym Expr t ret
e Assignment (ExprBoundVar t) args
bound_vars Assignment (SymExpr (ExprBuilder t st fs)) args
Assignment (Expr t) args
args
     MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
f Assignment (ExprBoundVar t) args
_ Expr t ret
_ -> do
       MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
-> ExprBuilder t st fs
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsExprBuilder sym =>
MatlabSolverFn (SymExpr sym) args ret
-> sym -> Assignment (SymExpr sym) args -> IO (SymExpr sym ret)
evalMatlabSolverFn MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
MatlabSolverFn (Expr t) args ret
f ExprBuilder t st fs
sym Assignment (SymExpr (ExprBuilder t st fs)) args
args
     SymFnInfo t args ret
_ -> ExprBuilder t st fs -> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) ret -> IO (Expr t ret))
-> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$! ExprSymFn t args ret
-> Assignment (Expr t) args -> NonceApp t (Expr t) ret
forall t (args :: Ctx BaseType) (tp :: BaseType)
       (e :: BaseType -> Type).
ExprSymFn t args tp -> Assignment e args -> NonceApp t e tp
FnApp SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
fn Assignment (SymExpr (ExprBuilder t st fs)) args
Assignment (Expr t) args
args

  substituteBoundVars :: forall (tp :: BaseType).
ExprBuilder t st fs
-> MapF
     (BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
-> SymExpr (ExprBuilder t st fs) tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
substituteBoundVars ExprBuilder t st fs
sym MapF
  (BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
subst SymExpr (ExprBuilder t st fs) tp
e = do
    EvalHashTables t
tbls <- ST RealWorld (EvalHashTables t) -> IO (EvalHashTables t)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (EvalHashTables t) -> IO (EvalHashTables t))
-> ST RealWorld (EvalHashTables t) -> IO (EvalHashTables t)
forall a b. (a -> b) -> a -> b
$ do
      HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- Int -> ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
forall {k1} s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized (Int -> ST RealWorld (HashTable RealWorld (Expr t) (Expr t)))
-> Int -> ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
forall a b. (a -> b) -> a -> b
$ MapF (ExprBoundVar t) (Expr t) -> Int
forall t e. IsBinTree t e => t -> Int
PM.size MapF
  (BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
MapF (ExprBoundVar t) (Expr t)
subst
      HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl <- ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
      (forall (tp :: BaseType).
 ExprBoundVar t tp -> Expr t tp -> ST RealWorld ())
-> MapF (ExprBoundVar t) (Expr t) -> ST RealWorld ()
forall {v} (m :: Type -> Type) (ktp :: v -> Type) (f :: v -> Type).
Applicative m =>
(forall (tp :: v). ktp tp -> f tp -> m ()) -> MapF ktp f -> m ()
PM.traverseWithKey_ (HashTable RealWorld (Expr t) (Expr t)
-> Expr t tp -> Expr t tp -> ST RealWorld ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld (Expr t) (Expr t)
expr_tbl (Expr t tp -> Expr t tp -> ST RealWorld ())
-> (ExprBoundVar t tp -> Expr t tp)
-> ExprBoundVar t tp
-> Expr t tp
-> ST RealWorld ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExprBoundVar t tp -> Expr t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr) MapF
  (BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
MapF (ExprBoundVar t) (Expr t)
subst
      EvalHashTables t -> ST RealWorld (EvalHashTables t)
forall a. a -> ST RealWorld a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (EvalHashTables t -> ST RealWorld (EvalHashTables t))
-> EvalHashTables t -> ST RealWorld (EvalHashTables t)
forall a b. (a -> b) -> a -> b
$ EvalHashTables
        { exprTable :: HashTable RealWorld (Expr t) (Expr t)
exprTable = HashTable RealWorld (Expr t) (Expr t)
expr_tbl
        , fnTable :: HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable  = HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl
        }
    EvalHashTables t
-> ExprBuilder t st fs -> Expr t tp -> IO (Expr t tp)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym SymExpr (ExprBuilder t st fs) tp
Expr t tp
e

  substituteSymFns :: forall (tp :: BaseType).
ExprBuilder t st fs
-> MapF
     (SymFnWrapper (ExprBuilder t st fs))
     (SymFnWrapper (ExprBuilder t st fs))
-> SymExpr (ExprBuilder t st fs) tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
substituteSymFns ExprBuilder t st fs
sym MapF
  (SymFnWrapper (ExprBuilder t st fs))
  (SymFnWrapper (ExprBuilder t st fs))
subst SymExpr (ExprBuilder t st fs) tp
e = do
    EvalHashTables t
tbls <- ST RealWorld (EvalHashTables t) -> IO (EvalHashTables t)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (EvalHashTables t) -> IO (EvalHashTables t))
-> ST RealWorld (EvalHashTables t) -> IO (EvalHashTables t)
forall a b. (a -> b) -> a -> b
$ do
      HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
      HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl <- Int -> ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall {k1} s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized (Int
 -> ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t)))
-> Int
-> ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall a b. (a -> b) -> a -> b
$ MapF
  (SymFnWrapper (ExprBuilder t st fs))
  (SymFnWrapper (ExprBuilder t st fs))
-> Int
forall t e. IsBinTree t e => t -> Int
PM.size MapF
  (SymFnWrapper (ExprBuilder t st fs))
  (SymFnWrapper (ExprBuilder t st fs))
subst
      (forall (tp :: Ctx BaseType).
 SymFnWrapper (ExprBuilder t st fs) tp
 -> SymFnWrapper (ExprBuilder t st fs) tp -> ST RealWorld ())
-> MapF
     (SymFnWrapper (ExprBuilder t st fs))
     (SymFnWrapper (ExprBuilder t st fs))
-> ST RealWorld ()
forall {v} (m :: Type -> Type) (ktp :: v -> Type) (f :: v -> Type).
Applicative m =>
(forall (tp :: v). ktp tp -> f tp -> m ()) -> MapF ktp f -> m ()
PM.traverseWithKey_
        (\(SymFnWrapper SymFn (ExprBuilder t st fs) args ret
f) (SymFnWrapper SymFn (ExprBuilder t st fs) args ret
g) -> HashTable RealWorld (Nonce t) (CachedSymFn t)
-> Nonce t (args '::> ret)
-> CachedSymFn t (args '::> ret)
-> ST RealWorld ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl (ExprSymFn t args ret -> Nonce t (args '::> ret)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
f) (Bool -> ExprSymFn t args ret -> CachedSymFn t (args '::> ret)
forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
True SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
g))
        MapF
  (SymFnWrapper (ExprBuilder t st fs))
  (SymFnWrapper (ExprBuilder t st fs))
subst
      EvalHashTables t -> ST RealWorld (EvalHashTables t)
forall a. a -> ST RealWorld a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (EvalHashTables t -> ST RealWorld (EvalHashTables t))
-> EvalHashTables t -> ST RealWorld (EvalHashTables t)
forall a b. (a -> b) -> a -> b
$ EvalHashTables
        { exprTable :: HashTable RealWorld (Expr t) (Expr t)
exprTable = HashTable RealWorld (Expr t) (Expr t)
expr_tbl
        , fnTable :: HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable  = HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl
        }
    EvalHashTables t
-> ExprBuilder t st fs -> Expr t tp -> IO (Expr t tp)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym SymExpr (ExprBuilder t st fs) tp
Expr t tp
e

  transformPredBV2LIA :: ExprBuilder t st fs
-> [Pred (ExprBuilder t st fs)]
-> IO
     ([Pred (ExprBuilder t st fs)],
      Map
        (SomeSymFn (ExprBuilder t st fs))
        (SomeSymFn (ExprBuilder t st fs)))
transformPredBV2LIA ExprBuilder t st fs
sym [Pred (ExprBuilder t st fs)]
exprs = do
    HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
-> IO (HashTable RealWorld (Expr t) (Expr t))
forall a. ST RealWorld a -> IO a
stToIO ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
    HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl  <- ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
-> IO (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall a. ST RealWorld a -> IO a
stToIO ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
    let tbls :: EvalHashTables t
tbls = EvalHashTables
          { exprTable :: HashTable RealWorld (Expr t) (Expr t)
exprTable = HashTable RealWorld (Expr t) (Expr t)
expr_tbl
          , fnTable :: HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable  = HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl
          }
    HashTable
  RealWorld
  (ExprBoundVar t ('BaseBVType 64))
  (ExprBoundVar t BaseIntegerType)
subst <- IO
  (HashTable
     RealWorld
     (ExprBoundVar t ('BaseBVType 64))
     (ExprBoundVar t BaseIntegerType))
IO
  (IOHashTable
     HashTable
     (ExprBoundVar t ('BaseBVType 64))
     (ExprBoundVar t BaseIntegerType))
forall (h :: Type -> Type -> Type -> Type) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
    HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t)
fn_subst <- IO (HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t))
IO (IOHashTable HashTable (SomeExprSymFn t) (SomeExprSymFn t))
forall (h :: Type -> Type -> Type -> Type) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
    let transformer_tbls :: ExprTransformerTables t ('BaseBVType 64) BaseIntegerType
transformer_tbls = ExprTransformerTables
          { evalTables :: EvalHashTables t
evalTables = EvalHashTables t
tbls
          , transformerSubst :: IOHashTable
  HashTable
  (ExprBoundVar t ('BaseBVType 64))
  (ExprBoundVar t BaseIntegerType)
transformerSubst = HashTable
  RealWorld
  (ExprBoundVar t ('BaseBVType 64))
  (ExprBoundVar t BaseIntegerType)
IOHashTable
  HashTable
  (ExprBoundVar t ('BaseBVType 64))
  (ExprBoundVar t BaseIntegerType)
subst
          , transformerFnSubst :: IOHashTable HashTable (SomeExprSymFn t) (SomeExprSymFn t)
transformerFnSubst = HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t)
IOHashTable HashTable (SomeExprSymFn t) (SomeExprSymFn t)
fn_subst
          }
    let ?transformCmpTp1ToTp2 = ?transformCmpTp1ToTp2::ExprBuilder t st fs
                       -> Expr t BaseBoolType
                       -> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (BV2LIAExprTransformer t (Expr t BaseBoolType))
transformCmpBV2LIA
        ?transformExprTp1ToTp2 = ?transformExprTp1ToTp2::ExprBuilder t st fs
                        -> Expr t ('BaseBVType 64)
                        -> BV2LIAExprTransformer t (Expr t BaseIntegerType)
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t ('BaseBVType 64)
-> BV2LIAExprTransformer t (Expr t BaseIntegerType)
transformExprBV2LIA
    [Expr t BaseBoolType]
lia_exprs <- (String -> IO [Expr t BaseBoolType])
-> ([Expr t BaseBoolType] -> IO [Expr t BaseBoolType])
-> Either String [Expr t BaseBoolType]
-> IO [Expr t BaseBoolType]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO [Expr t BaseBoolType]
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail [Expr t BaseBoolType] -> IO [Expr t BaseBoolType]
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either String [Expr t BaseBoolType] -> IO [Expr t BaseBoolType])
-> IO (Either String [Expr t BaseBoolType])
-> IO [Expr t BaseBoolType]
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      ExprTransformer
  t ('BaseBVType 64) BaseIntegerType [Expr t BaseBoolType]
-> ExprTransformerTables t ('BaseBVType 64) BaseIntegerType
-> IO (Either String [Expr t BaseBoolType])
forall t (tp1 :: BaseType) (tp2 :: BaseType) a.
ExprTransformer t tp1 tp2 a
-> ExprTransformerTables t tp1 tp2 -> IO (Either String a)
runExprTransformer ((Expr t BaseBoolType
 -> BV2LIAExprTransformer t (Expr t BaseBoolType))
-> [Expr t BaseBoolType]
-> ExprTransformer
     t ('BaseBVType 64) BaseIntegerType [Expr t BaseBoolType]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: Type -> Type) a b.
Monad m =>
(a -> m b) -> [a] -> m [b]
mapM (ExprBuilder t st fs
-> Expr t BaseBoolType
-> BV2LIAExprTransformer t (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> Expr t BaseBoolType
-> ExprTransformer t tp1 tp2 (Expr t BaseBoolType)
transformPred ExprBuilder t st fs
sym) [Pred (ExprBuilder t st fs)]
[Expr t BaseBoolType]
exprs) ExprTransformerTables t ('BaseBVType 64) BaseIntegerType
transformer_tbls
    Map
  (SomeSymFn (ExprBuilder t st fs)) (SomeSymFn (ExprBuilder t st fs))
bv_to_lia_fn_subst <- [(SomeSymFn (ExprBuilder t st fs),
  SomeSymFn (ExprBuilder t st fs))]
-> Map
     (SomeSymFn (ExprBuilder t st fs)) (SomeSymFn (ExprBuilder t st fs))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(SomeSymFn (ExprBuilder t st fs),
   SomeSymFn (ExprBuilder t st fs))]
 -> Map
      (SomeSymFn (ExprBuilder t st fs))
      (SomeSymFn (ExprBuilder t st fs)))
-> ([(SomeExprSymFn t, SomeExprSymFn t)]
    -> [(SomeSymFn (ExprBuilder t st fs),
         SomeSymFn (ExprBuilder t st fs))])
-> [(SomeExprSymFn t, SomeExprSymFn t)]
-> Map
     (SomeSymFn (ExprBuilder t st fs)) (SomeSymFn (ExprBuilder t st fs))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ((SomeExprSymFn t, SomeExprSymFn t)
 -> (SomeSymFn (ExprBuilder t st fs),
     SomeSymFn (ExprBuilder t st fs)))
-> [(SomeExprSymFn t, SomeExprSymFn t)]
-> [(SomeSymFn (ExprBuilder t st fs),
     SomeSymFn (ExprBuilder t st fs))]
forall a b. (a -> b) -> [a] -> [b]
map (\(SomeExprSymFn ExprSymFn t args ret
f, SomeExprSymFn ExprSymFn t args ret
g) -> (SymFn (ExprBuilder t st fs) args ret
-> SomeSymFn (ExprBuilder t st fs)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
SymFn sym args ret -> SomeSymFn sym
SomeSymFn SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
f, SymFn (ExprBuilder t st fs) args ret
-> SomeSymFn (ExprBuilder t st fs)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
SymFn sym args ret -> SomeSymFn sym
SomeSymFn SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
g)) ([(SomeExprSymFn t, SomeExprSymFn t)]
 -> Map
      (SomeSymFn (ExprBuilder t st fs))
      (SomeSymFn (ExprBuilder t st fs)))
-> IO [(SomeExprSymFn t, SomeExprSymFn t)]
-> IO
     (Map
        (SomeSymFn (ExprBuilder t st fs))
        (SomeSymFn (ExprBuilder t st fs)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$>
      IOHashTable HashTable (SomeExprSymFn t) (SomeExprSymFn t)
-> IO [(SomeExprSymFn t, SomeExprSymFn t)]
forall (h :: Type -> Type -> Type -> Type) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t)
IOHashTable HashTable (SomeExprSymFn t) (SomeExprSymFn t)
fn_subst
    ([Expr t BaseBoolType],
 Map
   (SomeSymFn (ExprBuilder t st fs))
   (SomeSymFn (ExprBuilder t st fs)))
-> IO
     ([Expr t BaseBoolType],
      Map
        (SomeSymFn (ExprBuilder t st fs))
        (SomeSymFn (ExprBuilder t st fs)))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ([Expr t BaseBoolType]
lia_exprs, Map
  (SomeSymFn (ExprBuilder t st fs)) (SomeSymFn (ExprBuilder t st fs))
bv_to_lia_fn_subst)

  transformSymFnLIA2BV :: ExprBuilder t st fs
-> SomeSymFn (ExprBuilder t st fs)
-> IO (SomeSymFn (ExprBuilder t st fs))
transformSymFnLIA2BV ExprBuilder t st fs
sym (SomeSymFn SymFn (ExprBuilder t st fs) args ret
fn) = do
    HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
-> IO (HashTable RealWorld (Expr t) (Expr t))
forall a. ST RealWorld a -> IO a
stToIO ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
    HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl  <- ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
-> IO (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall a. ST RealWorld a -> IO a
stToIO ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
    let tbls :: EvalHashTables t
tbls = EvalHashTables
          { exprTable :: HashTable RealWorld (Expr t) (Expr t)
exprTable = HashTable RealWorld (Expr t) (Expr t)
expr_tbl
          , fnTable :: HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable  = HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl
          }
    HashTable
  RealWorld
  (ExprBoundVar t BaseIntegerType)
  (ExprBoundVar t ('BaseBVType 64))
subst <- IO
  (HashTable
     RealWorld
     (ExprBoundVar t BaseIntegerType)
     (ExprBoundVar t ('BaseBVType 64)))
IO
  (IOHashTable
     HashTable
     (ExprBoundVar t BaseIntegerType)
     (ExprBoundVar t ('BaseBVType 64)))
forall (h :: Type -> Type -> Type -> Type) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
    HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t)
fn_subst <- IO (HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t))
IO (IOHashTable HashTable (SomeExprSymFn t) (SomeExprSymFn t))
forall (h :: Type -> Type -> Type -> Type) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
    let transformer_tbls :: ExprTransformerTables t BaseIntegerType ('BaseBVType 64)
transformer_tbls = ExprTransformerTables
          { evalTables :: EvalHashTables t
evalTables = EvalHashTables t
tbls
          , transformerSubst :: IOHashTable
  HashTable
  (ExprBoundVar t BaseIntegerType)
  (ExprBoundVar t ('BaseBVType 64))
transformerSubst = HashTable
  RealWorld
  (ExprBoundVar t BaseIntegerType)
  (ExprBoundVar t ('BaseBVType 64))
IOHashTable
  HashTable
  (ExprBoundVar t BaseIntegerType)
  (ExprBoundVar t ('BaseBVType 64))
subst
          , transformerFnSubst :: IOHashTable HashTable (SomeExprSymFn t) (SomeExprSymFn t)
transformerFnSubst = HashTable RealWorld (SomeExprSymFn t) (SomeExprSymFn t)
IOHashTable HashTable (SomeExprSymFn t) (SomeExprSymFn t)
fn_subst
          }
    let ?transformCmpTp1ToTp2 = ?transformCmpTp1ToTp2::ExprBuilder t st fs
                       -> Expr t BaseBoolType
                       -> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseBoolType
-> Maybe (LIA2BVExprTransformer t (Expr t BaseBoolType))
transformCmpLIA2BV
        ?transformExprTp1ToTp2 = ?transformExprTp1ToTp2::ExprBuilder t st fs
                        -> Expr t BaseIntegerType
                        -> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> Expr t BaseIntegerType
-> LIA2BVExprTransformer t (Expr t ('BaseBVType 64))
transformExprLIA2BV
    (String -> IO (SomeSymFn (ExprBuilder t st fs)))
-> (SomeExprSymFn t -> IO (SomeSymFn (ExprBuilder t st fs)))
-> Either String (SomeExprSymFn t)
-> IO (SomeSymFn (ExprBuilder t st fs))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO (SomeSymFn (ExprBuilder t st fs))
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (\(SomeExprSymFn ExprSymFn t args ret
fn') -> SomeSymFn (ExprBuilder t st fs)
-> IO (SomeSymFn (ExprBuilder t st fs))
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return (SomeSymFn (ExprBuilder t st fs)
 -> IO (SomeSymFn (ExprBuilder t st fs)))
-> SomeSymFn (ExprBuilder t st fs)
-> IO (SomeSymFn (ExprBuilder t st fs))
forall a b. (a -> b) -> a -> b
$ SymFn (ExprBuilder t st fs) args ret
-> SomeSymFn (ExprBuilder t st fs)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
SymFn sym args ret -> SomeSymFn sym
SomeSymFn SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
fn') (Either String (SomeExprSymFn t)
 -> IO (SomeSymFn (ExprBuilder t st fs)))
-> IO (Either String (SomeExprSymFn t))
-> IO (SomeSymFn (ExprBuilder t st fs))
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      ExprTransformer
  t BaseIntegerType ('BaseBVType 64) (SomeExprSymFn t)
-> ExprTransformerTables t BaseIntegerType ('BaseBVType 64)
-> IO (Either String (SomeExprSymFn t))
forall t (tp1 :: BaseType) (tp2 :: BaseType) a.
ExprTransformer t tp1 tp2 a
-> ExprTransformerTables t tp1 tp2 -> IO (Either String a)
runExprTransformer (ExprBuilder t st fs
-> SomeExprSymFn t
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (SomeExprSymFn t)
forall t (st :: Type -> Type) fs (tp1 :: BaseType)
       (tp2 :: BaseType).
HasTransformerConstraints t st fs tp1 tp2 =>
ExprBuilder t st fs
-> SomeExprSymFn t -> ExprTransformer t tp1 tp2 (SomeExprSymFn t)
transformFn ExprBuilder t st fs
sym (SomeExprSymFn t
 -> ExprTransformer
      t BaseIntegerType ('BaseBVType 64) (SomeExprSymFn t))
-> SomeExprSymFn t
-> ExprTransformer
     t BaseIntegerType ('BaseBVType 64) (SomeExprSymFn t)
forall a b. (a -> b) -> a -> b
$ ExprSymFn t args ret -> SomeExprSymFn t
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SomeExprSymFn t
SomeExprSymFn SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
fn) ExprTransformerTables t BaseIntegerType ('BaseBVType 64)
transformer_tbls


instance IsInterpretedFloatExprBuilder (ExprBuilder t st fs) => IsInterpretedFloatSymExprBuilder (ExprBuilder t st fs)


--------------------------------------------------------------------------------
-- MatlabSymbolicArrayBuilder instance

instance MatlabSymbolicArrayBuilder (ExprBuilder t st fs) where
  mkMatlabSolverFn :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
-> IO (SymFn (ExprBuilder t st fs) args ret)
mkMatlabSolverFn ExprBuilder t st fs
sym MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
fn_id = do
    let key :: MatlabFnWrapper t (args ::> ret)
key = MatlabSolverFn (Expr t) args ret
-> MatlabFnWrapper t (args ::> ret)
forall t (a :: Ctx BaseType) (r :: BaseType).
MatlabSolverFn (Expr t) a r -> MatlabFnWrapper t (a ::> r)
MatlabFnWrapper MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
MatlabSolverFn (Expr t) args ret
fn_id
    Maybe (ExprSymFnWrapper t (args ::> ret))
mr <- ST RealWorld (Maybe (ExprSymFnWrapper t (args ::> ret)))
-> IO (Maybe (ExprSymFnWrapper t (args ::> ret)))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Maybe (ExprSymFnWrapper t (args ::> ret)))
 -> IO (Maybe (ExprSymFnWrapper t (args ::> ret))))
-> ST RealWorld (Maybe (ExprSymFnWrapper t (args ::> ret)))
-> IO (Maybe (ExprSymFnWrapper t (args ::> ret)))
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
-> MatlabFnWrapper t (args ::> ret)
-> ST RealWorld (Maybe (ExprSymFnWrapper t (args ::> ret)))
forall {k} (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> ST s (Maybe (val tp))
PH.lookup (ExprBuilder t st fs
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
sbMatlabFnCache ExprBuilder t st fs
sym) MatlabFnWrapper t (args ::> ret)
key
    case Maybe (ExprSymFnWrapper t (args ::> ret))
mr of
      Just (ExprSymFnWrapper ExprSymFn t a r
f) -> ExprSymFn t args ret -> IO (ExprSymFn t args ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t args ret
ExprSymFn t a r
f
      Maybe (ExprSymFnWrapper t (args ::> ret))
Nothing -> do
        let tps :: Assignment BaseTypeRepr args
tps = MatlabSolverFn (Expr t) args ret -> Assignment BaseTypeRepr args
forall (f :: BaseType -> Type) (args :: Ctx BaseType)
       (ret :: BaseType).
MatlabSolverFn f args ret -> Assignment BaseTypeRepr args
matlabSolverArgTypes MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
MatlabSolverFn (Expr t) args ret
fn_id
        Assignment (ExprBoundVar t) args
vars <- (forall (x :: BaseType). BaseTypeRepr x -> IO (ExprBoundVar t x))
-> forall (x :: Ctx BaseType).
   Assignment BaseTypeRepr x -> IO (Assignment (ExprBoundVar t) x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
forall (f :: BaseType -> Type) (g :: BaseType -> Type)
       (m :: Type -> Type).
Applicative m =>
(forall (x :: BaseType). f x -> m (g x))
-> forall (x :: Ctx BaseType). Assignment f x -> m (Assignment g x)
traverseFC (ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr x
-> IO (BoundVar (ExprBuilder t st fs) x)
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (BoundVar sym tp)
forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (BoundVar (ExprBuilder t st fs) tp)
freshBoundVar ExprBuilder t st fs
sym SolverSymbol
emptySymbol) Assignment BaseTypeRepr args
tps
        Expr t ret
r <- MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
-> ExprBuilder t st fs
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsExprBuilder sym =>
MatlabSolverFn (SymExpr sym) args ret
-> sym -> Assignment (SymExpr sym) args -> IO (SymExpr sym ret)
evalMatlabSolverFn MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
fn_id ExprBuilder t st fs
sym ((forall (x :: BaseType). ExprBoundVar t x -> Expr t x)
-> forall (x :: Ctx BaseType).
   Assignment (ExprBoundVar t) x -> Assignment (Expr t) x
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
fmapFC ExprBoundVar t x -> Expr t x
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
forall (x :: BaseType). ExprBoundVar t x -> Expr t x
BoundVarExpr Assignment (ExprBoundVar t) args
vars)
        ProgramLoc
l <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
        Nonce t (args ::> ret)
n <- ExprBuilder t st fs -> IO (Nonce t (args ::> ret))
forall t (st :: Type -> Type) fs (ctx :: Ctx BaseType).
ExprBuilder t st fs -> IO (Nonce t ctx)
sbFreshSymFnNonce ExprBuilder t st fs
sym
        let f :: ExprSymFn t args ret
f = ExprSymFn { symFnId :: Nonce t (args ::> ret)
symFnId   = Nonce t (args ::> ret)
n
                            , symFnName :: SolverSymbol
symFnName = SolverSymbol
emptySymbol
                            , symFnInfo :: SymFnInfo t args ret
symFnInfo = MatlabSolverFn (Expr t) args ret
-> Assignment (ExprBoundVar t) args
-> Expr t ret
-> SymFnInfo t args ret
forall t (args :: Ctx BaseType) (ret :: BaseType).
MatlabSolverFn (Expr t) args ret
-> Assignment (ExprBoundVar t) args
-> Expr t ret
-> SymFnInfo t args ret
MatlabSolverFnInfo MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
MatlabSolverFn (Expr t) args ret
fn_id Assignment (ExprBoundVar t) args
vars Expr t ret
r
                            , symFnLoc :: ProgramLoc
symFnLoc  = ProgramLoc
l
                            }
        ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
emptySymbol (ExprSymFn t args ret -> SymbolBinding t
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymbolBinding t
FnSymbolBinding ExprSymFn t args ret
f)
        ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
-> MatlabFnWrapper t (args ::> ret)
-> ExprSymFnWrapper t (args ::> ret)
-> ST RealWorld ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert (ExprBuilder t st fs
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
sbMatlabFnCache ExprBuilder t st fs
sym) MatlabFnWrapper t (args ::> ret)
key (ExprSymFn t args ret -> ExprSymFnWrapper t (args ::> ret)
forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
ExprSymFn t a r -> ExprSymFnWrapper t c
ExprSymFnWrapper ExprSymFn t args ret
f)
        ExprSymFn t args ret -> IO (ExprSymFn t args ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t args ret
f

unsafeUserSymbol :: String -> IO SolverSymbol
unsafeUserSymbol :: String -> IO SolverSymbol
unsafeUserSymbol String
s =
  case String -> Either SolverSymbolError SolverSymbol
userSymbol String
s of
    Left SolverSymbolError
err -> String -> IO SolverSymbol
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (SolverSymbolError -> String
forall a. Show a => a -> String
show SolverSymbolError
err)
    Right SolverSymbol
symbol  -> SolverSymbol -> IO SolverSymbol
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SolverSymbol
symbol

cachedUninterpFn
  :: (sym ~ ExprBuilder t st fs)
  => sym
  -> SolverSymbol
  -> Ctx.Assignment BaseTypeRepr args
  -> BaseTypeRepr ret
  -> (  sym
     -> SolverSymbol
     -> Ctx.Assignment BaseTypeRepr args
     -> BaseTypeRepr ret
     -> IO (SymFn sym args ret)
     )
  -> IO (SymFn sym args ret)
cachedUninterpFn :: forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
    -> SolverSymbol
    -> Assignment BaseTypeRepr args
    -> BaseTypeRepr ret
    -> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn sym
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
handler = do
  Map
  (SolverSymbol, Some (Assignment BaseTypeRepr))
  (SomeSymFn (ExprBuilder t st fs))
fn_cache <- IORef
  (Map
     (SolverSymbol, Some (Assignment BaseTypeRepr))
     (SomeSymFn (ExprBuilder t st fs)))
-> IO
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
forall a. IORef a -> IO a
readIORef (IORef
   (Map
      (SolverSymbol, Some (Assignment BaseTypeRepr))
      (SomeSymFn (ExprBuilder t st fs)))
 -> IO
      (Map
         (SolverSymbol, Some (Assignment BaseTypeRepr))
         (SomeSymFn (ExprBuilder t st fs))))
-> IORef
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
-> IO
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> IORef
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> IORef
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
sbUninterpFnCache sym
ExprBuilder t st fs
sym
  case (SolverSymbol, Some (Assignment BaseTypeRepr))
-> Map
     (SolverSymbol, Some (Assignment BaseTypeRepr))
     (SomeSymFn (ExprBuilder t st fs))
-> Maybe (SomeSymFn (ExprBuilder t st fs))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (SolverSymbol, Some (Assignment BaseTypeRepr))
fn_key Map
  (SolverSymbol, Some (Assignment BaseTypeRepr))
  (SomeSymFn (ExprBuilder t st fs))
fn_cache of
    Just (SomeSymFn SymFn (ExprBuilder t st fs) args ret
fn)
      | Just args :~: args
Refl <- Assignment BaseTypeRepr args
-> Assignment BaseTypeRepr args -> Maybe (args :~: args)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: Ctx BaseType) (b :: Ctx BaseType).
Assignment BaseTypeRepr a
-> Assignment BaseTypeRepr b -> Maybe (a :~: b)
testEquality (ExprSymFn t args ret -> Assignment BaseTypeRepr args
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Assignment BaseTypeRepr args
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> Assignment BaseTypeRepr args
fnArgTypes SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
fn) Assignment BaseTypeRepr args
arg_types
      , Just ret :~: ret
Refl <- BaseTypeRepr ret -> BaseTypeRepr ret -> Maybe (ret :~: ret)
forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
forall (a :: BaseType) (b :: BaseType).
BaseTypeRepr a -> BaseTypeRepr b -> Maybe (a :~: b)
testEquality (ExprSymFn t args ret -> BaseTypeRepr ret
forall (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> BaseTypeRepr ret
forall (fn :: Ctx BaseType -> BaseType -> Type)
       (args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> BaseTypeRepr ret
fnReturnType SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
fn) BaseTypeRepr ret
ret_type
      -> ExprSymFn t args ret -> IO (ExprSymFn t args ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
fn
      | Bool
otherwise
      -> String -> IO (ExprSymFn t args ret)
forall a. String -> IO a
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Duplicate uninterpreted function declaration."
    Maybe (SomeSymFn (ExprBuilder t st fs))
Nothing -> do
      ExprSymFn t args ret
fn <- sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
handler sym
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type
      IORef
  (Map
     (SolverSymbol, Some (Assignment BaseTypeRepr))
     (SomeSymFn (ExprBuilder t st fs)))
-> (Map
      (SolverSymbol, Some (Assignment BaseTypeRepr))
      (SomeSymFn (ExprBuilder t st fs))
    -> (Map
          (SolverSymbol, Some (Assignment BaseTypeRepr))
          (SomeSymFn (ExprBuilder t st fs)),
        ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (ExprBuilder t st fs
-> IORef
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> IORef
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
sbUninterpFnCache sym
ExprBuilder t st fs
sym) (\Map
  (SolverSymbol, Some (Assignment BaseTypeRepr))
  (SomeSymFn (ExprBuilder t st fs))
m -> ((SolverSymbol, Some (Assignment BaseTypeRepr))
-> SomeSymFn (ExprBuilder t st fs)
-> Map
     (SolverSymbol, Some (Assignment BaseTypeRepr))
     (SomeSymFn (ExprBuilder t st fs))
-> Map
     (SolverSymbol, Some (Assignment BaseTypeRepr))
     (SomeSymFn (ExprBuilder t st fs))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (SolverSymbol, Some (Assignment BaseTypeRepr))
fn_key (SymFn (ExprBuilder t st fs) args ret
-> SomeSymFn (ExprBuilder t st fs)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
SymFn sym args ret -> SomeSymFn sym
SomeSymFn SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
fn) Map
  (SolverSymbol, Some (Assignment BaseTypeRepr))
  (SomeSymFn (ExprBuilder t st fs))
m, ()))
      ExprSymFn t args ret -> IO (ExprSymFn t args ret)
forall a. a -> IO a
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t args ret
fn
  where fn_key :: (SolverSymbol, Some (Assignment BaseTypeRepr))
fn_key =  (SolverSymbol
fn_name, Assignment BaseTypeRepr (args ::> ret)
-> Some (Assignment BaseTypeRepr)
forall k (f :: k -> Type) (x :: k). f x -> Some f
Some (Assignment BaseTypeRepr args
arg_types Assignment BaseTypeRepr args
-> BaseTypeRepr ret -> Assignment BaseTypeRepr (args ::> ret)
forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
       (tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> BaseTypeRepr ret
ret_type))

mkUninterpFnApp
  :: (sym ~ ExprBuilder t st fs)
  => sym
  -> String
  -> Ctx.Assignment (SymExpr sym) args
  -> BaseTypeRepr ret
  -> IO (SymExpr sym ret)
mkUninterpFnApp :: forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp sym
sym String
str_fn_name Assignment (SymExpr sym) args
args BaseTypeRepr ret
ret_type = do
  SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol String
str_fn_name
  let arg_types :: Assignment BaseTypeRepr args
arg_types = (forall (x :: BaseType). Expr t x -> BaseTypeRepr x)
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> Assignment BaseTypeRepr x
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
fmapFC Expr t x -> BaseTypeRepr x
forall (x :: BaseType). Expr t x -> BaseTypeRepr x
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr sym) args
Assignment (Expr t) args
args
  ExprSymFn t args ret
fn <- sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
    -> SolverSymbol
    -> Assignment BaseTypeRepr args
    -> BaseTypeRepr ret
    -> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
    -> SolverSymbol
    -> Assignment BaseTypeRepr args
    -> BaseTypeRepr ret
    -> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn sym
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn
  sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn sym
sym SymFn sym args ret
ExprSymFn t args ret
fn Assignment (SymExpr sym) args
args

mkFreshUninterpFnApp
  :: (sym ~ ExprBuilder t st fs)
  => sym
  -> String
  -> Ctx.Assignment (SymExpr sym) args
  -> BaseTypeRepr ret
  -> IO (SymExpr sym ret)
mkFreshUninterpFnApp :: forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkFreshUninterpFnApp sym
sym String
str_fn_name Assignment (SymExpr sym) args
args BaseTypeRepr ret
ret_type = do
  SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol String
str_fn_name
  let arg_types :: Assignment BaseTypeRepr args
arg_types = (forall (x :: BaseType). Expr t x -> BaseTypeRepr x)
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> Assignment BaseTypeRepr x
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
forall (f :: BaseType -> Type) (g :: BaseType -> Type).
(forall (x :: BaseType). f x -> g x)
-> forall (x :: Ctx BaseType). Assignment f x -> Assignment g x
fmapFC Expr t x -> BaseTypeRepr x
forall (x :: BaseType). Expr t x -> BaseTypeRepr x
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr sym) args
Assignment (Expr t) args
args
  ExprSymFn t args ret
fn <- sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn sym
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type
  sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
forall (args :: Ctx BaseType) (ret :: BaseType).
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn sym
sym SymFn sym args ret
ExprSymFn t args ret
fn Assignment (SymExpr sym) args
args