{-|
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 DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# 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
  , cacheStartSize
  , userState
  , exprCounter
  , startCaching
  , stopCaching
  , exprBuilderSplitConfig
  , exprBuilderFreshConfig

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

    -- * configuration options
  , unaryThresholdOption
  , cacheStartSizeOption
  , 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.IO.Class
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           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 = 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 <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ 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 -> 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
      seq :: forall a b. a -> b -> b
seq a tp
r forall a b. (a -> b) -> a -> b
$ do
      forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ 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
      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 = forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f 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 = forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
x) (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) =
    forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp 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) =
    forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
x) (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 = forall t. Bimap SolverSymbol (SymbolBinding t) -> SymbolVarBimap t
SymbolVarBimap 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) = 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) = 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 <- 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
    forall (m :: Type -> Type) a. Monad m => a -> m a
return 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) = 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) =
    forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ 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) =
    forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering forall a b. (a -> b) -> a -> b
$ 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 Show (SomeExprSymFn t) where
  show :: SomeExprSymFn t -> String
show (SomeExprSymFn ExprSymFn t args ret
f) = 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)

          -- | 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.
Getter (ExprBuilder t st fs) (NonceGenerator IO t)
exprCounter = forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to 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.
Lens' (ExprBuilder t st fs) (st t)
userState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens 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 t
sbUserState = st t
st })

unaryThreshold :: Getter (ExprBuilder t st fs) (CFG.OptionSetting BaseIntegerType)
unaryThreshold :: forall t (st :: Type -> Type) fs.
Getter (ExprBuilder t st fs) (OptionSetting BaseIntegerType)
unaryThreshold = forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to 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.
Getter (ExprBuilder t st fs) (OptionSetting BaseIntegerType)
cacheStartSize = forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize

-- | 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 (forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Config
sbConfiguration ExprBuilder t st fs
sym)
     forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprBuilder t st fs
sym{ sbConfiguration :: Config
sbConfiguration = Config
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 = forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sym
     ExprAllocator t
es <- forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage NonceGenerator IO t
gen

     IORef ProgramLoc
loc_ref       <- forall a. a -> IO (IORef a)
newIORef ProgramLoc
initializationLoc
     IORef (ExprAllocator t)
storage_ref   <- forall a. a -> IO (IORef a)
newIORef ExprAllocator t
es
     IORef (Maybe (SolverEvent -> IO ()))
logger_ref    <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
     IORef (SymbolVarBimap t)
bindings_ref  <- forall a. a -> IO (IORef a)
newIORef forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef (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
              ]
     OptionSetting BaseIntegerType
unarySetting       <- forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
unaryThresholdOption Config
cfg
     OptionSetting BaseIntegerType
cacheStartSetting  <- forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
cacheStartSizeOption Config
cfg
     [ConfigDesc] -> Config -> IO ()
CFG.extendConfig [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 <- forall a. a -> IO (IORef a)
newIORef Integer
0

     forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprBuilder t st fs
sym { sbConfiguration :: Config
sbConfiguration = Config
cfg
                , sbFloatReduce :: Bool
sbFloatReduce = Bool
True
                , sbUnaryThreshold :: OptionSetting BaseIntegerType
sbUnaryThreshold = OptionSetting BaseIntegerType
unarySetting
                , sbCacheStartSize :: OptionSetting BaseIntegerType
sbCacheStartSize = OptionSetting BaseIntegerType
cacheStartSetting
                , sbProgramLoc :: IORef ProgramLoc
sbProgramLoc = IORef ProgramLoc
loc_ref
                , sbCurAllocator :: IORef (ExprAllocator t)
sbCurAllocator = IORef (ExprAllocator t)
storage_ref
                , sbNonLinearOps :: IORef Integer
sbNonLinearOps = IORef Integer
nonLinearOps
                , sbVarBindings :: IORef (SymbolVarBimap t)
sbVarBindings = IORef (SymbolVarBimap t)
bindings_ref
                , sbSolverLogger :: IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger = IORef (Maybe (SolverEvent -> IO ()))
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 = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall t (f :: BaseType -> Type).
IORef (MapF (Nonce t) f) -> IdxCache t f
IdxCache forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef 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{} = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
_ StringExpr{} = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
_ BoolExpr{} = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
_ FloatExpr{} = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
c (NonceAppExpr NonceAppExpr t tp
e) = 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 (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)  = 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 (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) = 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 (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 = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef (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 = seq :: forall a b. a -> b -> b
seq f tp
v forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c) forall a b. (a -> b) -> a -> b
$ (\MapF (Nonce t) f
m -> (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 = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c) forall a b. (a -> b) -> a -> b
$ (\MapF (Nonce t) f
m -> (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 = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
atomicWriteIORef (forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c) 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{} = forall a. Maybe a
Nothing
exprMaybeId StringExpr{} = forall a. Maybe a
Nothing
exprMaybeId BoolExpr{} = forall a. Maybe a
Nothing
exprMaybeId FloatExpr{} = forall a. Maybe a
Nothing
exprMaybeId (NonceAppExpr NonceAppExpr t tp
e) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t tp
e
exprMaybeId (AppExpr  AppExpr t tp
e) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t tp
e
exprMaybeId (BoundVarExpr ExprBoundVar t tp
e) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! 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 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 -> 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 <- 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 -> 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
      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
      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 = forall a. IORef a -> IO a
readIORef (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 <- forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sym)
  ProgramLoc
pc <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
  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 (e :: BaseType -> Type) t (tp :: BaseType).
IsExpr e =>
(forall (u :: BaseType). e u -> AbstractValue u)
-> NonceApp t e tp -> AbstractValue tp
quantAbsEval forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
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 <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sb
  forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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 <- forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sym)
  ProgramLoc
pc <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
  let v :: AbstractValue tp
v = 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 forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue App (Expr t) tp
a
  forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (forall (e :: BaseType -> Type) (tp :: BaseType). App e tp -> Bool
isNonLinearApp App (Expr t) tp
a) forall a b. (a -> b) -> a -> b
$
    forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef Integer
sbNonLinearOps ExprBuilder t st fs
sym) (\Integer
n -> (Integer
nforall a. Num a => a -> a -> a
+Integer
1,()))
  case 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 -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
    BaseTypeRepr tp
BaseIntegerRepr | Just Integer
c <- forall tp. ValueRange tp -> Maybe tp
asSingleRange AbstractValue tp
v -> forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
c
    BaseTypeRepr tp
BaseRealRepr | Just Rational
c <- forall tp. ValueRange tp -> Maybe tp
asSingleRange (RealAbstractValue -> ValueRange Rational
ravRange AbstractValue tp
v) -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
c
    BaseBVRepr NatRepr w
w | Just Integer
x <- forall (w :: Natural). BVDomain w -> Maybe Integer
BVD.asSingleton AbstractValue tp
v -> 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 (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
x)
    BaseTypeRepr 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 forall a. Eq a => a -> a -> Bool
== SolverSymbol
emptySymbol = forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
  | Bool
otherwise =
    forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings ExprBuilder t st fs
sym) forall a b. (a -> b) -> a -> b
$ (\SymbolVarBimap t
x -> SymbolBinding t
v seq :: forall a b. a -> b -> b
`seq` (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) = forall t. Bimap SolverSymbol (SymbolBinding t) -> SymbolVarBimap t
SymbolVarBimap (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  <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sym
  ProgramLoc
pc <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
  forall (m :: Type -> Type) a. Monad m => a -> m a
return 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 = forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce (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 = forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce (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 = 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 = 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 (forall a. a -> Maybe a
Just (Integer -> ConcreteVal BaseIntegerType
ConcreteInteger Integer
0))
  where sty :: OptionStyle BaseIntegerType
sty = Bound Integer -> OptionStyle BaseIntegerType
CFG.integerWithMinOptSty (forall r. r -> Bound r
CFG.Inclusive Integer
0)
        help :: Maybe (Doc Void)
help = forall a. a -> Maybe a
Just Doc Void
"Maximum number of values in unary bitvector encoding."



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 <- forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage NonceGenerator IO t
gen

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

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

  -- Set up configuration options
  Config
cfg <- Integer -> [ConfigDesc] -> IO Config
CFG.initialConfig Integer
0
           [ ConfigDesc
unaryThresholdDesc
           , ConfigDesc
cacheStartSizeDesc
           ]
  OptionSetting BaseIntegerType
unarySetting       <- forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
unaryThresholdOption Config
cfg
  OptionSetting BaseIntegerType
cacheStartSetting  <- forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
cacheStartSizeOption Config
cfg
  [ConfigDesc] -> Config -> IO ()
CFG.extendConfig [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 <- forall a. a -> IO (IORef a)
newIORef Integer
0

  forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SB { sbTrue :: BoolExpr t
sbTrue  = forall {t}. Expr t 'BaseBoolType
t
               , sbFalse :: BoolExpr t
sbFalse = forall {t}. Expr t 'BaseBoolType
f
               , sbZero :: RealExpr t
sbZero = 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
               , 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 = forall a. IORef a -> IO a
readIORef (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 <- forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)
  forall a. IORef a -> a -> IO ()
atomicWriteIORef (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 <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize ExprBuilder t st fs
sb)
  ExprAllocator t
s <- forall t. NonceGenerator IO t -> Int -> IO (ExprAllocator t)
newCachedStorage (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb) (forall a. Num a => Integer -> a
fromInteger Integer
sz)
  forall a. IORef a -> a -> IO ()
atomicWriteIORef (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 = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth BVExpr t w
x
  case (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV BVExpr t w
x, 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 forall a. Eq a => a -> a -> Bool
/= forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
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 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))
_ -> 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 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 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)
traverseFC 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 forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e tp
x of
            BaseTypeRepr tp
BaseIntegerRepr  -> Integer -> IndexLit BaseIntegerType
IntIndexLit forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger e tp
x
            BaseBVRepr NatRepr w
w -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> IndexLit ('BaseBVType w)
BVIndexLit NatRepr w
w forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV e tp
x
            BaseTypeRepr 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 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)
traverseFC forall (tp :: BaseType). IndexLit tp -> IO (SymExpr sym tp)
f
  where f :: IndexLit tp -> IO (SymExpr sym tp)
        f :: forall (tp :: BaseType). IndexLit tp -> IO (SymExpr sym tp)
f (IntIndexLit Integer
n)  = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym Integer
n
        f (BVIndexLit NatRepr w
w BV w
i) = 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 forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args ret
f of
    UninterpFnInfo{} ->
      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 forall a b. (a -> b) -> a -> b
$! 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
      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
      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 (Expr t) args ret
fn_id ExprBuilder t st fs
sym 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 forall a. Eq a => a -> a -> Bool
== e
y then
    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 = forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t tp
v
  Maybe (Expr t tp)
mr <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ 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
      forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Expr t tp
r forall a. Eq a => a -> a -> Bool
/= Expr t tp
e) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail 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.
      forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ 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 = forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t idx ret
f
  case 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' <- 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 (forall t.
EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable EvalHashTables t
tbl) Nonce t (idx ::> ret)
n forall a b. (a -> b) -> a -> b
$
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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
      forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
changed, ExprSymFn t a r
f')
    DefinedFnInfo Assignment (ExprBoundVar t) idx
vars Expr t ret
e UnfoldPolicy
evalFn -> do
      let nm :: SolverSymbol
nm = 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' <-
        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 (forall t.
EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable EvalHashTables t
tbl) Nonce t (idx ::> ret)
n forall a b. (a -> b) -> a -> b
$ do
          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_ (forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbl)) Assignment (ExprBoundVar t) idx
vars
          Expr t ret
e' <- 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 forall a. Eq a => a -> a -> Bool
== Expr t ret
e' then
            forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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
            forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
True forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment (BoundVar sym) args
-> SymExpr sym ret
-> UnfoldPolicy
-> IO (SymFn sym args ret)
definedFn ExprBuilder t st fs
sym SolverSymbol
nm Assignment (ExprBoundVar t) idx
vars Expr t ret
e' UnfoldPolicy
evalFn
      forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
changed, ExprSymFn t a r
f')
    MatlabSolverFnInfo{} -> 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{} -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    StringExpr{} -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    BoolExpr{} -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    FloatExpr{} -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    AppExpr AppExpr t ret
ae -> 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 (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 forall a b. (a -> b) -> a -> b
$ do
      let a :: App (Expr t) ret
a = forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t ret
ae
      App (Expr t) ret
a' <- 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 (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 forall a. Eq a => a -> a -> Bool
== App (Expr t) ret
a' then
        forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
       else
        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 forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary App (Expr t) ret
a'
    NonceAppExpr NonceAppExpr t ret
ae -> 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 (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 forall a b. (a -> b) -> a -> b
$ do
      case 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' <- 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 forall a. Eq a => a -> a -> Bool
== Expr t ret
a' then
            forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
          else
            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 forall a b. (a -> b) -> a -> b
$ 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
          forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (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.
          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 (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 (forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
forallPred ExprBuilder t st fs
sym ExprBoundVar t tp1
v)
        Exists ExprBoundVar t tp1
v Expr t 'BaseBoolType
e -> do
          forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (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.
          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 (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 (forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
existsPred ExprBuilder t st fs
sym ExprBoundVar t tp1
v)
        ArrayFromFn ExprSymFn t (idx ::> itp) ret
f -> do
          (Bool
changed, ExprSymFn t (idx ::> itp) ret
f') <- 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
            forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            forall sym (idx :: Ctx BaseType) (itp :: BaseType)
       (ret :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (idx ::> itp) ret
-> IO (SymArray sym (idx ::> itp) ret)
arrayFromFn ExprBuilder t st fs
sym 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') <- 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) =
                forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
ArrayResultWrapper forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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)
traverseFC forall (idx :: Ctx BaseType) (itp :: BaseType) (utp :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) utp
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
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 forall a. Eq a => a -> a -> Bool
== Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args' then
            forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            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)
arrayMap ExprBuilder t st fs
sym ExprSymFn t (ctx ::> d) r
f' 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') <- 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' <- 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 forall a. Eq a => a -> a -> Bool
== Expr t (BaseArrayType (idx ::> itp) 'BaseBoolType)
a' then
            forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            forall sym (idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (idx ::> itp) 'BaseBoolType
-> SymArray sym (idx ::> itp) 'BaseBoolType
-> IO (Pred sym)
arrayTrueOnEntries ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) 'BaseBoolType
f' 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') <- 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 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)
traverseFC (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 forall a. Eq a => a -> a -> Bool
== Assignment (Expr t) args
a' then
            forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t st fs
sym ExprSymFn t args ret
f' Assignment (Expr t) args
a'

    BoundVarExpr{} -> 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 (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 forall a b. (a -> b) -> a -> b
$ 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 = forall {k} (f :: k -> Type) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size Assignment key args
keys
  HashTable s key val
tbl <- forall {k1} s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized (forall {k} (ctx :: Ctx k). Size ctx -> Int
Ctx.sizeInt Size args
sz)
  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 a b. (a -> b) -> a -> b
$ \Index args tp
i -> do
    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 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 forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index args tp
i)
  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 <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ 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 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
fmapFC forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr Assignment (ExprBoundVar t) args
vars) Assignment (Expr t) args
exprs
  HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl  <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ 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
                            }
  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

-- | 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) <- 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 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) (i ::> itp) tp1
entry_map of
        Just Expr t tp1
v -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t tp1
v
        Maybe (Expr t tp1)
Nothing -> 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) tp1)
def Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
    -- Evaluate function arrays on ground values.
  | Just (ArrayFromFn ExprSymFn t (idx ::> itp) ret
f) <- forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      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) ret
f Assignment (Expr t) (d ::> tp)
idx

    -- Lookups on constant arrays just return value
  | Just (ConstantArray Assignment BaseTypeRepr (i ::> tp1)
_ BaseTypeRepr b
_ Expr t b
v) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      forall (m :: Type -> Type) a. Monad m => a -> m a
return 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) <- 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 <- 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 Expr t tp
idx0 Expr t tp
update_idx0
    Expr t 'BaseBoolType
is_diff_zero <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t ('BaseBVType w)
diff forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType w)
diff) (forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType w)
diff))
    case forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
is_diff_zero of
      Just Bool
True -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t b
v
      Just Bool
False -> 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) b)
arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
      Maybe Bool
_ -> do
        (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
sliced_idx) <- 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
        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 (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 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) <- 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 <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
dest_begin_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned
  , Integer
lookup_idx_unsigned forall a. Ord a => a -> a -> Bool
< Integer
dest_end_idx_unsigned = do
    Expr t (BaseBVType w)
new_lookup_idx <- 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 Expr t (BaseBVType w)
src_begin_idx forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
      (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 forall a b. (a -> b) -> a -> b
$ forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w forall a b. (a -> b) -> a -> b
$ Integer
lookup_idx_unsigned forall a. Num a => a -> a -> a
- Integer
dest_begin_idx_unsigned)
    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)
arrayLookup ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr forall a b. (a -> b) -> a -> b
$ 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) <- 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 <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
dest_begin_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Ord a => a -> a -> Bool
< Integer
dest_begin_idx_unsigned =
    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)) a)
dest_arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
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) <- 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 <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
dest_end_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned =
    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)) a)
dest_arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
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) <- 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 <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
begin_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned
  , Integer
lookup_idx_unsigned forall a. Ord a => a -> a -> Bool
< Integer
end_idx_unsigned =
    forall (m :: Type -> Type) a. Monad m => a -> m a
return 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) <- 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 <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
begin_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Ord a => a -> a -> Bool
< Integer
begin_idx_unsigned =
    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)) a)
arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
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) <- 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 <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
  , Just Integer
end_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned =
    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)) a)
arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx

  | Just (MapOverArrays ExprSymFn t (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- 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 = 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 (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
      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) r
f forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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)
traverseFC forall (utp :: BaseType).
ArrayResultWrapper (Expr t) (d ::> tp) utp -> IO (Expr t utp)
eval Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args
    -- Create select index.
  | Bool
otherwise = do
    case 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) <- 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
        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 (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 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 =
    case 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 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) (i ::> itp) tp1
entry_map of
          Just Expr t tp1
val -> do
            Expr t ('BaseArrayType (i ::> itp) tp1)
arr_base <- 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 <- 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)
arrayUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (i ::> itp) tp1)
arr_base Assignment (Expr t) (d ::> tp)
lookup_idx Expr t tp1
val
            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 -> 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 (i ::> itp) tp1)
arr Assignment (Expr t) (d ::> tp)
lookup_idx
      Maybe (Assignment IndexLit (d ::> tp))
Nothing ->
        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) <- 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 <- 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)
dest_begin_idx (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 <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUlt ExprBuilder t st fs
sym (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 (BaseBVType w)
dest_end_idx
    case (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
p0, 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 <- 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 Expr t (BaseBVType w)
src_begin_idx forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          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 (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 (BaseBVType w)
dest_begin_idx
        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)
src_arr forall a b. (a -> b) -> a -> b
$ 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
_) ->
        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)
lookup_idx
      (Maybe Bool
_, Just Bool
False) ->
        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)
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) <- 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)
lookup_idx
        Expr t (BaseBVType w)
sliced_dest_begin_idx <- 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 Expr t (BaseBVType w)
dest_begin_idx forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          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 (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) (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 <- 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 Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_dest_arr Expr t (BaseBVType w)
sliced_dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr Expr t (BaseBVType w)
src_begin_idx Expr t (BaseBVType w)
len
        forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, 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) <- 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 <- 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)
begin_idx (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 <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUlt ExprBuilder t st fs
sym (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 (BaseBVType w)
end_idx
    case (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
p0, 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 <- 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 <- 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)
arrayUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr_base Assignment (Expr t) (d ::> tp)
lookup_idx Expr t a
val
        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
_) ->
        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)
lookup_idx
      (Maybe Bool
_, Just Bool
False) ->
        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)
lookup_idx
      (Maybe Bool, Maybe Bool)
_ -> do
        (Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_arr, Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_idx) <- 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)
lookup_idx
        Expr t (BaseBVType w)
sliced_begin_idx <- 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 Expr t (BaseBVType w)
begin_idx forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
          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 (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) (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' <- 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 Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_arr Expr t (BaseBVType w)
sliced_begin_idx Expr t a
val Expr t (BaseBVType w)
len
        forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr', 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) <- 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') <- 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') <- 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 <- forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
p Expr t (BaseArrayType (d ::> tp) range)
x' Expr t (BaseArrayType (d ::> tp) range)
y'
      Assignment (Expr t) (d ::> tp)
sliced_idx <- 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 (forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
p) Assignment (Expr t) (d ::> tp)
i' Assignment (Expr t) (d ::> tp)
j'
      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 = 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 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
_) -> 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 ::> tp1) b)
arr
  Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
_ Expr t ('BaseArrayType (i ::> itp) tp1)
arr) -> 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
  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)
_) -> 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
  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)
_) -> 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
  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' <- 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' <- 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
    forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
p Expr t (BaseArrayType (d ::> tp) range)
x' Expr t (BaseArrayType (d ::> tp) range)
y'
  Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
_ -> 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 = 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 = 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 = 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 forall (f :: BaseType -> Type). BoolMap f -> BoolMapView f
BM.viewBoolMap BoolMap (Expr t)
bm of
    BoolMapView (Expr t)
BoolMapUnit     -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
    BoolMapView (Expr t)
BoolMapDualUnit -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 -> forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
x
        Polarity
Negative -> forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym BoolExpr t
x
    BoolMapView (Expr 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 forall a b. (a -> b) -> a -> b
$ 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 <-  forall (p :: BaseType -> Type) (w :: Natural).
IsExpr p =>
UnaryBV (p 'BaseBoolType) w -> Maybe Integer
UnaryBV.asConstant UnaryBV (BoolExpr t) w
u = 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 (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
v)
  | Bool
otherwise = 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 (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 = 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BVExpr t n
e = forall a. a -> Maybe a
Just UnaryBV (Expr t 'BaseBoolType) n
u
  | ?unaryThreshold::Int
?unaryThreshold forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. Maybe a
Nothing
  | SemiRingLiteral (SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
w) Coefficient sr
v ProgramLoc
_ <- BVExpr t n
e = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall sym (n :: Natural).
IsExprBuilder sym =>
sym -> NatRepr n -> Integer -> UnaryBV (Pred sym) n
UnaryBV.constant ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). BV w -> Integer
BV.asUnsigned Coefficient sr
v)
  | Bool
otherwise = 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 forall p (n :: Natural). UnaryBV p n -> Int
UnaryBV.size UnaryBV (BoolExpr t) w
u forall a. Ord a => a -> a -> Bool
< ?unaryThreshold::Int
?unaryThreshold then
       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
  | forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Bool
WSum.nullProd SemiRingProduct (Expr t) sr
pd = 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 (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd) (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.one (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd))
  | Just Expr t (SemiRingBase sr)
v <- forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Maybe (f (SemiRingBase sr))
WSum.asProdVar SemiRingProduct (Expr t) sr
pd = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
v
  | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ 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 <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) sr
s = 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 (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 <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (f (SemiRingBase sr))
WSum.asVar WeightedSum (Expr t) sr
s      = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
r
    | Bool
otherwise                   = 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 = 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 forall a b. (a -> b) -> a -> b
$ 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
  | forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr) Coefficient sr
c = 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 (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
  | forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.one SemiRingRepr sr
sr)  Coefficient sr
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x
  | Just Coefficient sr
r <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x =
    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 (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 <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x =
    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 (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 =
    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 (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  <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x
  | Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
y

    -- reduce negations
  | Just (NotPred Expr t 'BaseBoolType
c') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
c
  = 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 forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = 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') <- 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 (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) (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 (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 <- 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 <- 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 forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
xr forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
yr
    Expr t (SemiRingBase sr)
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 (forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e 'BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (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)
    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 forall a b. (a -> b) -> a -> b
$! 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 forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
x forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
y in
      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 (forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e 'BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (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  <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t bt
x
  | Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t bt
y

    -- reduce negations
  | Just (NotPred Expr t 'BaseBoolType
c') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
c
  = 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 forall a. Eq a => a -> a -> Bool
== Expr t bt
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t bt
x

  | Bool
otherwise =
      let sz :: Integer
sz = Integer
1 forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t bt
x forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t bt
y in
      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 (forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e 'BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (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 forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return (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 <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x
    , forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
    , Just (SemiRingProd SemiRingProduct (Expr t) sr
pd) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
y
    , Just sr :~: sr
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality SemiRingRepr sr
sr (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd)
    = 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

      -- Another strength reduction
    | Just Coefficient sr
c <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y
    , forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
    , Just (SemiRingProd SemiRingProduct (Expr t) sr
pd) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
x
    , Just sr :~: sr
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality SemiRingRepr sr
sr (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd)
    = 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

      -- 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
y
    = forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c 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)
a 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)
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) <- 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 <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality BaseTypeRepr (SemiRingBase sr)
tp (forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr)
    = forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c 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 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') <- 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 (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) (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 (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 <- 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 <- 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 = 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 forall a b. (a -> b) -> a -> b
$ 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 = 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 forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return (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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
y
  = forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c 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)
a 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)
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) <- 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
  = forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c 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 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') <- 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 (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) (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 (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr sr
sr WeightedSum (Expr t) sr
z) =
    case (forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) sr
x', 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) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (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 <- 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 <- 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'
              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 forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) (forall a. Ord a => a -> a -> a
min Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr) (forall a. Ord a => a -> a -> a
max Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr)

  | Bool
otherwise =
    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 forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) (forall a. Ord a => a -> a -> a
min Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y) (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 (forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x, 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
_) | forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
y
      (SemiRingView t sr
_, SR_Constant Coefficient sr
c) | forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr) -> 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) ->
        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 (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) ->
        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 (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) ->
        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 (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) <- 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 <- 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 <- 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
            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 ->
            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 (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
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) <- 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 <- 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 <- 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
            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 ->
            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 (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
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) -> 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 (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
_)         -> 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 (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)        -> 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 (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)
_                      -> 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 (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 (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 (forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x, 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
_) -> 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) -> 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 (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 <- 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 forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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  <- 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
         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 (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 <- 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 forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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  <- 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
         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) -> 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 (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
_)          -> 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 (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul SemiRingProduct (Expr t) sr
px (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)          -> 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 (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul (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)
_                        -> 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 (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul (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) (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 = forall (sr :: SemiRing). OrderedSemiRingRepr sr -> SemiRingRepr sr
SR.orderedSemiRing OrderedSemiRingRepr sr
osr
     Expr t (SemiRingBase sr)
zero <- 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 (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
     forall a b. (a, b) -> a
fst forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (sr :: SemiRing). OrderedSemiRingRepr sr -> SemiRingRepr sr
SR.orderedSemiRing OrderedSemiRingRepr sr
osr
     Expr t (SemiRingBase sr)
zero <- 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 (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
     forall a b. (a, b) -> b
snd forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 =
   forall a. a -> Maybe a -> a
fromMaybe (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym, forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = (,) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary (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
                forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> 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 forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary (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 <- forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
nn1 Expr t 'BaseBoolType
nn2 forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
np1 Expr t 'BaseBoolType
np2)
      Expr t 'BaseBoolType
np <- forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
nn1 Expr t 'BaseBoolType
np2 forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
np1 Expr t 'BaseBoolType
nn2)
      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 ::> 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType i tp)
x = 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 ::> itp) tp1
m Expr t ('BaseArrayType (i ::> itp) tp1)
c
  | Bool
otherwise = forall (i :: Ctx BaseType) (f :: BaseType -> Type)
       (tp :: BaseType).
ArrayUpdateMap f i tp
-> f (BaseArrayType i tp) -> ArrayMapView i f tp
ArrayMapView 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) i tp
x) = forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
ArrayResultWrapper 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 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
foldlFC' forall (tp :: BaseType).
Set (Assignment IndexLit i)
-> ArrayResultWrapper (Expr t) i tp -> Set (Assignment IndexLit i)
f 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 (tp :: BaseType).
Set (Assignment IndexLit i)
-> ArrayResultWrapper (Expr t) i tp -> 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)
_) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult  ArrayResultWrapper (Expr t) i tp
e) =
            forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Assignment IndexLit i)
s (forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp -> Set (Assignment IndexLit ctx)
AUM.keysSet 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 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)
traverseFC forall t (tp :: BaseType). Expr t tp -> Maybe (IntLit tp)
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
_) = forall a. a -> Maybe a
Just (forall (tp :: BaseType).
(tp ~ BaseIntegerType) =>
Integer -> IntLit tp
IntLit Coefficient sr
n)
        f Expr t 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 forall a. Ord a => a -> a -> Bool
<= Integer
0 = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure r
r
  | Bool
otherwise =
      do r
r' <- forall r. (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM r -> Integer -> IO r
f r
r (Integer
nforall 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 forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty
    Assignment IntLit ctx
bnds Ctx.:> IntLit Integer
b -> 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 (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
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 = forall r. (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM (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 <- 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 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' <- forall (f :: BaseType -> Type).
OrdF f =>
BoolMap f -> f 'BaseBoolType -> Maybe Polarity
BM.contains BoolMap (Expr t)
bm BoolExpr t
x, Polarity
p forall a. Eq a => a -> a -> Bool
== Polarity
p' = Bool
True
checkAbsorption BoolMap (Expr t)
bm ((BoolExpr t, Polarity)
_:[(BoolExpr t, Polarity)]
xs) = 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 (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (NotPred (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as)))) (forall t.
Expr t 'BaseBoolType -> [(Expr t 'BaseBoolType, Polarity)]
asConjunction -> [(BoolExpr t, Polarity)]
bs)
  = forall t. BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
checkAbsorption (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 (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as)) (forall t.
Expr t 'BaseBoolType -> [(Expr t 'BaseBoolType, Polarity)]
asDisjunction -> [(BoolExpr t, Polarity)]
bs)
  = 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 = 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 = forall a. IORef a -> a -> IO ()
atomicWriteIORef (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 = forall a. IORef a -> IO a
readIORef (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 =
    forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger ExprBuilder t st fs
sb) forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (SolverEvent -> IO ())
Nothing -> 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 <- forall (m :: Type -> Type) s. NonceGenerator m s -> m Integer
countNoncesGenerated (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)
    Integer
nonLinearOps <- forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef Integer
sbNonLinearOps ExprBuilder t st fs
sb)
    forall (m :: Type -> Type) a. Monad m => a -> m a
return 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
      NonceAppExpr (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp -> Annotation BaseTypeRepr tp
_ Nonce t tp
n Expr t tp
_) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (Nonce t tp
n, SymExpr (ExprBuilder t st fs) tp
e)
      SymExpr (ExprBuilder t st fs) tp
_ -> do
        let tpr :: BaseTypeRepr tp
tpr = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) tp
e
        Nonce t tp
n <- 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' <- 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 (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
e)
        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
      NonceAppExpr (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp -> Annotation BaseTypeRepr tp
_ Nonce t tp
n Expr t tp
_) -> forall a. a -> Maybe a
Just Nonce t tp
n
      SymExpr (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 (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp -> Annotation BaseTypeRepr tp
_ Nonce t tp
_ Expr t tp
x) -> forall a. a -> Maybe a
Just Expr t tp
x
      SymExpr (ExprBuilder t st fs) tp
_ -> forall a. Maybe a
Nothing

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

  getCurrentProgramLoc :: ExprBuilder t st fs -> IO ProgramLoc
getCurrentProgramLoc = 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 = forall a. IORef a -> a -> IO ()
atomicWriteIORef (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  = forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> BoolExpr t
sbTrue
  falsePred :: ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
falsePred = 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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! Bool -> Bool
not Bool
b)

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

    | Bool
otherwise
    = 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 (forall (e :: BaseType -> Type).
e 'BaseBoolType -> App e 'BaseBoolType
NotPred Pred (ExprBuilder t st fs)
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)
x forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
y
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)

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

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

    | Bool
otherwise
    = case (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x, forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y) of
        (Just Bool
False, Maybe Bool
_)    -> 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
_)     -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
        (Maybe Bool
_, Just Bool
False)    -> 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)     -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
        (Maybe Bool, Maybe Bool)
_ -> 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 forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq BaseTypeRepr 'BaseBoolType
BaseBoolRepr (forall a. Ord a => a -> a -> a
min Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y) (forall a. Ord a => a -> a -> a
max Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
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 = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x, forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y) of
      (Just Bool
True, Maybe Bool
_)  -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
      (Just Bool
False, Maybe Bool
_) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
      (Maybe Bool
_, Just Bool
True)  -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
      (Maybe Bool
_, Just Bool
False) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
      (Maybe Bool, Maybe Bool)
_ | Pred (ExprBuilder t st fs)
x forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
y -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x -- and is idempotent
        | Bool
otherwise -> Expr t 'BaseBoolType
-> Expr t 'BaseBoolType -> IO (Expr t 'BaseBoolType)
go Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y

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

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

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

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

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

     | Bool
otherwise
     = forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
[(f 'BaseBoolType, Polarity)] -> BoolMap f
BM.fromVars [forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asPosAtom Expr t 'BaseBoolType
a, forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asPosAtom Expr t 'BaseBoolType
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 (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x, forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y) of
      (Just Bool
True, Maybe Bool
_)  -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
      (Just Bool
False, Maybe Bool
_) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
      (Maybe Bool
_, Just Bool
True)  -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
      (Maybe Bool
_, Just Bool
False) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
      (Maybe Bool, Maybe Bool)
_ | Pred (ExprBuilder t st fs)
x forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
y -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x -- or is idempotent
        | Bool
otherwise -> Expr t 'BaseBoolType
-> Expr t 'BaseBoolType -> IO (Expr t 'BaseBoolType)
go Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y

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

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

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

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

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

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

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

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

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

      -- ite c 1 y = c || y
    | Just Bool
True  <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x = 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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
y forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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  <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
x forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y = 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 forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Pred (ExprBuilder t st fs)
x forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Pred (ExprBuilder t st fs)
y in
        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 forall a b. (a -> b) -> a -> b
$ 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)
c Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y

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

  intLit :: ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
intLit ExprBuilder t st fs
sym Integer
n = 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
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 = 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)
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 = 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)
x SymInteger (ExprBuilder t st fs)
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 = 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)
x SymInteger (ExprBuilder t st fs)
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 = 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)
c SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
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 <- forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckEq (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
y)
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
    , Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
y
    = let wx :: NatRepr w
wx = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
          wy :: NatRepr w
wy = 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 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' <- 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 Expr t (BaseBVType w)
xbv
              forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
ybv
            NatCases w w
NatCaseEQ ->
              forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
ybv
            NatCaseGT LeqProof (w + 1) w
LeqProof -> do
              Expr t (BaseBVType w)
y' <- 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 Expr t (BaseBVType w)
ybv
              forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
y'

      -- Reduce to bitvector equality, when possible
    | Just (BVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
    , Just (BVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
y
    = let wx :: NatRepr w
wx = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
          wy :: NatRepr w
wy = 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 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' <- 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 Expr t (BaseBVType w)
xbv
              forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
ybv
            NatCases w w
NatCaseEQ ->
              forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
ybv
            NatCaseGT LeqProof (w + 1) w
LeqProof -> do
              Expr t (BaseBVType w)
y' <- 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 Expr t (BaseBVType w)
ybv
              forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
y'

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

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

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

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

    | Bool
otherwise = 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 (forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym) SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
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 <- forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckLe (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
y)
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
    , Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
y
    = do let wx :: NatRepr w
wx = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
         let wy :: NatRepr w
wy = 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 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' <- 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 Expr t (BaseBVType w)
xbv
             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)
x' Expr t (BaseBVType w)
ybv
           NatCases w w
NatCaseEQ -> 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)
xbv Expr t (BaseBVType w)
ybv
           NatCaseGT LeqProof (w + 1) w
LeqProof -> do
             Expr t (BaseBVType w)
y' <- 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 Expr t (BaseBVType w)
ybv
             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)
xbv Expr t (BaseBVType w)
y'

      -- Check with two bitvectors.
    | Just (BVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
    , Just (BVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
y
    = do let wx :: NatRepr w
wx = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
         let wy :: NatRepr w
wy = 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 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' <- 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 Expr t (BaseBVType w)
xbv
             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)
x' Expr t (BaseBVType w)
ybv
           NatCases w w
NatCaseEQ -> 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)
xbv Expr t (BaseBVType w)
ybv
           NatCaseGT LeqProof (w + 1) w
LeqProof -> do
             Expr t (BaseBVType w)
y' <- 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 Expr t (BaseBVType w)
ybv
             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)
xbv Expr t (BaseBVType w)
y'

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

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

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

    | Just Coefficient SemiRingInteger
xi <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
x
    , Just (BVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
    = let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv in
      if | Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
< forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
         | Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
> forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
         | Bool
otherwise -> forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient SemiRingInteger
xi) forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> 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
    = 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 (forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe ExprBuilder t st fs
sym) SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
x = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall a. Num a => a -> a
abs Integer
i)
    | Just Bool
True <- forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckLe (forall tp. tp -> ValueRange tp
SingleRange Integer
0) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
x) = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymInteger (ExprBuilder t st fs)
x
    | Just Bool
True <- forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckLe (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
x) (forall tp. tp -> ValueRange tp
SingleRange Integer
0) = forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> IO (SymInteger sym)
intNeg ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x
    | Bool
otherwise = 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 (forall (e :: BaseType -> Type).
e BaseIntegerType -> App e BaseIntegerType
IntAbs SymInteger (ExprBuilder t st fs)
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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymInteger (ExprBuilder t st fs)
x
      -- As integers.
    | Just Integer
xi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
x, Just Integer
yi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y, Integer
yi forall a. Eq a => a -> a -> Bool
/= Integer
0 =
      if Integer
yi forall a. Ord a => a -> a -> Bool
>= Integer
0 then
        forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
xi forall a. Integral a => a -> a -> a
`div` Integer
yi)
      else
        forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall a. Num a => a -> a
negate (Integer
xi forall a. Integral a => a -> a -> a
`div` forall a. Num a => a -> a
negate Integer
yi))
      -- Return int div
    | Bool
otherwise =
        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 (forall (e :: BaseType -> Type).
e BaseIntegerType -> e BaseIntegerType -> App e BaseIntegerType
IntDiv SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
0
      -- As integers.
    | Just Integer
xi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
x, Just Integer
yi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y, Integer
yi forall a. Eq a => a -> a -> Bool
/= Integer
0 =
        forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
xi forall a. Integral a => a -> a -> a
`mod` forall a. Num a => a -> a
abs Integer
yi)
    | Just (SemiRingSum WeightedSum (Expr t) sr
xsum) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
    , SemiRingRepr sr
SR.SemiRingIntegerRepr <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
xsum
    , Just Integer
yi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y
    , Integer
yi forall a. Eq a => a -> a -> Bool
/= Integer
0 =
        case forall (f :: BaseType -> Type).
Tm f =>
WeightedSum f SemiRingInteger
-> Integer -> WeightedSum f SemiRingInteger
WSum.reduceIntSumMod WeightedSum (Expr t) sr
xsum (forall a. Num a => a -> a
abs Integer
yi) of
          WeightedSum (Expr t) SemiRingInteger
xsum' | Just Coefficient SemiRingInteger
xi <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) SemiRingInteger
xsum' ->
                    forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Coefficient SemiRingInteger
xi
                | Bool
otherwise ->
                    do IntegerExpr t
x' <- 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'
                       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 (forall (e :: BaseType -> Type).
e BaseIntegerType -> e BaseIntegerType -> App e BaseIntegerType
IntMod IntegerExpr t
x' SymInteger (ExprBuilder t st fs)
y)
      -- Return int mod.
    | Bool
otherwise =
        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 (forall (e :: BaseType -> Type).
e BaseIntegerType -> e BaseIntegerType -> App e BaseIntegerType
IntMod SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
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 forall a. Eq a => a -> a -> Bool
== Natural
0 = forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
0
    | Natural
k forall a. Eq a => a -> a -> Bool
== Natural
1 = forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
    | Just Integer
xi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Integer
xi forall a. Integral a => a -> a -> a
`mod` (forall a. Integral a => a -> Integer
toInteger Natural
k) forall a. Eq a => a -> a -> Bool
== Integer
0)
    | Just (SemiRingSum WeightedSum (Expr t) sr
xsum) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
    , SemiRingRepr sr
SR.SemiRingIntegerRepr <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
xsum =
        case forall (f :: BaseType -> Type).
Tm f =>
WeightedSum f SemiRingInteger
-> Integer -> WeightedSum f SemiRingInteger
WSum.reduceIntSumMod WeightedSum (Expr t) sr
xsum (forall a. Integral a => a -> Integer
toInteger Natural
k) of
          WeightedSum (Expr t) SemiRingInteger
xsum' | Just Coefficient SemiRingInteger
xi <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) SemiRingInteger
xsum' ->
                    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Coefficient SemiRingInteger
xi forall a. Eq a => a -> a -> Bool
== Integer
0)
                | Bool
otherwise ->
                    do IntegerExpr t
x' <- 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'
                       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 (forall (e :: BaseType -> Type).
e BaseIntegerType -> Natural -> App e 'BaseBoolType
IntDivisible IntegerExpr t
x' Natural
k)
    | Bool
otherwise =
        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 (forall (e :: BaseType -> Type).
e BaseIntegerType -> Natural -> App e 'BaseBoolType
IntDivisible SymInteger (ExprBuilder t st fs)
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 =
    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 (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
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 (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) u
x, forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) 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' = forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y)
          LeqProof 1 (u + v)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (m :: Natural) (n :: Natural) (p :: Natural -> Type)
       (q :: Natural -> Type).
(1 <= m, 1 <= n) =>
p m -> q n -> LeqProof 1 (m + n)
leqAddPos (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y))
          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' (forall (w :: Natural) (w' :: Natural).
NatRepr w -> NatRepr w' -> BV w -> BV w' -> BV (w + w')
BV.concat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) v
y
        , Just BV u
_av <- 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 <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)))
                        (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a)) (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 <- forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (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 <- 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 Expr t (BaseBVType u)
a
            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 Expr t (BaseBVType (u + u))
xa 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x
        , Just (BVSelect NatRepr idx
idx2 NatRepr n
n2 Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) v
y
        , Just BaseBVType w :~: BaseBVType w
Refl <- 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 <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr idx
idx1 (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 <- forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (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 <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx2 (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr n
n1 NatRepr n
n2)) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
a) ->
            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 (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr n
n1 NatRepr n
n2) 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x
        , Just BV v
_bv <- 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 <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y)))
                        (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y))
        , Just LeqProof 1 (v + v)
LeqProof <- forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y)) -> do
            Expr t (BaseBVType (v + v))
by <- 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 Expr t (BaseBVType v)
b SymBV (ExprBuilder t st fs) v
y
            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 Expr t (BaseBVType u)
a 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 = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x
        let wy :: NatRepr v
wy = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y
        Just LeqProof 1 (u + v)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr u
wx NatRepr v
wy))
        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 forall a b. (a -> b) -> a -> b
$ 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 (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
x SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = do
      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 (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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , let idx2 :: NatRepr (idx + idx)
idx2 = 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 <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (idx + idx)
idx2 NatRepr n
n) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b) =
      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 Expr t (BaseBVType w)
b

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

    | Just (BVShl NatRepr w
w Expr t ('BaseBVType w)
a Expr t ('BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , Just BV w
diff <- 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 (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof x idx
LeqProof <- 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 <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (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
      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 (forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n Expr t ('BaseBVType w)
a

    | Just (BVShl NatRepr w
_w Expr t ('BaseBVType w)
_a Expr t ('BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , Just BV w
diff <- 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 (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof (idx + n) x
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) NatRepr x
diffRepr =
      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 (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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , Just BV w
diff <- 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 (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof ((idx + x) + n) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (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 =
      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 (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n Expr t ('BaseBVType w)
a

    | Just (BVLshr NatRepr w
w Expr t ('BaseBVType w)
a Expr t ('BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , Just BV w
diff <- 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 (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof ((idx + x) + n) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (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 =
      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 (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n Expr t ('BaseBVType w)
a

    | Just (BVLshr NatRepr w
w Expr t ('BaseBVType w)
_a Expr t ('BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , Just BV w
diff <- 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 (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
    , Just LeqProof w (idx + x)
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr w
w (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) =
      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 (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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x = do
      -- Add dynamic check
      Just LeqProof w r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (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 = forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr r
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 <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
      Just LeqProof 1 (w - w)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (r - w)
ext
      Expr t (BaseBVType (w - w))
zeros <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> IO (SymBV sym w)
minUnsignedBV ExprBuilder t st fs
sb NatRepr (r - w)
ext
      Expr t (BaseBVType (w - w))
ones  <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> IO (SymBV sym w)
maxUnsignedBV ExprBuilder t st fs
sb NatRepr (r - w)
ext
      Expr t 'BaseBoolType
c     <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNeg ExprBuilder t st fs
sb Expr t (BaseBVType w)
b
      Expr t (BaseBVType (w - w))
hi    <- 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 Expr t 'BaseBoolType
c Expr t (BaseBVType (w - w))
ones Expr t (BaseBVType (w - w))
zeros
      Expr t (BaseBVType ((w - w) + w))
x'    <- 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 Expr t (BaseBVType (w - w))
hi Expr t (BaseBVType w)
b
      -- Add dynamic check
      Just LeqProof (idx + n) ((w - w) + w)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (r - w)
ext (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b))
      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 Expr t (BaseBVType ((w - w) + w))
x'

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

      Just LeqProof 1 (n - (v - idx))
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (n - (v - idx))
n1
      Just LeqProof (n - (v - idx)) u
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr 0
z NatRepr (n - (v - idx))
n1) (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' <- 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 Expr t (BaseBVType u)
a

      Just LeqProof 1 (v - idx)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (v - idx)
n2
      Just LeqProof (idx + (v - idx)) v
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr (v - idx)
n2) (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' <- 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 Expr t (BaseBVType v)
b

      Just ((n - (v - idx)) + (v - idx)) :~: n
Refl <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (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
      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 Expr t (BaseBVType (n - (v - idx)))
a' 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVArithRepr NatRepr w
w <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s
    , Just idx :~: 0
Refl <- 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 :: NatRepr 0) =
      do let mask :: BV w
mask = case 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 -> forall (w :: Natural) (w' :: Natural).
((w + 1) <= w') =>
NatRepr w' -> BV w -> BV w'
BV.zext NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr n
n)
               Right n :~: w
Refl -> 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 forall (w :: Natural). BV w -> BV w -> BV w
`BV.and` BV w
mask forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w = forall (m :: Type -> Type) a w. Monad m => (a, w) -> WriterT w m a
writer (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w, Bool -> Any
Any Bool
True)
               | Bool
otherwise                    = 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) = forall w a. Writer w a -> (a, w)
runWriter forall a b. (a -> b) -> a -> b
$ 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)
reduce WeightedSum (Expr t) sr
s
         Expr t (BaseBVType w)
x' <- if Bool
changed then 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 (forall (e :: BaseType -> Type) (sr :: SemiRing).
WeightedSum e sr -> App e (SemiRingBase sr)
SemiRingSum WeightedSum (Expr t) sr
s') else forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
         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 forall a b. (a -> b) -> a -> b
$ 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 (Expr t 'BaseBoolType) n
u) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , Just idx :~: 0
Refl <- 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) =
      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 forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 (Expr t 'BaseBoolType) n
u NatRepr n
n

      -- if none of the above apply, produce a basic select term
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ 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
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 forall a. Ord a => a -> a -> Bool
< Natural
0 Bool -> Bool -> Bool
|| Natural
i forall a. Ord a => a -> a -> Bool
>= forall (n :: Natural). NatRepr n -> Natural
natValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
y) =
      forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Illegal bit index."

      -- Constant evaluation
    | Just BV w
yc <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
    , Natural
i forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (w :: Natural). Natural -> BV w -> Bool
BV.testBit' (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') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
    = if Natural
i forall a. Ord a => a -> a -> Bool
>= forall (n :: Natural). NatRepr n -> Natural
natValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y') then
        forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym
      else
        forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i Expr t (BaseBVType w)
y'

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

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

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

    | Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ Expr t 'BaseBoolType
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
    , forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (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 Expr t 'BaseBoolType
a' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i Expr t (BaseBVType w)
a
         Expr t 'BaseBoolType
b' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i Expr t (BaseBVType w)
b
         forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c Expr t 'BaseBoolType
a' Expr t 'BaseBoolType
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 = 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 forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
Natural -> e (BaseBVType w) -> App e 'BaseBoolType
BVTestBit Natural
i SymBV (ExprBuilder t st fs) 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  <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p = 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 (forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr w
w)
    | Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p = 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 (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w)
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ 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)
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 Expr t 'BaseBoolType
px) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , Just (BVFill NatRepr w
_w Expr t 'BaseBoolType
py) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y =
      do Expr t 'BaseBoolType
z <- 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 Expr t 'BaseBoolType
px Expr t 'BaseBoolType
py
         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 Expr t 'BaseBoolType
z

    | Just (BVZext NatRepr r
w  Expr t (BaseBVType w)
x') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , Just (BVZext NatRepr r
w' Expr t (BaseBVType w)
y') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
    , Just w :~: w
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
x') (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y')
    , Just r :~: r
Refl <- 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 <- 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 Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
y'
         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 Expr t (BaseBVType w)
z

    | Just (BVSext NatRepr r
w  Expr t (BaseBVType w)
x') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , Just (BVSext NatRepr r
w' Expr t (BaseBVType w)
y') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
    , Just w :~: w
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
x') (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y')
    , Just r :~: r
Refl <- 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 <- 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 Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
y'
         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 Expr t (BaseBVType w)
z

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

    | Bool
otherwise =
        do Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
           let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
           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 (Expr t 'BaseBoolType) w
ux <- 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
x
                 UnaryBV (Expr t 'BaseBoolType) w
uy <- 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
y
                 forall (m :: Type -> Type) a. Monad m => a -> m a
return (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 (Expr t 'BaseBoolType) w
ux UnaryBV (Expr t 'BaseBoolType) w
uy))
             (case forall t (w :: Natural).
Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (Some BVFlavorRepr)
inSameBVSemiRing SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y of
                Just (Some BVFlavorRepr x
flv) ->
                  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 (forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr x
flv (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)) Pred (ExprBuilder t st fs)
c SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
                Maybe (Some BVFlavorRepr)
Nothing ->
                  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)
c SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) 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
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym

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

    | Just Bool
b <- forall (w :: Natural). BVDomain w -> BVDomain w -> Maybe Bool
BVD.eq (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y) = do
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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
_ Expr t 'BaseBoolType
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
    , forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b) -- avoid loss of sharing
    = forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Expr t (BaseBVType w)
a forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> 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 Expr t (BaseBVType w)
b)

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

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

    | Bool
otherwise = do
        Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
        let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
        if | Just UnaryBV (Expr t 'BaseBoolType) w
ux <- 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
x
           , Just UnaryBV (Expr t 'BaseBoolType) w
uy <- 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
y
           -> 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 (Expr t 'BaseBoolType) w
ux UnaryBV (Expr t 'BaseBoolType) w
uy
           | Bool
otherwise
           -> 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 forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)) (forall a. Ord a => a -> a -> a
min SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y) (forall a. Ord a => a -> a -> a
max SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x
    , Just BV w
yc <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y =
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> BV w -> Bool
BV.slt (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xc BV w
yc)
    | Just Bool
b <- forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> Maybe Bool
BVD.slt (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y) =
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
    | SymBV (ExprBuilder t st fs) w
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)

    | Bool
otherwise = do
        Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
        let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
        if | Just UnaryBV (Expr t 'BaseBoolType) w
ux <- 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
x
           , Just UnaryBV (Expr t 'BaseBoolType) w
uy <- 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
y
           -> 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 (Expr t 'BaseBoolType) w
ux UnaryBV (Expr t 'BaseBoolType) w
uy
           | Bool
otherwise
           -> 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 forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> e (BaseBVType w) -> App e 'BaseBoolType
BVSlt SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x
    , Just BV w
yc <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y = do
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (w :: Natural). BV w -> BV w -> Bool
BV.ult BV w
xc BV w
yc)
    | Just Bool
b <- forall (w :: Natural).
(1 <= w) =>
BVDomain w -> BVDomain w -> Maybe Bool
BVD.ult (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y) =
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
    | SymBV (ExprBuilder t st fs) w
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y =
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym

    | Bool
otherwise = do
        Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
        let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
        if | Just UnaryBV (Expr t 'BaseBoolType) w
ux <- 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
x
           , Just UnaryBV (Expr t 'BaseBoolType) w
uy <- 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
y
           -> 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 (Expr t 'BaseBoolType) w
ux UnaryBV (Expr t 'BaseBoolType) w
uy

           | Bool
otherwise
           -> 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 forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> e (BaseBVType w) -> App e 'BaseBoolType
BVUlt SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) 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) <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
   = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymBV (ExprBuilder t st fs) w
x

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

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

   | Bool
otherwise
   = 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 forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVShl (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) 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) <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
   = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymBV (ExprBuilder t st fs) w
x

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

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

   | Bool
otherwise
   = 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 forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVLshr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) 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) <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
   = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymBV (ExprBuilder t st fs) 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) = forall (w :: Natural). BVDomain w -> (Integer, Integer)
BVD.ubounds (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y)
   , Integer
lo forall a. Ord a => a -> a -> Bool
>= forall (w :: Natural). NatRepr w -> Integer
intValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
   = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> Pred sym -> IO (SymBV sym w)
bvFill ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x, Just BV w
n <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
   = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall a b. (a -> b) -> a -> b
$ forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> Natural -> BV w
BV.ashr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n)

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

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

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

   | Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
   = do Expr t (BaseBVType w)
wbv <- 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 (forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
        Expr t (BaseBVType w)
n' <- 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 Expr t ('BaseBVType w)
n Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
y' <- 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 Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
z <- 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 Expr t (BaseBVType w)
n' Expr t (BaseBVType w)
y'
        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 Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z

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

   | Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
   = do Expr t (BaseBVType w)
wbv <- 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 (forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
        Expr t (BaseBVType w)
y' <- 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 Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
n' <- 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 Expr t ('BaseBVType w)
n Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
z <- 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 Expr t (BaseBVType w)
n' forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 Expr t (BaseBVType w)
wbv Expr t (BaseBVType w)
y'
        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 Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z

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

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

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

   | Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
   = do Expr t (BaseBVType w)
wbv <- 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 (forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
        Expr t (BaseBVType w)
n' <- 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 Expr t ('BaseBVType w)
n Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
y' <- 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 Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
z <- 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 Expr t (BaseBVType w)
n' Expr t (BaseBVType w)
y'
        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 Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z

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

   | Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
   = do Expr t (BaseBVType w)
wbv <- 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 (forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
        Expr t (BaseBVType w)
n' <- 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 Expr t ('BaseBVType w)
n Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
y' <- 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 Expr t (BaseBVType w)
wbv
        Expr t (BaseBVType w)
z <- 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 Expr t (BaseBVType w)
n' forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 Expr t (BaseBVType w)
wbv Expr t (BaseBVType w)
y'
        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 Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z

   | Bool
otherwise
   = let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x in
     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 forall a b. (a -> b) -> a -> b
$ 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
x SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) u
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
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 (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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof (w + 1) r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat (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 <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
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 forall a b. (a -> b) -> a -> b
$ 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 (Expr t 'BaseBoolType) n
u) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
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 forall a b. (a -> b) -> a -> b
$ forall (u :: Natural) (r :: Natural) p.
(1 <= u, (u + 1) <= r) =>
UnaryBV p u -> NatRepr r -> UnaryBV p r
UnaryBV.uext UnaryBV (Expr t 'BaseBoolType) n
u NatRepr r
w

    | Bool
otherwise = do
      Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
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 forall a b. (a -> b) -> a -> b
$ 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
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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) u
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
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 (forall (w :: Natural) (w' :: Natural).
(1 <= w, (w + 1) <= w') =>
NatRepr w -> NatRepr w' -> BV w -> BV w'
BV.sext (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) NatRepr r
w BV u
xv)

      -- Concatenate sign extension.
    | Just (BVSext NatRepr r
_ Expr t (BaseBVType w)
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof (w + 1) r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat (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 <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
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 (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 (Expr t 'BaseBoolType) n
u) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x = do
      -- Add dynamic check for GHC typechecker.
      Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
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 forall a b. (a -> b) -> a -> b
$ forall (u :: Natural) (r :: Natural) p.
(1 <= u, (u + 1) <= r) =>
UnaryBV p u -> NatRepr r -> UnaryBV p r
UnaryBV.sext UnaryBV (Expr t 'BaseBoolType) n
u NatRepr r
w

    | Bool
otherwise = do
      Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
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 (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
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
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x))  -- special case: x `xor` x = 0
    | Bool
otherwise
    = let sr :: SemiRingRepr ('SemiRingBV 'BVBits w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
       in 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
x SymBV (ExprBuilder t st fs) 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
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x -- Special case: idempotency of and

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

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

    | Bool
otherwise
    = let sr :: SemiRingRepr ('SemiRingBV 'BVBits w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
       in 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
x SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x
    = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall a b. (a -> b) -> a -> b
$ BV w
xv forall (w :: Natural). BV w -> BV w -> BV w
`BV.xor` (forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x))

    | Bool
otherwise
    = let sr :: SemiRingRepr ('SemiRingBV 'BVBits w)
sr = (forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x))
       in 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 forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr ('SemiRingBV 'BVBits w)
sr (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
x) (forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) 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 (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x, forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y) of
      (Just BV w
xv, Just BV w
yv) -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (BV w
xv forall (w :: Natural). BV w -> BV w -> BV w
`BV.or` BV w
yv)
      (Just BV w
xv , Maybe (BV w)
_)
        | BV w
xv forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
y
        | BV w
xv forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
      (Maybe (BV w)
_, Just BV w
yv)
        | BV w
yv forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
y) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
        | BV w
yv forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
y

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

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

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

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

        | Just (BVOrBits NatRepr w
w BVOrSet (Expr t) w
xs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
        -> 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 forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits NatRepr w
w forall a b. (a -> b) -> a -> b
$ 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
y BVOrSet (Expr t) w
xs

        | Just (BVOrBits NatRepr w
w BVOrSet (Expr t) w
ys) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
        -> 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 forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits NatRepr w
w forall a b. (a -> b) -> a -> b
$ 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
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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
        , Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
lo) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
        , Just Integer
ni <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
n
        , forall (w :: Natural). NatRepr w -> Integer
intValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) forall a. Eq a => a -> a -> Bool
== Integer
ni
        , Just LeqProof w w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (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' <- forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr w
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 <- 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)
w' -- dynamic check for GHC typechecker
        , Just LeqProof ((w - w) + 1) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat 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 <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
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 <- 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)
w' Expr t ('BaseBVType w)
x'
          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 Expr t (BaseBVType (w - w))
hi Expr t (BaseBVType w)
lo
        | Just (BVShl NatRepr w
w Expr t ('BaseBVType w)
y' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
        , Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
lo) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
        , Just Integer
ni <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
n
        , forall (w :: Natural). NatRepr w -> Integer
intValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) forall a. Eq a => a -> a -> Bool
== Integer
ni
        , Just LeqProof w w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (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' <- forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr w
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 <- 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)
w' -- dynamic check for GHC typechecker
        , Just LeqProof ((w - w) + 1) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat 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 <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
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 <- 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)
w' Expr t ('BaseBVType w)
y'
          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 Expr t (BaseBVType (w - w))
hi Expr t (BaseBVType w)
lo

        | Bool
otherwise
        -> 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 forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall a b. (a -> b) -> a -> b
$ 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
x forall a b. (a -> b) -> a -> b
$ 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
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 = 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
x SymBV (ExprBuilder t st fs) w
y
     where sr :: SemiRingRepr ('SemiRingBV 'BVArith w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) 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 = 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
x SymBV (ExprBuilder t st fs) w
y
     where sr :: SemiRingRepr ('SemiRingBV 'BVArith w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.negate (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv)
    | Bool
otherwise =
        do Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
           let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
           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 (Expr t 'BaseBoolType) w
ux <- 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
x
                 forall a. a -> Maybe a
Just (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 (Expr t 'BaseBoolType) w
ux))
             (do let sr :: SemiRingRepr ('SemiRingBV 'BVArith w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
                 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 (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (-Integer
1)) SymBV (ExprBuilder t st fs) 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
_ Expr t 'BaseBoolType
p Expr t (BaseBVType w)
t Expr t (BaseBVType w)
f) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
t) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (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  Expr t 'BaseBoolType
t' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType w)
t
          Expr t 'BaseBoolType
f' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType w)
f
          forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
p Expr t 'BaseBoolType
t' Expr t 'BaseBoolType
f'
    | Just (BVConcat NatRepr (u + v)
_ Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
    , forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType u)
a) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (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 Expr t 'BaseBoolType
pa <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType u)
a
          Expr t 'BaseBoolType
pb <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType v)
b
          forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
pa Expr t 'BaseBoolType
pb
    | Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
          forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType w)
y
    | Just (BVSext NatRepr r
_ Expr t (BaseBVType w)
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
          forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType w)
y
    | Just (BVFill NatRepr w
_ Expr t 'BaseBoolType
p) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
          forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t 'BaseBoolType
p
    | Just (BVUnaryTerm UnaryBV (Expr t 'BaseBoolType) n
ubv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
          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 -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Integer
iforall a. Eq a => a -> a -> Bool
/=Integer
0))
            (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym)
            UnaryBV (Expr t 'BaseBoolType) n
ubv
    | Bool
otherwise = do
          let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x
          Expr t (BaseBVType w)
zro <- 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 (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w)
          forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 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 = 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 (forall a b. a -> b -> a
const forall (w :: Natural). BV w -> BV w -> BV w
BV.uquot) 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 <- forall (w :: Natural).
(1 <= w) =>
BVDomain w -> BVDomain w -> Maybe Bool
BVD.ult (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y) = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
    | Bool
otherwise = 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 (forall a b. a -> b -> a
const forall (w :: Natural). BV w -> BV w -> BV w
BV.urem) 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
x SymBV (ExprBuilder t st fs) 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 = 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 forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> BV w -> BV w
BV.squot 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 = 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 forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> BV w -> BV w
BV.srem 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = 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 (forall (w :: Natural). BV w -> BV w
BV.popCount BV w
xv)
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ 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
x
   where w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = 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 (forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.ctz NatRepr w
w BV w
xv)
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ 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
x
   where w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = 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 (forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.clz NatRepr w
w BV w
xv)
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ 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
x
   where w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) 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
    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 forall a b. (a -> b) -> a -> b
$ forall (flds :: Ctx BaseType) (e :: BaseType -> Type).
Assignment BaseTypeRepr flds
-> Assignment e flds -> App e ('BaseStructType flds)
StructCtor (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
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr (ExprBuilder t st fs)) flds
args) Assignment (SymExpr (ExprBuilder t st fs)) 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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymStruct (ExprBuilder t st fs) flds
s = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Assignment (Expr t) flds
args forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index flds tp
i
    | Bool
otherwise = do
      case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymStruct (ExprBuilder t st fs) flds
s of
        BaseStructRepr Assignment BaseTypeRepr ctx
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 forall a b. (a -> b) -> a -> b
$ 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
s Index flds tp
i (Assignment BaseTypeRepr ctx
flds forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index flds 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  <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymStruct (ExprBuilder t st fs) flds
x
    | Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymStruct (ExprBuilder t st fs) flds
y
    | SymStruct (ExprBuilder t st fs) flds
x forall a. Eq a => a -> a -> Bool
== SymStruct (ExprBuilder t st fs) flds
y                         = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymStruct (ExprBuilder t st fs) flds
x
    | Bool
otherwise                      = 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)
p SymStruct (ExprBuilder t st fs) flds
x SymStruct (ExprBuilder t st fs) 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 = forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> StringLiteral si -> IO (SymString sym si)
stringLit ExprBuilder t st fs
sym (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 <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
       forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
    , Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f 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
    = 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 forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (si :: StringInfo).
StringInfoRepr si -> BaseTypeRepr ('BaseStringType si)
BaseStringRepr (forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> StringInfoRepr si
stringInfo SymString (ExprBuilder t st fs) si
x)) SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) 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' <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
c
    = if Bool
c' then forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
x else forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) 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' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
    , Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
    , forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality StringLiteral si
x' StringLiteral si
y')
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) 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
    = 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)
c SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) 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' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
    , Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
    , Just Integer
k' <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
k
    = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! 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
    = 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 forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si)
-> e BaseIntegerType
-> App e BaseIntegerType
StringIndexOf SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y SymInteger (ExprBuilder t st fs)
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' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
    , Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Bool
stringLitContains StringLiteral si
x' StringLiteral si
y')
    | Just Bool
b <- StringAbstractValue -> StringAbstractValue -> Maybe Bool
stringAbsContains (forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
x) (forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
y)
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
    | Bool
otherwise
    = 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 forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si) -> App e 'BaseBoolType
StringContains SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) 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' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
    , Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Bool
stringLitIsPrefixOf StringLiteral si
x' StringLiteral si
y')

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

    | Bool
otherwise
    = 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 forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si) -> App e 'BaseBoolType
StringIsPrefixOf SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) 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' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
    , Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Bool
stringLitIsSuffixOf StringLiteral si
x' StringLiteral si
y')

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

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

    | Bool
otherwise
    = 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 forall a b. (a -> b) -> a -> b
$ forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si
-> e (BaseStringType si)
-> e BaseIntegerType
-> e BaseIntegerType
-> App e (BaseStringType si)
StringSubstring (forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> StringInfoRepr si
stringInfo SymString (ExprBuilder t st fs) si
x) SymString (ExprBuilder t st fs) si
x SymInteger (ExprBuilder t st fs)
off SymInteger (ExprBuilder t st fs)
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' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x, forall (si :: StringInfo). StringLiteral si -> Bool
stringLitNull StringLiteral si
x'
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
y

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

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

    | Just (StringAppend StringInfoRepr si
si StringSeq (Expr t) si
xs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
x
    , Just (StringAppend StringInfoRepr si
_  StringSeq (Expr t) si
ys) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
y
    = 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 forall a b. (a -> b) -> a -> b
$ forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
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
ys)

    | Just (StringAppend StringInfoRepr si
si StringSeq (Expr t) si
xs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
x
    = 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 forall a b. (a -> b) -> a -> b
$ forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
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 (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
y))

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

    | Bool
otherwise
    = let si :: StringInfoRepr si
si = forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> StringInfoRepr si
stringInfo SymString (ExprBuilder t st fs) si
x in
      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 forall a b. (a -> b) -> a -> b
$ forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
si (forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringSeq e si -> StringSeq e si
SSeq.append (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
x) (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
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' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
    = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall (si :: StringInfo). StringLiteral si -> Integer
stringLitLength StringLiteral si
x')

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

    | Bool
otherwise
    = 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 forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si) -> App e BaseIntegerType
StringLength SymString (ExprBuilder t st fs) 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 =
    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 forall a b. (a -> b) -> a -> 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 (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) b
v) SymExpr (ExprBuilder t st fs) 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
    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 forall a b. (a -> b) -> a -> b
$ 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
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  <- 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
f
    , Just (MapOverArrays ExprSymFn t (ctx ::> d) r
g Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp (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)
arraysforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1))
    , Just MatlabSolverFn (Expr t) (ctx ::> d) r
RealToIntegerFn <- forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn ExprSymFn t (ctx ::> d) r
g =
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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)
argsforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1)
      -- Cancel out realToInteger (integerToReal a)
    | Just MatlabSolverFn (Expr t) (ctx ::> d) r
RealToIntegerFn  <- 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
f
    , Just (MapOverArrays ExprSymFn t (ctx ::> d) r
g Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp (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)
arraysforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1))
    , Just MatlabSolverFn (Expr t) (ctx ::> d) r
IntegerToRealFn <- forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn ExprSymFn t (ctx ::> d) r
g =
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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)
argsforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1)

    -- When the array is an update of concrete entries, map over the entries.
    | Set (Assignment IndexLit (idx ::> itp))
s <- 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)
arrays
    , Bool -> Bool
not (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 <- 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)
arrayMap ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
f (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
fmapFC forall t (i :: Ctx BaseType) (tp :: BaseType).
ArrayResultWrapper (Expr t) i tp
-> ArrayResultWrapper (Expr t) i tp
underlyingArrayMapExpr Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
arrays)
        BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
ret <- forall (m :: Type -> Type) a. Monad m => a -> m a
return (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
              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 (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) (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 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)
traverseFC (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
              forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t st fs
sym ExprSymFn t ctx ret
g forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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)
traverseFC (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 <- 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 forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Assignment IndexLit (idx ::> itp)
k -> (Assignment IndexLit (idx ::> itp)
k,) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
f Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
arrays Assignment IndexLit (idx ::> itp)
k) (forall a. Set a -> [a]
Set.toAscList Set (Assignment IndexLit (idx ::> itp))
s)
        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)
arrayUpdateAtIdxLits ExprBuilder t st fs
sym ArrayUpdateMap (Expr t) (idx ::> itp) xs
m Expr t (BaseArrayType (idx ::> itp) r)
base
      -- When entries are constants, then just evaluate constant.
    | Just Assignment (Expr t) (ctx ::> d)
cns <-  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)
traverseFC (\ArrayResultWrapper (Expr t) (idx ::> itp) x
a -> forall (e :: BaseType -> Type) (idx :: Ctx BaseType)
       (bt :: BaseType).
IsExpr e =>
e (BaseArrayType idx bt) -> Maybe (e bt)
asConstantArray (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)
arrays = do
      Expr t r
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
f Assignment (Expr t) (ctx ::> d)
cns
      case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (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)
arrays)) of
        BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idxRepr BaseTypeRepr xs
_ -> do
          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)
constantArray ExprBuilder t st fs
sym Assignment BaseTypeRepr (idx ::> tp)
idxRepr Expr t r
r

    | Bool
otherwise = do
      let idx :: Assignment BaseTypeRepr (idx ::> itp)
idx = forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
BaseTypeRepr (BaseArrayType (idx ::> itp) d)
-> Assignment BaseTypeRepr (idx ::> itp)
arrayResultIdxType (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (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)
arrays)))
      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 forall a b. (a -> b) -> a -> b
$ 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
f Assignment BaseTypeRepr (idx ::> itp)
idx Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (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 <- 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)
i =
      case forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymArray (ExprBuilder t st fs) (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 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
v forall a. Eq a => a -> a -> Bool
== Expr t b
cns -> 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) (i ::> itp) tp1
m
                  Maybe (App (Expr t) ('BaseArrayType (i ::> itp) 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
v ArrayUpdateMap (Expr t) (i ::> itp) tp1
m
          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 forall a b. (a -> b) -> a -> 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 (i ::> itp)
idx BaseTypeRepr tp1
tp ArrayUpdateMap (Expr t) (idx ::> tp) 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 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
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType  Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
i
          let bRepr :: BaseTypeRepr b
bRepr = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) b
v
          let new_map :: ArrayUpdateMap (Expr t) (idx ::> tp) b
new_map = 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
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 forall a b. (a -> b) -> a -> 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
arr
    | Bool
otherwise = do
      let bRepr :: BaseTypeRepr b
bRepr = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) b
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 (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 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
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
i)  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)

  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 =
    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
arr (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)
idx) Assignment (SymExpr (ExprBuilder t st fs)) (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 forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
dest_arr of
    (BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
a_repr) -> do
      Expr t (BaseBVType w)
dest_end_idx <- 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 <- 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
      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 (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 (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
dest_idx) BaseTypeRepr xs
a_repr 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 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 <- 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
    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 (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 (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
idx) (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) a
val) 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 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 forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
x_arr of
    (BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
a_repr) -> do
      Expr t (BaseBVType w)
x_end_idx <- 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 <- 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
      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 (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 (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x_idx) BaseTypeRepr xs
a_repr 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 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 <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) (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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymArray (ExprBuilder t st fs) (idx ::> itp) tp
def_map =
            forall (e :: BaseType -> Type) (tp :: BaseType)
       (ctx :: Ctx BaseType).
(e tp -> Bool)
-> ArrayUpdateMap e ctx tp -> ArrayUpdateMap e ctx tp
AUM.filter (forall a. Eq a => a -> a -> Bool
/= Expr t b
default_value) ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
m
          | Bool
otherwise = ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
m
    if 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
      forall (m :: Type -> Type) a. Monad m => a -> m a
return SymArray (ExprBuilder t st fs) (idx ::> itp) tp
def_map
     else
      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 forall a b. (a -> b) -> a -> 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_tps BaseTypeRepr xs
baseRepr ArrayUpdateMap (Expr t) (idx ::> tp) xs
new_map SymArray (ExprBuilder t st fs) (idx ::> itp) tp
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
       -- Extract all concrete updates out.
     | ArrayMapView ArrayUpdateMap (Expr t) idx b
mx Expr t (BaseArrayType idx b)
x' <- 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
x
     , ArrayMapView ArrayUpdateMap (Expr t) idx b
my Expr t (BaseArrayType idx b)
y' <- 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
y
     , Bool -> Bool
not (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 (forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp -> Bool
AUM.null ArrayUpdateMap (Expr t) idx b
my) = do
       case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) 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 = forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p Expr t b
u 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 <- 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)
y' (forall a. a -> Maybe a
Just Assignment IndexLit (idx ::> tp)
idx) forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 <- 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)
x' (forall a. a -> Maybe a
Just Assignment IndexLit (idx ::> tp)
idx) forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 <- 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)
both_fn Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
left_fn Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
right_fn ArrayUpdateMap (Expr t) idx b
mx ArrayUpdateMap (Expr t) idx b
my
           Expr t ('BaseArrayType (idx ::> tp) xs)
z' <- 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)
arrayIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p Expr t (BaseArrayType idx b)
x' Expr t (BaseArrayType idx b)
y'

           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 forall a b. (a -> b) -> a -> 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)
idxRepr BaseTypeRepr xs
bRepr ArrayUpdateMap (Expr t) (idx ::> tp) xs
mz Expr t ('BaseArrayType (idx ::> tp) xs)
z'

     | Bool
otherwise = 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)
p SymArray (ExprBuilder t st fs) idx b
x SymArray (ExprBuilder t st fs) 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
x forall a. Eq a => a -> a -> Bool
== SymArray (ExprBuilder t st fs) idx b
y =
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
    | Bool
otherwise =
      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 forall a b. (a -> b) -> a -> b
$! forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) idx b
x) SymArray (ExprBuilder t st fs) idx b
x SymArray (ExprBuilder t st fs) 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 <- forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymArray (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
a =
      forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) <- 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
f
    , Just Assignment IntLit (idx '::> itp)
v <- 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)
-> Expr t 'BaseBoolType
-> Assignment (Expr t) (i ::> it)
-> IO (Expr t 'BaseBoolType)
h Expr t (BaseArrayType (i ::> it) 'BaseBoolType)
a0 Expr t 'BaseBoolType
p Assignment (Expr t) (i ::> it)
i = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
p forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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)
arrayLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (i ::> it) 'BaseBoolType)
a0 Assignment (Expr t) (i ::> it)
i
      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 (forall (i :: Ctx BaseType) (it :: BaseType).
Expr t (BaseArrayType (i ::> it) 'BaseBoolType)
-> Expr t 'BaseBoolType
-> Assignment (Expr t) (i ::> it)
-> IO (Expr t 'BaseBoolType)
h SymArray (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
a) (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym) Assignment IntLit (idx '::> itp)
v

    | Bool
otherwise =
      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 forall a b. (a -> b) -> a -> b
$! 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
f SymArray (ExprBuilder t st fs) (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 = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr (forall a. Real a => a -> Rational
toRational Coefficient sr
i) ProgramLoc
l
    | Just (RealToInteger Expr t BaseRealType
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseRealType
y
    | Bool
otherwise  = 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 (forall (e :: BaseType -> Type).
e BaseIntegerType -> App e BaseRealType
IntegerToReal SymInteger (ExprBuilder t st fs)
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 = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a b. (RealFrac a, Integral b) => a -> b
floor Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
      -- Static case
    | Bool
otherwise =
      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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x =
      forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
xv)
      -- bvToInteger (integerToBv x w) == mod x (2^w)
    | Just (IntegerToBV IntegerExpr t
xi NatRepr w
w) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
      forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMod ExprBuilder t st fs
sym IntegerExpr t
xi forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
    | Bool
otherwise =
      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 (forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> App e BaseIntegerType
BVToInteger SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x =
      forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall (w :: Natural). (1 <= w) => NatRepr w -> BV w -> Integer
BV.asSigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv)
      -- sbvToInteger (integerToBv x w) == mod (x + 2^(w-1)) (2^w) - 2^(w-1)
    | Just (IntegerToBV IntegerExpr t
xi NatRepr w
w) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
      do IntegerExpr t
halfmod <- forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w forall a. Num a => a -> a -> a
- Natural
1))
         IntegerExpr t
modulus <- forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
2 forall a b. (Num a, Integral b) => a -> b -> a
^ forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
         IntegerExpr t
x'      <- forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intAdd ExprBuilder t st fs
sym IntegerExpr t
xi IntegerExpr t
halfmod
         IntegerExpr t
z       <- forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMod ExprBuilder t st fs
sym IntegerExpr t
x' IntegerExpr t
modulus
         forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intSub ExprBuilder t st fs
sym IntegerExpr t
z IntegerExpr t
halfmod
    | Bool
otherwise =
      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 (forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> App e BaseIntegerType
SBVToInteger SymBV (ExprBuilder t st fs) 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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p =
        if Bool
b then 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 (forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
BV.one NatRepr w
w) else 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 (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w)
    | Bool
otherwise =
       case 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   -> 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 (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)
p)
         NatCaseGT LeqProof (1 + 1) w
LeqProof -> 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 forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m 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 (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)
p)
         NatCaseLT LeqProof (w + 1) 1
LeqProof -> 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 =
      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 (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient sr
i)

    | Just (BVToInteger Expr t (BaseBVType w)
r) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
xr =
      case forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases (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 -> 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 w)
r
        NatCases w w
NatCaseEQ   -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseBVType w)
r
        NatCaseGT LeqProof (w + 1) w
LeqProof -> 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 Expr t (BaseBVType w)
r

    | Just (SBVToInteger Expr t (BaseBVType w)
r) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
xr =
      case forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases (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 -> 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 Expr t (BaseBVType w)
r
        NatCases w w
NatCaseEQ   -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseBVType w)
r
        NatCaseGT LeqProof (w + 1) w
LeqProof -> 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 Expr t (BaseBVType w)
r

    | Bool
otherwise =
      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 (forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e BaseIntegerType -> NatRepr w -> App e ('BaseBVType w)
IntegerToBV SymInteger (ExprBuilder t st fs)
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 = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a. RealFrac a => a -> Integer
roundAway Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
      -- Static case
    | Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) =
      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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
x)
      -- Unsimplified case
    | Bool
otherwise = 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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RoundReal SymReal (ExprBuilder t st fs)
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 = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a b. (RealFrac a, Integral b) => a -> b
round Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
      -- Static case
    | Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) =
      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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
x)
      -- Unsimplified case
    | Bool
otherwise = 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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RoundEvenReal SymReal (ExprBuilder t st fs)
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 = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a b. (RealFrac a, Integral b) => a -> b
floor Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
      -- Static case
    | Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) =
      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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
x)
      -- Unsimplified case
    | Bool
otherwise = 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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
FloorReal SymReal (ExprBuilder t st fs)
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 = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a b. (RealFrac a, Integral b) => a -> b
ceiling Coefficient sr
r) ProgramLoc
l
      -- Match integerToReal
    | Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
      -- Static case
    | Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) =
      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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
x)
      -- Unsimplified case
    | Bool
otherwise = 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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
CeilReal SymReal (ExprBuilder t st fs)
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 <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sb
    forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr Rational
r ProgramLoc
l)

  realZero :: ExprBuilder t st fs -> SymReal (ExprBuilder t st fs)
realZero = 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 (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
y)
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

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

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

    | Bool
otherwise
    = 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 (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq ExprBuilder t st fs
sym) SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
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 (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
y)
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b

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

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

    | Bool
otherwise
    = 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 (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLe ExprBuilder t st fs
sym) SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
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 = 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)
c SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
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 = 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)
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 = 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)
x SymReal (ExprBuilder t st fs)
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 = 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)
x SymReal (ExprBuilder t st fs)
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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
x =
      forall (m :: Type -> Type) a. Monad m => a -> m a
return SymReal (ExprBuilder t st fs)
x
    | Just Rational
xd <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
x, Just Rational
yd <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
y, Rational
yd forall a. Eq a => a -> a -> Bool
/= Rational
0 = do
      forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Rational
xd forall a. Fractional a => a -> a -> a
/ Rational
yd)
      -- Handle division by a constant.
    | Just Rational
yd <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
y, Rational
yd forall a. Eq a => a -> a -> Bool
/= Rational
0 = do
      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 forall a. Fractional a => a -> a -> a
/ Rational
yd) SymReal (ExprBuilder t st fs)
x
    | Bool
otherwise =
      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 forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type).
e BaseRealType -> e BaseRealType -> App e BaseRealType
RealDiv SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sb (forall a. Ratio a -> a
denominator Rational
r forall a. Eq a => a -> a -> Bool
== Integer
1)
    | Just Bool
b <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sb Bool
b
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type).
e BaseRealType -> App e 'BaseBoolType
RealIsInteger SymReal (ExprBuilder t st fs)
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 = forall a. Floating a => a -> a
sqrt
    case SymReal (ExprBuilder t st fs)
x of
      SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
_
        | Coefficient sr
r forall a. Ord a => a -> a -> Bool
< Rational
0 -> 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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealSqrt SymReal (ExprBuilder t st fs)
x)
        | Just Rational
w <- Rational -> Maybe Rational
tryRationalSqrt Coefficient sr
r -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
w
        | forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (Double -> Double
sqrt_dbl (forall a. Fractional a => Rational -> a
fromRational Coefficient sr
r)))
      SymReal (ExprBuilder t st fs)
_ -> 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 (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealSqrt SymReal (ExprBuilder t st fs)
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
    | 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 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a
pi :: Double))
          -- TODO, other constants

          SpecialFunction args
_ -> 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 (forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs 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 <- 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 forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
0
            | forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
sin (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Cos
            | Rational
c forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
            | forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
cos (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Sinh
            | Rational
c forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
0
            | forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
sinh (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Cosh
            | Rational
c forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
            | forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
cosh (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Exp
            | Rational
c forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
            | forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
exp (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
SFn.Log
            | Rational
c forall a. Ord a => a -> a -> Bool
> Rational
0, forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
log (Rational -> Double
toDouble Rational
c)))
          SpecialFunction args
_ -> 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 (forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (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
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 <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational Expr t BaseRealType
x,
      Just Rational
yc <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational Expr t BaseRealType
y =
        case SpecialFunction args
fn of
          SpecialFunction args
SFn.Arctan2
            | forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. RealFloat a => a -> a -> a
atan2 (Rational -> Double
toDouble Rational
xc) (Rational -> Double
toDouble Rational
yc)))
          SpecialFunction args
SFn.Pow
            | Rational
yc forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
            | forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym ->
              forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (Rational -> Double
toDouble Rational
xc forall a. Floating a => a -> a -> a
** Rational -> Double
toDouble Rational
yc))
          SpecialFunction args
_ -> 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 (forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (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
args))

  realSpecialFunction ExprBuilder t st fs
sym SpecialFunction args
fn Assignment
  (SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args = 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 (forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (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
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 <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
       forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym 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
_) = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym 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 = 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 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
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
_) = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym 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 = 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 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
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
_) =
    forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> (BigFloat, Status)
BF.bfSqrt (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 = 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 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
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
_) =
    forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfAdd (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 = 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 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
x SymFloat (ExprBuilder t st fs) 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
_) =
    forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfSub (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 = 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 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
x SymFloat (ExprBuilder t st fs) 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
_) =
    forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfMul (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 = 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 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
x SymFloat (ExprBuilder t st fs) 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
_) =
    forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfDiv (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 = 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 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
x SymFloat (ExprBuilder t st fs) 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
_) =
    forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfRem (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 = 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 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
x SymFloat (ExprBuilder t st fs) 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
_) =
    forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfFMA (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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymFloat (ExprBuilder t st fs) fpp
x in 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 forall a b. (a -> b) -> a -> b
$ 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
x SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! (BigFloat -> BigFloat -> Ordering
BF.bfCompare BigFloat
x BigFloat
y 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
x forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
    | Bool
otherwise = 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 (forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymFloat (ExprBuilder t st fs) fpp
x)) ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) 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 = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! (BigFloat
x 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
x forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
y = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
    | Bool
otherwise = 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 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
x SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! (BigFloat
x 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
x forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
y = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
    | Bool
otherwise = 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 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
x SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! (BigFloat
x 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
x forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym
    | Bool
otherwise = 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 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
x SymFloat (ExprBuilder t st fs) 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = 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)
c SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym 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 = 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 forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym 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 = 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 forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsInf ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym 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 = 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 forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsZero ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym 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 = 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 forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsPos ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym 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 = 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 forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! BFOpts -> BigFloat -> Bool
BF.bfIsSubnormal (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 = 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 forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsSubnorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) 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
_) =
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! BFOpts -> BigFloat -> Bool
BF.bfIsNormal (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 = 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 forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsNorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) 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
_) =
    forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> (BigFloat, Status)
BF.bfRoundFloat (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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymFloat (ExprBuilder t st fs) fpp'
x
    , forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr eb
eb forall a. Ord a => a -> a -> Bool
<= forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr eb
eb'
    , forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr sb
sb forall a. Ord a => a -> a -> Bool
<= forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr sb
sb'
    , Just 'BaseFloatType fpp :~: BaseFloatType fpp'
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp) (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t (BaseFloatType fpp')
fval)
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseFloatType fpp')
fval
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ 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'
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
_) =
    forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (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 = 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 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
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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) (eb + sb)
x
    = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp (BFOpts -> Integer -> BigFloat
BF.bfFromBits (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp RoundingMode
RNE) (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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) (eb + sb)
x
    , Just FloatingPointPrecision eb sb :~: FloatingPointPrecision eb sb
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp'
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseFloatType (FloatingPointPrecision eb sb))
fval
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ 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)
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 <- forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr eb
eb NatRepr sb
sb) =
        forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr eb
eb NatRepr sb
sb) (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr eb
eb NatRepr sb
sb) (BFOpts -> BigFloat -> Integer
BF.bfToBits (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 forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
x of
    BaseFloatRepr FloatPrecisionRepr fpp
fpp | LeqProof 1 (eb + sb)
LeqProof <- forall (eb' :: Natural) (sb' :: Natural).
FloatPrecisionRepr (FloatingPointPrecision eb' sb')
-> LeqProof 1 (eb' + sb')
lemmaFloatPrecisionIsPos FloatPrecisionRepr fpp
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 forall a b. (a -> b) -> a -> b
$ 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
fpp SymFloat (ExprBuilder t st fs) (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 =
    forall sym v.
IsExprBuilder sym =>
(sym -> Pred sym -> v -> v -> IO v)
-> sym -> [(IO (Pred sym), IO v)] -> IO v -> IO v
iteList forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte ExprBuilder t st fs
sym
      [ (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x, forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
y)
      , (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y, forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
      , (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
      , (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
y)
      , (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) 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 Expr t 'BaseBoolType
b <- forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
emptySymbol BaseTypeRepr 'BaseBoolType
BaseBoolRepr
          forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
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 =
    forall sym v.
IsExprBuilder sym =>
(sym -> Pred sym -> v -> v -> IO v)
-> sym -> [(IO (Pred sym), IO v)] -> IO v -> IO v
iteList forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte ExprBuilder t st fs
sym
      [ (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x, forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
y)
      , (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y, forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
      , (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
y)
      , (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
      , (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) 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 Expr t 'BaseBoolType
b <- forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
emptySymbol BaseTypeRepr 'BaseBoolType
BaseBoolRepr
          forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BFOpts -> Integer -> BigFloat
floatFromInteger (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) (forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
bv))
    | Bool
otherwise = 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 (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
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 <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BFOpts -> Integer -> BigFloat
floatFromInteger (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) (forall (w :: Natural). (1 <= w) => NatRepr w -> BV w -> Integer
BV.asSigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
bv))
    | Bool
otherwise = 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 (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
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' <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
x = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BFOpts -> Rational -> BigFloat
floatFromRational (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) Rational
x')
    | Bool
otherwise = 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 (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)
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 forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
<= forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
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 (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)

    | Bool
otherwise = 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 (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
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
    , forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
<= forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
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 (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)

    | Bool
otherwise = 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 (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
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
    = forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
q

    | Bool
otherwise = 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 (forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseRealType
FloatToReal SymFloat (ExprBuilder t st fs) 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 =
    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 (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 (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
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 = 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 (forall (e :: BaseType -> Type).
Complex (e BaseRealType) -> App e 'BaseComplexType
Cplx Complex (SymReal (ExprBuilder t st fs))
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
_)) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymCplx (ExprBuilder t st fs)
e = 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 =
    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 (forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
RealPart SymCplx (ExprBuilder t st fs)
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)) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymCplx (ExprBuilder t st fs)
e = 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 =
    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 (forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
ImagPart SymCplx (ExprBuilder t st fs)
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) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymCplx (ExprBuilder t st fs)
e = 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 =
    forall a. a -> a -> Complex a
(:+) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f 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 (forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
RealPart SymCplx (ExprBuilder t st fs)
x)
         forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f 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 (forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
ImagPart SymCplx (ExprBuilder t st fs)
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) <- 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) <- 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 <- 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 <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s2
  , Just fv :~: fv
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality BVFlavorRepr fv
flv1 BVFlavorRepr fv
flv2
  = forall a. a -> Maybe a
Just (forall k (f :: k -> Type) (x :: k). f x -> Some f
Some BVFlavorRepr fv
flv1)

  | Bool
otherwise
  = 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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in 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 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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in 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 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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in 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 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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in 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 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 = 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 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 = 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 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
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
_ = 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
_ = 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
_ = 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
_ = 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 = forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
"80-bit floating point value does not represent a rational number: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show X86_80Val
x)
       Just Rational
r  -> 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 = 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 = 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
_ = 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
_ = 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
_ = 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
_ = 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
_ = 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 = 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 <- forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLe ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
    forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realIte ExprBuilder t st (Flags FloatReal)
sym Expr t 'BaseBoolType
c SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x 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 <- forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGe ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
    forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realIte ExprBuilder t st (Flags FloatReal)
sym Expr t 'BaseBoolType
c SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x 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 <- (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realMul ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y)
    forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realAdd ExprBuilder t st (Flags FloatReal)
sym Expr t BaseRealType
tmp 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq ExprBuilder t st (Flags FloatReal)
sym forall a b. (a -> b) -> a -> b
$ 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 = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLt ExprBuilder t st (Flags FloatReal)
sym forall a b. (a -> b) -> a -> b
$ 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 = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGt ExprBuilder t st (Flags FloatReal)
sym forall a b. (a -> b) -> a -> b
$ 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
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realNe ExprBuilder t st (Flags FloatReal)
sym forall a b. (a -> b) -> a -> b
$ 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
_ = 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 =
    forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> IO (SymReal sym)
integerToReal ExprBuilder t st (Flags FloatReal)
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< case RoundingMode
r of
      RoundingMode
RNA -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realRound ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
      RoundingMode
RTP -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realCeil ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
      RoundingMode
RTN -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realFloor ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
      RoundingMode
RTZ -> do
        Expr t 'BaseBoolType
is_pos <- forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLt ExprBuilder t st (Flags FloatReal)
sym (forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym) SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
        forall sym v.
IsExprBuilder sym =>
(sym -> Pred sym -> v -> v -> IO v)
-> sym -> Pred sym -> IO v -> IO v -> IO v
iteM forall sym.
IsExprBuilder sym =>
sym
-> Pred sym
-> SymInteger sym
-> SymInteger sym
-> IO (SymInteger sym)
intIte ExprBuilder t st (Flags FloatReal)
sym Expr t 'BaseBoolType
is_pos (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realFloor ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x) (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realCeil ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x)
      RoundingMode
RNE -> 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) <- forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp SymBV (ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi)
x
    , Text
"uninterpreted_real_to_float_binary" forall a. Eq a => a -> a -> Bool
== SolverSymbol -> Text
solverSymbolAsText (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
_) <- 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
    = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t tp
rval
    | Bool
otherwise = 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"
                                       (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty 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)
x)
                                       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 =
    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"
                         (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty 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
x)
                         (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
_ = 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
_ = 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
_ = 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 = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymReal sym -> NatRepr w -> IO (SymBV sym w)
realToBV ExprBuilder t st (Flags FloatReal)
sym 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 = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymReal sym -> NatRepr w -> IO (SymBV sym w)
realToSBV ExprBuilder t st (Flags FloatReal)
sym 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)
_ = 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 = forall sym (args :: Ctx Type).
IsExprBuilder sym =>
sym
-> SpecialFunction args
-> Assignment (SpecialFnArg (SymExpr sym) BaseRealType) args
-> IO (SymReal sym)
realSpecialFunction ExprBuilder t st (Flags FloatReal)
sym SpecialFunction args
fn 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
_ = 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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 = forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal sym
-> IO (SymInterpretedFloat sym fi)
iRealToFloat ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr fi
fi RoundingMode
RNE forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< 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 =
    forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SymBV sym (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat sym fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr SingleFloat
SingleFloatRepr
      forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatUninterpreted)
sym forall (n :: Natural). KnownNat n => NatRepr n
knownNat forall a b. (a -> b) -> a -> b
$ Word32 -> BV 32
BV.word32 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 =
    forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SymBV sym (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat sym fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr DoubleFloat
DoubleFloatRepr
      forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatUninterpreted)
sym forall (n :: Natural). KnownNat n => NatRepr n
knownNat forall a b. (a -> b) -> a -> b
$ Word64 -> BV 64
BV.word64 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 =
    forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SymBV sym (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat sym fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr X86_80Float
X86_80FloatRepr
      forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatUninterpreted)
sym forall (n :: Natural). KnownNat n => NatRepr n
knownNat forall a b. (a -> b) -> a -> b
$ forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV forall (n :: Natural). KnownNat n => NatRepr n
knownNat 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
x
    Expr t BaseIntegerType
r_arg <- 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
    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"
                    (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty 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 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
x 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
y 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
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 = forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym -> SymExpr sym tp -> SymExpr sym tp -> IO (Pred sym)
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 = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st (Flags FloatUninterpreted)
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym -> SymExpr sym tp -> SymExpr sym tp -> IO (Pred sym)
isEq ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) fi
x 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 = 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 = 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 = 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 = 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 = 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
y SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) 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 = 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
y SymInterpretedFloat
  (ExprBuilder t st (Flags FloatUninterpreted)) 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 = forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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 = 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
_ = 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
_ = 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    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"
                    (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty 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
x)
                    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 =
    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 (forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym 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
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)
_ = 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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
  in  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 (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty 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 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_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SpecialFunction args
fn)
     ExprSymFn t EmptyCtx bt
fn' <- 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 forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty BaseTypeRepr bt
btr forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn
     forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t sf tfs
sym ExprSymFn t EmptyCtx bt
fn' 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_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SpecialFunction args
fn)
     ExprSymFn t (EmptyCtx ::> bt) bt
fn' <- 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 (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty 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 forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn
     forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t sf tfs
sym ExprSymFn t (EmptyCtx ::> bt) bt
fn' (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty 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_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SpecialFunction args
fn)
     ExprSymFn t ((EmptyCtx ::> bt) ::> bt) bt
fn' <- 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 (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty 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 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 forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn
     forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t sf tfs
sym ExprSymFn t ((EmptyCtx ::> bt) ::> bt) bt
fn' (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty 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 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 =
  forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Special function with unexpected arity", 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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
  e BaseIntegerType
r_arg <- 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
  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 (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty 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 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 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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
  in  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 (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty 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 = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
  e BaseIntegerType
r_arg <- 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
  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 (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty 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 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 =
  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 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 =
  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 (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty 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 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) 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 =
  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 (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty 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) 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 <- 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
  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 (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty 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 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 = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatPZero ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatNZero ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatNaN ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatPInf ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatNInf ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> Rational -> IO (SymFloat sym fpp)
floatLitRational ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    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 forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
      forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (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 forall a b. (a -> b) -> a -> b
$ Word32 -> BV 32
BV.word32 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 =
    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 forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
      forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (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 forall a b. (a -> b) -> a -> b
$ Word64 -> BV 64
BV.word64 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 <- 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) forall a b. (a -> b) -> a -> b
$ Word16 -> BV 16
BV.word16 Word16
e
    Expr t (BaseBVType 64)
sl <- 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) forall a b. (a -> b) -> a -> b
$ Word64 -> BV 64
BV.word64 Word64
s
    Expr t (BaseBVType (16 + 64))
fl <- 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 Expr t (BaseBVType 16)
el Expr t (BaseBVType 64)
sl
    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 forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> RoundingMode -> SymFloat sym fpp -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
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 = forall sym (fpp :: FloatPrecision) (fpp' :: FloatPrecision).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymFloat sym fpp'
-> IO (SymFloat sym fpp)
floatCast ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> RoundingMode -> SymFloat sym fpp -> IO (SymFloat sym 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         -> 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 forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
    FloatInfoRepr fi
SingleFloatRepr       -> 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 forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
    FloatInfoRepr fi
DoubleFloatRepr       -> 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 forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
    FloatInfoRepr fi
QuadFloatRepr         -> 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 forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
    FloatInfoRepr fi
X86_80FloatRepr       -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"x86_80 is not an IEEE-754 format."
    FloatInfoRepr fi
DoubleDoubleFloatRepr -> 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         -> 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 SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
    FloatInfoRepr fi
SingleFloatRepr       -> 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 SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
    FloatInfoRepr fi
DoubleFloatRepr       -> 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 SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
    FloatInfoRepr fi
QuadFloatRepr         -> 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 SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
    FloatInfoRepr fi
X86_80FloatRepr       -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"x86_80 is not an IEEE-754 format."
    FloatInfoRepr fi
DoubleDoubleFloatRepr -> 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymReal sym
-> IO (SymFloat sym fpp)
realToFloat ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 = 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 = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymReal sym)
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 =
    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)
floatSpecialFunction ExprBuilder t st (Flags FloatIEEE)
sym (forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr FloatInfoRepr fi
fi) SpecialFunction args
fn 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)
_ = forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- 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 forall a. Maybe a
Nothing
    forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t tp
v)
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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 = forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
nm (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 forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
boundsOK (forall e a. Exception e => e -> IO a
Ex.throwIO (forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Integral a => a -> Integer
toInteger Maybe Natural
mlo) (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Integral a => a -> Integer
toInteger Maybe Natural
mhi)))
       ExprBoundVar t ('BaseBVType w)
v <- 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 (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) VarKind
UninterpVarKind (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! (forall (w :: Natural).
NatRepr w -> Integer -> Integer -> BVDomain w
BVD.range NatRepr w
w Integer
lo Integer
hi))
       forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t ('BaseBVType w)
v)
       forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t ('BaseBVType w)
v
   where
   boundsOK :: Bool
boundsOK = Integer
lo forall a. Ord a => a -> a -> Bool
<= Integer
hi Bool -> Bool -> Bool
&& forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w forall a. Ord a => a -> a -> Bool
<= Integer
lo Bool -> Bool -> Bool
&& Integer
hi forall a. Ord a => a -> a -> Bool
<= forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
   lo :: Integer
lo = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w) forall a. Integral a => a -> Integer
toInteger Maybe Natural
mlo
   hi :: Integer
hi = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w) 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 = forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
nm (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 forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
boundsOK (forall e a. Exception e => e -> IO a
Ex.throwIO (forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) Maybe Integer
mlo Maybe Integer
mhi))
       ExprBoundVar t ('BaseBVType w)
v <- 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 (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) VarKind
UninterpVarKind (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! (forall (w :: Natural).
NatRepr w -> Integer -> Integer -> BVDomain w
BVD.range NatRepr w
w Integer
lo Integer
hi))
       forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t ('BaseBVType w)
v)
       forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t ('BaseBVType w)
v
   where
   boundsOK :: Bool
boundsOK = Integer
lo forall a. Ord a => a -> a -> Bool
<= Integer
hi Bool -> Bool -> Bool
&& forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w forall a. Ord a => a -> a -> Bool
<= Integer
lo Bool -> Bool -> Bool
&& Integer
hi forall a. Ord a => a -> a -> Bool
<= forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
   lo :: Integer
lo = forall a. a -> Maybe a -> a
fromMaybe (forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w) Maybe Integer
mlo
   hi :: Integer
hi = forall a. a -> Maybe a -> a
fromMaybe (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 forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (forall {a}. Ord a => Maybe a -> Maybe a -> Bool
boundsOK Maybe Integer
mlo Maybe Integer
mhi) (forall e a. Exception e => e -> IO a
Ex.throwIO (forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange BaseTypeRepr BaseIntegerType
BaseIntegerRepr Maybe Integer
mlo Maybe Integer
mhi))
       ExprBoundVar t BaseIntegerType
v <- 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 (forall {tp}. Maybe tp -> Maybe tp -> Maybe (ValueRange tp)
absVal Maybe Integer
mlo Maybe Integer
mhi)
       forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t BaseIntegerType
v)
       forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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 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 = forall a. Maybe a
Nothing
   absVal (Just tp
lo) Maybe tp
Nothing = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (forall tp. tp -> ValueBound tp
Inclusive tp
lo) forall tp. ValueBound tp
Unbounded
   absVal Maybe tp
Nothing (Just tp
hi) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange forall tp. ValueBound tp
Unbounded (forall tp. tp -> ValueBound tp
Inclusive tp
hi)
   absVal (Just tp
lo) (Just tp
hi) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (forall tp. tp -> ValueBound tp
Inclusive tp
lo) (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 forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (forall {a}. Ord a => Maybe a -> Maybe a -> Bool
boundsOK Maybe Rational
mlo Maybe Rational
mhi) (forall e a. Exception e => e -> IO a
Ex.throwIO (forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange BaseTypeRepr BaseRealType
BaseRealRepr Maybe Rational
mlo Maybe Rational
mhi))
       ExprBoundVar t BaseRealType
v <- 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)
       forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t BaseRealType
v)
       forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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 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 = forall a. Maybe a
Nothing
   absVal (Just Rational
lo) Maybe Rational
Nothing = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (forall tp. tp -> ValueBound tp
Inclusive Rational
lo) forall tp. ValueBound tp
Unbounded) forall a. Maybe a
Nothing
   absVal Maybe Rational
Nothing (Just Rational
hi) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange forall tp. ValueBound tp
Unbounded (forall tp. tp -> ValueBound tp
Inclusive Rational
hi)) forall a. Maybe a
Nothing
   absVal (Just Rational
lo) (Just Rational
hi) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (forall tp. tp -> ValueBound tp
Inclusive Rational
lo) (forall tp. tp -> ValueBound tp
Inclusive Rational
hi)) 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 <- 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 forall a. Maybe a
Nothing
    forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t tp
v)
    forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s t. VarRecorder s t () -> ST s (CollectedVarInfo t)
VI.collectVarInfo forall a b. (a -> b) -> a -> b
$ forall t (tp :: BaseType) s.
Scope -> Expr t tp -> VarRecorder s t ()
VI.recordExprVars Scope
VI.ExistsOnly SymExpr (ExprBuilder t st fs) tp
expr) forall s a. s -> Getting a s a -> a
^. forall t.
Simple Lens (CollectedVarInfo t) (Set (Some (ExprBoundVar 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 =
    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 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
_ = 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 = 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 forall a b. (a -> b) -> a -> b
$ forall t (tp1 :: BaseType) (e :: BaseType -> Type).
ExprBoundVar t tp1 -> e 'BaseBoolType -> NonceApp t e 'BaseBoolType
Forall BoundVar (ExprBuilder t st fs) tp
bv Pred (ExprBuilder t st fs)
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 = 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 forall a b. (a -> b) -> a -> b
$ forall t (tp1 :: BaseType) (e :: BaseType -> Type).
ExprBoundVar t tp1 -> e 'BaseBoolType -> NonceApp t e 'BaseBoolType
Exists BoundVar (ExprBuilder t st fs) tp
bv Pred (ExprBuilder t st fs)
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 <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
    Nonce t (args ::> ret)
n <- 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 = 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
bound_vars SymExpr (ExprBuilder t st fs) ret
result UnfoldPolicy
policy
                         , symFnLoc :: ProgramLoc
symFnLoc  = ProgramLoc
l
                         }
    forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
fn_name (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymbolBinding t
FnSymbolBinding ExprSymFn t args ret
fn)
    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 <- 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 <- 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 = 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
                         }
    seq :: forall a b. a -> b -> b
seq ExprSymFn t args ret
fn forall a b. (a -> b) -> a -> b
$ do
    forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
fn_name (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymbolBinding t
FnSymbolBinding ExprSymFn t args ret
fn)
    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 forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo SymFn (ExprBuilder t st fs) args ret
fn of
     DefinedFnInfo Assignment (ExprBoundVar t) args
bound_vars Expr t ret
e UnfoldPolicy
policy
       | forall (e :: BaseType -> Type) (args :: Ctx BaseType).
IsExpr e =>
UnfoldPolicy -> Assignment e args -> Bool
shouldUnfold UnfoldPolicy
policy Assignment (SymExpr (ExprBuilder t st fs)) args
args ->
           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
args
     MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
f Assignment (ExprBoundVar t) args
_ Expr t ret
_ -> do
       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 (Expr t) args ret
f ExprBuilder t st fs
sym Assignment (SymExpr (ExprBuilder t st fs)) args
args
     SymFnInfo t args 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 forall a b. (a -> b) -> a -> b
$! 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
fn Assignment (SymExpr (ExprBuilder t st fs)) 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 <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ do
      HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- forall {k1} s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized forall a b. (a -> b) -> a -> b
$ forall t e. IsBinTree t e => t -> Int
PM.size MapF
  (BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
subst
      HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl <- forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
      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_ (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr) MapF
  (BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
subst
      forall (m :: Type -> Type) a. Monad m => a -> m a
return 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
        }
    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
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 <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ do
      HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- 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 <- forall {k1} s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized forall a b. (a -> b) -> a -> b
$ forall t e. IsBinTree t e => t -> Int
PM.size MapF
  (SymFnWrapper (ExprBuilder t st fs))
  (SymFnWrapper (ExprBuilder t st fs))
subst
      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) -> 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 (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId SymFn (ExprBuilder t st fs) args ret
f) (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
g))
        MapF
  (SymFnWrapper (ExprBuilder t st fs))
  (SymFnWrapper (ExprBuilder t st fs))
subst
      forall (m :: Type -> Type) a. Monad m => a -> m a
return 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
        }
    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
e


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 = 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
fn_id
    Maybe (ExprSymFnWrapper t (args ::> ret))
mr <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ 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 (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) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t a r
f
      Maybe (ExprSymFnWrapper t (args ::> ret))
Nothing -> do
        let tps :: Assignment BaseTypeRepr args
tps = 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
fn_id
        Assignment (ExprBoundVar t) args
vars <- 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)
traverseFC (forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (BoundVar sym tp)
freshBoundVar ExprBuilder t st fs
sym SolverSymbol
emptySymbol) Assignment BaseTypeRepr args
tps
        Expr t ret
r <- 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 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
fmapFC forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr Assignment (ExprBoundVar t) args
vars)
        ProgramLoc
l <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
        Nonce t (args ::> ret)
n <- 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 = 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
fn_id Assignment (ExprBoundVar t) args
vars Expr t ret
r
                            , symFnLoc :: ProgramLoc
symFnLoc  = ProgramLoc
l
                            }
        forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
emptySymbol (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymbolBinding t
FnSymbolBinding ExprSymFn t args ret
f)
        forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ 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 (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 (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)
        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 -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show SolverSymbolError
err)
    Right SolverSymbol
symbol  -> 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 <- forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> IORef
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
sbUninterpFnCache sym
sym
  case 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 <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (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
fn) Assignment BaseTypeRepr args
arg_types
      , Just ret :~: ret
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (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
fn) BaseTypeRepr ret
ret_type
      -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymFn (ExprBuilder t st fs) args ret
fn
      | Bool
otherwise
      -> 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
      forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> IORef
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
sbUninterpFnCache sym
sym) (\Map
  (SolverSymbol, Some (Assignment BaseTypeRepr))
  (SomeSymFn (ExprBuilder t st fs))
m -> (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (SolverSymbol, Some (Assignment BaseTypeRepr))
fn_key (forall sym (args :: Ctx BaseType) (ret :: BaseType).
SymFn sym args ret -> SomeSymFn sym
SomeSymFn ExprSymFn t args ret
fn) Map
  (SolverSymbol, Some (Assignment BaseTypeRepr))
  (SomeSymFn (ExprBuilder t st fs))
m, ()))
      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, forall k (f :: k -> Type) (x :: k). f x -> Some f
Some (Assignment BaseTypeRepr args
arg_types 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 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
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr sym) args
args
  ExprSymFn t args ret
fn <- 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 forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn
  forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn sym
sym 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 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
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr sym) args
args
  ExprSymFn t args ret
fn <- forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
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
  forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn sym
sym ExprSymFn t args ret
fn Assignment (SymExpr sym) args
args