{-|
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.
-}
{-# 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
  , sbUnaryThreshold
  , sbCacheStartSize
  , sbBVDomainRangeLimit
  , sbUserState
  , exprCounter
  , startCaching
  , stopCaching

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

    -- * configuration options
  , unaryThresholdOption
  , bvdomainRangeLimitOption
  , 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

    -- * 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 qualified Data.Binary.IEEE754 as IEEE754
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 qualified LibBF as BF

import           What4.BaseTypes
import           What4.Concrete
import qualified What4.Config as CFG
import           What4.Interface
import           What4.InterpretedFloatingPoint
import           What4.ProgramLoc
import qualified What4.SemiRing as SR
import           What4.Symbol
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           What4.Utils.AbstractDomains
import           What4.Utils.Arithmetic
import qualified What4.Utils.BVDomain as BVD
import           What4.Utils.Complex
import           What4.Utils.FloatHelpers
import           What4.Utils.StringLiteral

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

data SomeSymFn sym = forall args ret . SomeSymFn (SymFn sym args ret)

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

-- | Mode flag for how floating-point values should be interpreted.
data FloatMode where
  FloatIEEE :: FloatMode
  FloatUninterpreted :: FloatMode
  FloatReal :: FloatMode
type FloatIEEE = 'FloatIEEE
type FloatUninterpreted = 'FloatUninterpreted
type FloatReal = 'FloatReal

data Flags (fi :: FloatMode)


data FloatModeRepr :: FloatMode -> Type where
  FloatIEEERepr          :: FloatModeRepr FloatIEEE
  FloatUninterpretedRepr :: FloatModeRepr FloatUninterpreted
  FloatRealRepr          :: FloatModeRepr FloatReal

instance Show (FloatModeRepr fm) where
  showsPrec :: Int -> FloatModeRepr fm -> ShowS
showsPrec Int
_ FloatModeRepr fm
FloatIEEERepr          = String -> ShowS
showString String
"FloatIEEE"
  showsPrec Int
_ FloatModeRepr fm
FloatUninterpretedRepr = String -> ShowS
showString String
"FloatUninterpreted"
  showsPrec Int
_ FloatModeRepr fm
FloatRealRepr          = String -> ShowS
showString String
"FloatReal"

instance ShowF FloatModeRepr

instance KnownRepr FloatModeRepr FloatIEEE          where knownRepr :: FloatModeRepr FloatIEEE
knownRepr = FloatModeRepr FloatIEEE
FloatIEEERepr
instance KnownRepr FloatModeRepr FloatUninterpreted where knownRepr :: FloatModeRepr FloatUninterpreted
knownRepr = FloatModeRepr FloatUninterpreted
FloatUninterpretedRepr
instance KnownRepr FloatModeRepr FloatReal          where knownRepr :: FloatModeRepr FloatReal
knownRepr = FloatModeRepr FloatReal
FloatRealRepr

instance TestEquality FloatModeRepr where
  testEquality :: FloatModeRepr a -> FloatModeRepr b -> Maybe (a :~: b)
testEquality FloatModeRepr a
FloatIEEERepr           FloatModeRepr b
FloatIEEERepr           = (a :~: a) -> Maybe (a :~: a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return a :~: a
forall k (a :: k). a :~: a
Refl
  testEquality FloatModeRepr a
FloatUninterpretedRepr  FloatModeRepr b
FloatUninterpretedRepr  = (a :~: a) -> Maybe (a :~: a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return a :~: a
forall k (a :: k). a :~: a
Refl
  testEquality FloatModeRepr a
FloatRealRepr           FloatModeRepr b
FloatRealRepr           = (a :~: a) -> Maybe (a :~: a)
forall (m :: Type -> Type) a. Monad m => a -> m a
return a :~: a
forall k (a :: k). a :~: a
Refl
  testEquality FloatModeRepr a
_ FloatModeRepr b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing


-- | 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 { ExprBuilder t st fs -> BoolExpr t
sbTrue  :: !(BoolExpr t)
        , ExprBuilder t st fs -> BoolExpr t
sbFalse :: !(BoolExpr t)
          -- | Constant zero.
        , ExprBuilder t st fs -> RealExpr t
sbZero  :: !(RealExpr t)
          -- | Configuration object for this symbolic backend
        , 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.
        , ExprBuilder t st fs -> Bool
sbFloatReduce :: !Bool
          -- | The maximum number of distinct values a term may have and use the
          -- unary representation.
        , ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold :: !(CFG.OptionSetting BaseIntegerType)
          -- | The maximum number of distinct ranges in a BVDomain expression.
        , ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbBVDomainRangeLimit :: !(CFG.OptionSetting BaseIntegerType)
          -- | The starting size when building a new cache
        , ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize :: !(CFG.OptionSetting BaseIntegerType)
          -- | Counter to generate new unique identifiers for elements and functions.
        , ExprBuilder t st fs -> NonceGenerator IO t
exprCounter :: !(NonceGenerator IO t)
          -- | Reference to current allocator for expressions.
        , ExprBuilder t st fs -> IORef (ExprAllocator t)
curAllocator :: !(IORef (ExprAllocator t))
          -- | Number of times an 'Expr' for a non-linear operation has been
          -- created.
        , ExprBuilder t st fs -> IORef Integer
sbNonLinearOps :: !(IORef Integer)
          -- | The current program location
        , ExprBuilder t st fs -> IORef ProgramLoc
sbProgramLoc :: !(IORef ProgramLoc)
          -- | Additional state maintained by the state manager
        , ExprBuilder t st fs -> st t
sbUserState :: !(st t)

        , ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings :: !(IORef (SymbolVarBimap t))
        , 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
        , ExprBuilder t st fs
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
sbMatlabFnCache
          :: !(PH.HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t))
        , 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

------------------------------------------------------------------------
-- | ExprAllocator provides an interface for creating expressions from
-- an applications.
-- Parameter @t@ is a phantom type brand used to track nonces.
data ExprAllocator t
   = ExprAllocator { ExprAllocator t
-> forall (tp :: BaseType).
   ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
appExpr  :: forall tp
                            .  ProgramLoc
                            -> App (Expr t) tp
                            -> AbstractValue tp
                            -> IO (Expr t tp)
                  , ExprAllocator t
-> forall (tp :: BaseType).
   ProgramLoc
   -> NonceApp t (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
nonceExpr :: forall tp
                             .  ProgramLoc
                             -> NonceApp t (Expr t) tp
                             -> AbstractValue tp
                             -> IO (Expr t tp)
                  }


------------------------------------------------------------------------
-- Uncached storage

-- | Create a new storage that does not do hash consing.
newStorage :: NonceGenerator IO t -> IO (ExprAllocator t)
newStorage :: NonceGenerator IO t -> IO (ExprAllocator t)
newStorage NonceGenerator IO t
g = do
  ExprAllocator t -> IO (ExprAllocator t)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprAllocator t -> IO (ExprAllocator t))
-> ExprAllocator t -> IO (ExprAllocator t)
forall a b. (a -> b) -> a -> b
$! ExprAllocator :: forall t.
(forall (tp :: BaseType).
 ProgramLoc
 -> App (Expr t) tp -> AbstractValue tp -> IO (Expr t tp))
-> (forall (tp :: BaseType).
    ProgramLoc
    -> NonceApp t (Expr t) tp -> AbstractValue tp -> IO (Expr t tp))
-> ExprAllocator t
ExprAllocator { appExpr :: forall (tp :: BaseType).
ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
appExpr = NonceGenerator IO t
-> ProgramLoc
-> App (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
forall t (tp :: BaseType).
NonceGenerator IO t
-> ProgramLoc
-> App (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
uncachedExprFn NonceGenerator IO t
g
                         , nonceExpr :: forall (tp :: BaseType).
ProgramLoc
-> NonceApp t (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
nonceExpr = NonceGenerator IO t
-> ProgramLoc
-> NonceApp t (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
forall t (tp :: BaseType).
NonceGenerator IO t
-> ProgramLoc
-> NonceApp t (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
uncachedNonceExpr NonceGenerator IO t
g
                         }

uncachedExprFn :: NonceGenerator IO t
              -> ProgramLoc
              -> App (Expr t) tp
              -> AbstractValue tp
              -> IO (Expr t tp)
uncachedExprFn :: NonceGenerator IO t
-> ProgramLoc
-> App (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
uncachedExprFn NonceGenerator IO t
g ProgramLoc
pc App (Expr t) tp
a AbstractValue tp
v = do
  Nonce t tp
n <- NonceGenerator IO t -> IO (Nonce t tp)
forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce NonceGenerator IO t
g
  Expr t tp -> IO (Expr t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t tp -> IO (Expr t tp)) -> Expr t tp -> IO (Expr t tp)
forall a b. (a -> b) -> a -> b
$! Nonce t tp
-> ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> Expr t tp
forall t (tp :: BaseType).
Nonce t tp
-> ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> Expr t tp
mkExpr Nonce t tp
n ProgramLoc
pc App (Expr t) tp
a AbstractValue tp
v

uncachedNonceExpr :: NonceGenerator IO t
                 -> ProgramLoc
                 -> NonceApp t (Expr t) tp
                 -> AbstractValue tp
                 -> IO (Expr t tp)
uncachedNonceExpr :: NonceGenerator IO t
-> ProgramLoc
-> NonceApp t (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
uncachedNonceExpr NonceGenerator IO t
g ProgramLoc
pc NonceApp t (Expr t) tp
p AbstractValue tp
v = do
  Nonce t tp
n <- NonceGenerator IO t -> IO (Nonce t tp)
forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce NonceGenerator IO t
g
  Expr t tp -> IO (Expr t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t tp -> IO (Expr t tp)) -> Expr t tp -> IO (Expr t tp)
forall a b. (a -> b) -> a -> b
$! NonceAppExpr t tp -> Expr t tp
forall t (tp :: BaseType). NonceAppExpr t tp -> Expr t tp
NonceAppExpr (NonceAppExpr t tp -> Expr t tp) -> NonceAppExpr t tp -> Expr t tp
forall a b. (a -> b) -> a -> b
$ NonceAppExprCtor :: forall t (tp :: BaseType).
Nonce t tp
-> ProgramLoc
-> NonceApp t (Expr t) tp
-> AbstractValue tp
-> NonceAppExpr t tp
NonceAppExprCtor { nonceExprId :: Nonce t tp
nonceExprId = Nonce t tp
n
                                          , nonceExprLoc :: ProgramLoc
nonceExprLoc = ProgramLoc
pc
                                          , nonceExprApp :: NonceApp t (Expr t) tp
nonceExprApp = NonceApp t (Expr t) tp
p
                                          , nonceExprAbsValue :: AbstractValue tp
nonceExprAbsValue = AbstractValue tp
v
                                          }

------------------------------------------------------------------------
-- Cached storage

cachedNonceExpr :: NonceGenerator IO t
               -> PH.HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
               -> ProgramLoc
               -> NonceApp t (Expr t) tp
               -> AbstractValue tp
               -> IO (Expr t tp)
cachedNonceExpr :: NonceGenerator IO t
-> HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
-> ProgramLoc
-> NonceApp t (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
cachedNonceExpr NonceGenerator IO t
g HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
h ProgramLoc
pc NonceApp t (Expr t) tp
p AbstractValue tp
v = do
  Maybe (Expr t tp)
me <- ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp)))
-> ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp))
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
-> NonceApp t (Expr t) tp -> ST RealWorld (Maybe (Expr t tp))
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> ST s (Maybe (val tp))
PH.lookup HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
h NonceApp t (Expr t) tp
p
  case Maybe (Expr t tp)
me of
    Just Expr t tp
e -> Expr t tp -> IO (Expr t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t tp
e
    Maybe (Expr t tp)
Nothing -> do
      Nonce t tp
n <- NonceGenerator IO t -> IO (Nonce t tp)
forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce NonceGenerator IO t
g
      let e :: Expr t tp
e = NonceAppExpr t tp -> Expr t tp
forall t (tp :: BaseType). NonceAppExpr t tp -> Expr t tp
NonceAppExpr (NonceAppExpr t tp -> Expr t tp) -> NonceAppExpr t tp -> Expr t tp
forall a b. (a -> b) -> a -> b
$ NonceAppExprCtor :: forall t (tp :: BaseType).
Nonce t tp
-> ProgramLoc
-> NonceApp t (Expr t) tp
-> AbstractValue tp
-> NonceAppExpr t tp
NonceAppExprCtor { nonceExprId :: Nonce t tp
nonceExprId = Nonce t tp
n
                                            , nonceExprLoc :: ProgramLoc
nonceExprLoc = ProgramLoc
pc
                                            , nonceExprApp :: NonceApp t (Expr t) tp
nonceExprApp = NonceApp t (Expr t) tp
p
                                            , nonceExprAbsValue :: AbstractValue tp
nonceExprAbsValue = AbstractValue tp
v
                                            }
      Expr t tp -> IO () -> IO ()
seq Expr t tp
e (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
-> NonceApp t (Expr t) tp -> Expr t tp -> ST RealWorld ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
h NonceApp t (Expr t) tp
p Expr t tp
e
      Expr t tp -> IO (Expr t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t tp -> IO (Expr t tp)) -> Expr t tp -> IO (Expr t tp)
forall a b. (a -> b) -> a -> b
$! Expr t tp
e


cachedAppExpr :: forall t tp
               . NonceGenerator IO t
              -> PH.HashTable RealWorld (App (Expr t)) (Expr t)
              -> ProgramLoc
              -> App (Expr t) tp
              -> AbstractValue tp
              -> IO (Expr t tp)
cachedAppExpr :: NonceGenerator IO t
-> HashTable RealWorld (App (Expr t)) (Expr t)
-> ProgramLoc
-> App (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
cachedAppExpr NonceGenerator IO t
g HashTable RealWorld (App (Expr t)) (Expr t)
h ProgramLoc
pc App (Expr t) tp
a AbstractValue tp
v = do
  Maybe (Expr t tp)
me <- ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp)))
-> ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp))
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (App (Expr t)) (Expr t)
-> App (Expr t) tp -> ST RealWorld (Maybe (Expr t tp))
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> ST s (Maybe (val tp))
PH.lookup HashTable RealWorld (App (Expr t)) (Expr t)
h App (Expr t) tp
a
  case Maybe (Expr t tp)
me of
    Just Expr t tp
e -> Expr t tp -> IO (Expr t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t tp
e
    Maybe (Expr t tp)
Nothing -> do
      Nonce t tp
n <- NonceGenerator IO t -> IO (Nonce t tp)
forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce NonceGenerator IO t
g
      let e :: Expr t tp
e = Nonce t tp
-> ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> Expr t tp
forall t (tp :: BaseType).
Nonce t tp
-> ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> Expr t tp
mkExpr Nonce t tp
n ProgramLoc
pc App (Expr t) tp
a AbstractValue tp
v
      Expr t tp -> IO () -> IO ()
seq Expr t tp
e (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (App (Expr t)) (Expr t)
-> App (Expr t) tp -> Expr t tp -> ST RealWorld ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld (App (Expr t)) (Expr t)
h App (Expr t) tp
a Expr t tp
e
      Expr t tp -> IO (Expr t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t tp
e

-- | Create a storage that does hash consing.
newCachedStorage :: forall t
                  . NonceGenerator IO t
                 -> Int
                 -> IO (ExprAllocator t)
newCachedStorage :: NonceGenerator IO t -> Int -> IO (ExprAllocator t)
newCachedStorage NonceGenerator IO t
g Int
sz = ST RealWorld (ExprAllocator t) -> IO (ExprAllocator t)
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (ExprAllocator t) -> IO (ExprAllocator t))
-> ST RealWorld (ExprAllocator t) -> IO (ExprAllocator t)
forall a b. (a -> b) -> a -> b
$ do
  HashTable RealWorld (App (Expr t)) (Expr t)
appCache  <- Int -> ST RealWorld (HashTable RealWorld (App (Expr t)) (Expr t))
forall k1 s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized Int
sz
  HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
predCache <- Int
-> ST
     RealWorld (HashTable RealWorld (NonceApp t (Expr t)) (Expr t))
forall k1 s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized Int
sz
  ExprAllocator t -> ST RealWorld (ExprAllocator t)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprAllocator t -> ST RealWorld (ExprAllocator t))
-> ExprAllocator t -> ST RealWorld (ExprAllocator t)
forall a b. (a -> b) -> a -> b
$ ExprAllocator :: forall t.
(forall (tp :: BaseType).
 ProgramLoc
 -> App (Expr t) tp -> AbstractValue tp -> IO (Expr t tp))
-> (forall (tp :: BaseType).
    ProgramLoc
    -> NonceApp t (Expr t) tp -> AbstractValue tp -> IO (Expr t tp))
-> ExprAllocator t
ExprAllocator { appExpr :: forall (tp :: BaseType).
ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
appExpr = NonceGenerator IO t
-> HashTable RealWorld (App (Expr t)) (Expr t)
-> ProgramLoc
-> App (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
forall t (tp :: BaseType).
NonceGenerator IO t
-> HashTable RealWorld (App (Expr t)) (Expr t)
-> ProgramLoc
-> App (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
cachedAppExpr NonceGenerator IO t
g HashTable RealWorld (App (Expr t)) (Expr t)
appCache
                        , nonceExpr :: forall (tp :: BaseType).
ProgramLoc
-> NonceApp t (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
nonceExpr = NonceGenerator IO t
-> HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
-> ProgramLoc
-> NonceApp t (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
forall t (tp :: BaseType).
NonceGenerator IO t
-> HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
-> ProgramLoc
-> NonceApp t (Expr t) tp
-> AbstractValue tp
-> IO (Expr t tp)
cachedNonceExpr NonceGenerator IO t
g HashTable RealWorld (NonceApp t (Expr t)) (Expr t)
predCache
                        }


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Creates a new bound var.
sbMakeBoundVar :: ExprBuilder t st fs
               -> SolverSymbol
               -> BaseTypeRepr tp
               -> VarKind
               -> Maybe (AbstractValue tp)
               -> IO (ExprBoundVar t tp)
sbMakeBoundVar :: ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp VarKind
k Maybe (AbstractValue tp)
absVal = do
  Nonce t tp
n  <- ExprBuilder t st fs -> IO (Nonce t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sym
  ProgramLoc
pc <- ExprBuilder t st fs -> IO ProgramLoc
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
  ExprBoundVar t tp -> IO (ExprBoundVar t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBoundVar t tp -> IO (ExprBoundVar t tp))
-> ExprBoundVar t tp -> IO (ExprBoundVar t tp)
forall a b. (a -> b) -> a -> b
$! BVar :: forall t (tp :: BaseType).
Nonce t tp
-> ProgramLoc
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> ExprBoundVar t tp
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 :: ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sb = NonceGenerator IO t -> IO (Nonce t tp)
forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce (ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
exprCounter ExprBuilder t st fs
sb)

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

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

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

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

------------------------------------------------------------------------
-- Configuration option for controlling how many disjoint ranges
-- should be allowed in bitvector domains.

-- | Maximum number of ranges in bitvector abstract domains.
--
--   This option is named \"backend.bvdomain_range_limit\"
bvdomainRangeLimitOption :: CFG.ConfigOption BaseIntegerType
bvdomainRangeLimitOption :: ConfigOption BaseIntegerType
bvdomainRangeLimitOption = BaseTypeRepr BaseIntegerType
-> String -> ConfigOption BaseIntegerType
forall (tp :: BaseType).
BaseTypeRepr tp -> String -> ConfigOption tp
CFG.configOption BaseTypeRepr BaseIntegerType
BaseIntegerRepr String
"backend.bvdomain_range_limit"

bvdomainRangeLimitDesc :: CFG.ConfigDesc
bvdomainRangeLimitDesc :: ConfigDesc
bvdomainRangeLimitDesc = ConfigOption BaseIntegerType
-> OptionStyle BaseIntegerType
-> Maybe (Doc Void)
-> Maybe (ConcreteVal BaseIntegerType)
-> ConfigDesc
forall (tp :: BaseType).
ConfigOption tp
-> OptionStyle tp
-> Maybe (Doc Void)
-> Maybe (ConcreteVal tp)
-> ConfigDesc
CFG.mkOpt ConfigOption BaseIntegerType
bvdomainRangeLimitOption OptionStyle BaseIntegerType
sty Maybe (Doc Void)
help (ConcreteVal BaseIntegerType -> Maybe (ConcreteVal BaseIntegerType)
forall a. a -> Maybe a
Just (Integer -> ConcreteVal BaseIntegerType
ConcreteInteger Integer
2))
  where sty :: OptionStyle BaseIntegerType
sty = Bound Integer -> OptionStyle BaseIntegerType
CFG.integerWithMinOptSty (Integer -> Bound Integer
forall r. r -> Bound r
CFG.Inclusive Integer
0)
        help :: Maybe (Doc Void)
help = Doc Void -> Maybe (Doc Void)
forall a. a -> Maybe a
Just Doc Void
"Maximum number of ranges in bitvector domains."

------------------------------------------------------------------------
-- Cache start size

-- | Starting size for element cache when caching is enabled.
--
--   This option is named \"backend.cache_start_size\"
cacheStartSizeOption :: CFG.ConfigOption BaseIntegerType
cacheStartSizeOption :: ConfigOption BaseIntegerType
cacheStartSizeOption = BaseTypeRepr BaseIntegerType
-> String -> ConfigOption BaseIntegerType
forall (tp :: BaseType).
BaseTypeRepr tp -> String -> ConfigOption tp
CFG.configOption BaseTypeRepr BaseIntegerType
BaseIntegerRepr String
"backend.cache_start_size"

-- | The configuration option for setting the size of the initial hash set
-- used by simple builder
cacheStartSizeDesc :: CFG.ConfigDesc
cacheStartSizeDesc :: ConfigDesc
cacheStartSizeDesc = ConfigOption BaseIntegerType
-> OptionStyle BaseIntegerType
-> Maybe (Doc Void)
-> Maybe (ConcreteVal BaseIntegerType)
-> ConfigDesc
forall (tp :: BaseType).
ConfigOption tp
-> OptionStyle tp
-> Maybe (Doc Void)
-> Maybe (ConcreteVal tp)
-> ConfigDesc
CFG.mkOpt ConfigOption BaseIntegerType
cacheStartSizeOption OptionStyle BaseIntegerType
sty Maybe (Doc Void)
help (ConcreteVal BaseIntegerType -> Maybe (ConcreteVal BaseIntegerType)
forall a. a -> Maybe a
Just (Integer -> ConcreteVal BaseIntegerType
ConcreteInteger Integer
100000))
  where sty :: OptionStyle BaseIntegerType
sty = Bound Integer -> OptionStyle BaseIntegerType
CFG.integerWithMinOptSty (Integer -> Bound Integer
forall r. r -> Bound r
CFG.Inclusive Integer
0)
        help :: Maybe (Doc Void)
help = Doc Void -> Maybe (Doc Void)
forall a. a -> Maybe a
Just Doc Void
"Starting size for element cache"

------------------------------------------------------------------------
-- Cache terms

-- | Indicates if we should cache terms.  When enabled, hash-consing
--   is used to find and deduplicate common subexpressions.
--
--   This option is named \"use_cache\"
cacheTerms :: CFG.ConfigOption BaseBoolType
cacheTerms :: ConfigOption BaseBoolType
cacheTerms = BaseTypeRepr BaseBoolType -> String -> ConfigOption BaseBoolType
forall (tp :: BaseType).
BaseTypeRepr tp -> String -> ConfigOption tp
CFG.configOption BaseTypeRepr BaseBoolType
BaseBoolRepr String
"use_cache"

cacheOptStyle ::
  NonceGenerator IO t ->
  IORef (ExprAllocator t) ->
  CFG.OptionSetting BaseIntegerType ->
  CFG.OptionStyle BaseBoolType
cacheOptStyle :: NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> OptionStyle BaseBoolType
cacheOptStyle NonceGenerator IO t
gen IORef (ExprAllocator t)
storageRef OptionSetting BaseIntegerType
szSetting =
  OptionStyle BaseBoolType
CFG.boolOptSty OptionStyle BaseBoolType
-> (OptionStyle BaseBoolType -> OptionStyle BaseBoolType)
-> OptionStyle BaseBoolType
forall a b. a -> (a -> b) -> b
& (Maybe (ConcreteVal BaseBoolType)
 -> ConcreteVal BaseBoolType -> IO OptionSetResult)
-> OptionStyle BaseBoolType -> OptionStyle BaseBoolType
forall (tp :: BaseType).
(Maybe (ConcreteVal tp) -> ConcreteVal tp -> IO OptionSetResult)
-> OptionStyle tp -> OptionStyle tp
CFG.set_opt_onset
        (\Maybe (ConcreteVal BaseBoolType)
mb ConcreteVal BaseBoolType
b -> Maybe Bool -> Bool -> IO ()
f ((ConcreteVal BaseBoolType -> Bool)
-> Maybe (ConcreteVal BaseBoolType) -> Maybe Bool
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ConcreteVal BaseBoolType -> Bool
fromConcreteBool Maybe (ConcreteVal BaseBoolType)
mb) (ConcreteVal BaseBoolType -> Bool
fromConcreteBool ConcreteVal BaseBoolType
b) IO () -> IO OptionSetResult -> IO OptionSetResult
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> OptionSetResult -> IO OptionSetResult
forall (m :: Type -> Type) a. Monad m => a -> m a
return OptionSetResult
CFG.optOK)
 where
 f :: Maybe Bool -> Bool -> IO ()
 f :: Maybe Bool -> Bool -> IO ()
f Maybe Bool
mb Bool
b | Maybe Bool
mb Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b = if Bool
b then IO ()
start else IO ()
stop
        | Bool
otherwise = () -> IO ()
forall (m :: Type -> Type) a. Monad m => a -> m a
return ()

 stop :: IO ()
stop  = do ExprAllocator t
s <- NonceGenerator IO t -> IO (ExprAllocator t)
forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage NonceGenerator IO t
gen
            IORef (ExprAllocator t) -> ExprAllocator t -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef (ExprAllocator t)
storageRef ExprAllocator t
s

 start :: IO ()
start = do Integer
sz <- OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt OptionSetting BaseIntegerType
szSetting
            ExprAllocator t
s <- NonceGenerator IO t -> Int -> IO (ExprAllocator t)
forall t. NonceGenerator IO t -> Int -> IO (ExprAllocator t)
newCachedStorage NonceGenerator IO t
gen (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
sz)
            IORef (ExprAllocator t) -> ExprAllocator t -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef (ExprAllocator t)
storageRef ExprAllocator t
s

cacheOptDesc ::
  NonceGenerator IO t ->
  IORef (ExprAllocator t) ->
  CFG.OptionSetting BaseIntegerType ->
  CFG.ConfigDesc
cacheOptDesc :: NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> ConfigDesc
cacheOptDesc NonceGenerator IO t
gen IORef (ExprAllocator t)
storageRef OptionSetting BaseIntegerType
szSetting =
  ConfigOption BaseBoolType
-> OptionStyle BaseBoolType
-> Maybe (Doc Void)
-> Maybe (ConcreteVal BaseBoolType)
-> ConfigDesc
forall (tp :: BaseType).
ConfigOption tp
-> OptionStyle tp
-> Maybe (Doc Void)
-> Maybe (ConcreteVal tp)
-> ConfigDesc
CFG.mkOpt
    ConfigOption BaseBoolType
cacheTerms
    (NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> OptionStyle BaseBoolType
forall t.
NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> OptionStyle BaseBoolType
cacheOptStyle NonceGenerator IO t
gen IORef (ExprAllocator t)
storageRef OptionSetting BaseIntegerType
szSetting)
    (Doc Void -> Maybe (Doc Void)
forall a. a -> Maybe a
Just Doc Void
"Use hash-consing during term construction")
    (ConcreteVal BaseBoolType -> Maybe (ConcreteVal BaseBoolType)
forall a. a -> Maybe a
Just (Bool -> ConcreteVal BaseBoolType
ConcreteBool Bool
False))


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 :: FloatModeRepr fm
-> st t -> NonceGenerator IO t -> IO (ExprBuilder t st (Flags fm))
newExprBuilder FloatModeRepr fm
floatMode st t
st NonceGenerator IO t
gen = do
  ExprAllocator t
es <- NonceGenerator IO t -> IO (ExprAllocator t)
forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage NonceGenerator IO t
gen

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

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

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

  ExprBuilder t st (Flags fm) -> IO (ExprBuilder t st (Flags fm))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st (Flags fm) -> IO (ExprBuilder t st (Flags fm)))
-> ExprBuilder t st (Flags fm) -> IO (ExprBuilder t st (Flags fm))
forall a b. (a -> b) -> a -> b
$! SB :: forall t (st :: Type -> Type) fs (fm :: FloatMode).
(fs ~ Flags fm) =>
BoolExpr t
-> BoolExpr t
-> RealExpr t
-> Config
-> Bool
-> OptionSetting BaseIntegerType
-> OptionSetting BaseIntegerType
-> OptionSetting BaseIntegerType
-> NonceGenerator IO t
-> IORef (ExprAllocator t)
-> IORef Integer
-> IORef ProgramLoc
-> st t
-> IORef (SymbolVarBimap t)
-> IORef
     (Map
        (SolverSymbol, Some (Assignment BaseTypeRepr))
        (SomeSymFn (ExprBuilder t st fs)))
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
-> IORef (Maybe (SolverEvent -> IO ()))
-> FloatModeRepr fm
-> ExprBuilder t st fs
SB { sbTrue :: BoolExpr t
sbTrue  = BoolExpr t
forall t. Expr t BaseBoolType
t
               , sbFalse :: BoolExpr t
sbFalse = BoolExpr t
forall t. Expr t BaseBoolType
f
               , sbZero :: RealExpr t
sbZero = RealExpr t
forall t. Expr t BaseRealType
z
               , sbConfiguration :: Config
sbConfiguration = Config
cfg
               , sbFloatReduce :: Bool
sbFloatReduce = Bool
True
               , sbUnaryThreshold :: OptionSetting BaseIntegerType
sbUnaryThreshold = OptionSetting BaseIntegerType
unarySetting
               , sbBVDomainRangeLimit :: OptionSetting BaseIntegerType
sbBVDomainRangeLimit = OptionSetting BaseIntegerType
domainRangeSetting
               , sbCacheStartSize :: OptionSetting BaseIntegerType
sbCacheStartSize = OptionSetting BaseIntegerType
cacheStartSetting
               , sbProgramLoc :: IORef ProgramLoc
sbProgramLoc = IORef ProgramLoc
loc_ref
               , exprCounter :: NonceGenerator IO t
exprCounter = NonceGenerator IO t
gen
               , curAllocator :: IORef (ExprAllocator t)
curAllocator = 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 :: ExprBuilder t st fs -> IO (SymbolVarBimap t)
getSymbolVarBimap ExprBuilder t st fs
sym = IORef (SymbolVarBimap t) -> IO (SymbolVarBimap t)
forall a. IORef a -> IO a
readIORef (ExprBuilder t st fs -> IORef (SymbolVarBimap t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings ExprBuilder t st fs
sym)

-- | Stop caching applications in backend.
stopCaching :: ExprBuilder t st fs -> IO ()
stopCaching :: ExprBuilder t st fs -> IO ()
stopCaching ExprBuilder t st fs
sb = do
  ExprAllocator t
s <- NonceGenerator IO t -> IO (ExprAllocator t)
forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage (ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
exprCounter ExprBuilder t st fs
sb)
  IORef (ExprAllocator t) -> ExprAllocator t -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef (ExprBuilder t st fs -> IORef (ExprAllocator t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
curAllocator 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 :: ExprBuilder t st fs -> IO ()
startCaching ExprBuilder t st fs
sb = do
  Integer
sz <- OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize ExprBuilder t st fs
sb)
  ExprAllocator t
s <- NonceGenerator IO t -> Int -> IO (ExprAllocator t)
forall t. NonceGenerator IO t -> Int -> IO (ExprAllocator t)
newCachedStorage (ExprBuilder t st fs -> NonceGenerator IO t
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
exprCounter ExprBuilder t st fs
sb) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
sz)
  IORef (ExprAllocator t) -> ExprAllocator t -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef (ExprBuilder t st fs -> IORef (ExprAllocator t)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
curAllocator 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 :: (NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
    -> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp NatRepr w -> BV w -> BV w -> BV w
f NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w)
c ExprBuilder t st fs
sb BVExpr t w
x BVExpr t w
y = do
  let w :: NatRepr w
w = BVExpr t w -> NatRepr w
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth BVExpr t w
x
  case (BVExpr t w -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV BVExpr t w
x, BVExpr t w -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV BVExpr t w
y) of
    (Just BV w
i, Just BV w
j) | BV w
j BV w -> BV w -> Bool
forall a. Eq a => a -> a -> Bool
/= NatRepr w -> BV w
forall (w :: Nat). NatRepr w -> BV w
BV.zero NatRepr w
w -> ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Nat).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr w
w (BV w -> IO (SymBV (ExprBuilder t st fs) w))
-> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> BV w -> BV w
f NatRepr w
w BV w
i BV w
j
    (Maybe (BV w), Maybe (BV w))
_ -> ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (BVExpr t w)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (App (Expr t) (BaseBVType w) -> IO (BVExpr t w))
-> App (Expr t) (BaseBVType w) -> IO (BVExpr t w)
forall a b. (a -> b) -> a -> b
$ NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w)
c NatRepr w
w BVExpr t w
x BVExpr t w
y

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

symbolicIndices :: forall sym ctx
                 . IsExprBuilder sym
                => sym
                -> Ctx.Assignment IndexLit ctx
                -> IO (Ctx.Assignment (SymExpr sym) ctx)
symbolicIndices :: sym -> Assignment IndexLit ctx -> IO (Assignment (SymExpr sym) ctx)
symbolicIndices sym
sym = (forall (x :: BaseType). IndexLit x -> IO (SymExpr sym x))
-> forall (x :: Ctx BaseType).
   Assignment IndexLit x -> IO (Assignment (SymExpr sym) x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC forall (x :: BaseType). IndexLit x -> IO (SymExpr sym x)
f
  where f :: IndexLit tp -> IO (SymExpr sym tp)
        f :: IndexLit tp -> IO (SymExpr sym tp)
f (IntIndexLit Integer
n)  = sym -> Integer -> IO (SymInteger sym)
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym Integer
n
        f (BVIndexLit NatRepr w
w BV w
i) = sym -> NatRepr w -> BV w -> IO (SymBV sym w)
forall sym (w :: Nat).
(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 :: ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym ExprSymFn t args ret
f Assignment (Expr t) args
args =
  case ExprSymFn t args ret -> SymFnInfo t args ret
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args ret
f of
    UninterpFnInfo{} ->
      ExprBuilder t st fs -> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) ret -> IO (Expr t ret))
-> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$! ExprSymFn t args ret
-> Assignment (Expr t) args -> NonceApp t (Expr t) ret
forall t (args :: Ctx BaseType) (ret :: BaseType)
       (e :: BaseType -> Type).
ExprSymFn t args ret -> Assignment e args -> NonceApp t e ret
FnApp ExprSymFn t args ret
f Assignment (Expr t) args
args
    DefinedFnInfo Assignment (ExprBoundVar t) args
bound_vars Expr t ret
e UnfoldPolicy
_ -> do
      ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
forall t (st :: Type -> Type) fs (ret :: BaseType)
       (args :: Ctx BaseType).
ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
evalBoundVars ExprBuilder t st fs
sym Expr t ret
e Assignment (ExprBoundVar t) args
bound_vars Assignment (Expr t) args
args
    MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
fn_id Assignment (ExprBoundVar t) args
_ Expr t ret
_ -> do
      MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
-> ExprBuilder t st fs
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsExprBuilder sym =>
MatlabSolverFn (SymExpr sym) args ret
-> sym -> Assignment (SymExpr sym) args -> IO (SymExpr sym ret)
evalMatlabSolverFn MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
MatlabSolverFn (Expr t) args ret
fn_id ExprBuilder t st fs
sym Assignment (SymExpr (ExprBuilder t st fs)) args
Assignment (Expr t) args
args

-- | This runs one action, and if it returns a value different from the input,
-- then it runs the second.  Otherwise it returns the result value passed in.
--
-- It is used when an action may modify a value, and we only want to run a
-- second action if the value changed.
runIfChanged :: Eq e
             => e
             -> (e -> IO e) -- ^ First action to run
             -> r           -- ^ Result if no change.
             -> (e -> IO r) -- ^ Second action to run
             -> IO r
runIfChanged :: e -> (e -> IO e) -> r -> (e -> IO r) -> IO r
runIfChanged e
x e -> IO e
f r
unChanged e -> IO r
onChange = do
  e
y <- e -> IO e
f e
x
  if e
x e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
y then
    r -> IO r
forall (m :: Type -> Type) a. Monad m => a -> m a
return r
unChanged
   else
    e -> IO 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 :: HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar HashTable RealWorld (Expr t) (Expr t)
tbl ExprBoundVar t tp
v = do
  let e :: Expr t tp
e = ExprBoundVar t tp -> Expr t tp
forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t tp
v
  Maybe (Expr t tp)
mr <- ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp)))
-> ST RealWorld (Maybe (Expr t tp)) -> IO (Maybe (Expr t tp))
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (Expr t) (Expr t)
-> Expr t tp -> ST RealWorld (Maybe (Expr t tp))
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> ST s (Maybe (val tp))
PH.lookup HashTable RealWorld (Expr t) (Expr t)
tbl Expr t tp
e
  case Maybe (Expr t tp)
mr of
    Just Expr t tp
r -> do
      Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Expr t tp
r Expr t tp -> Expr t tp -> Bool
forall a. Eq a => a -> a -> Bool
/= Expr t tp
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        String -> IO ()
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Simulator internal error; do not support rebinding variables."
    Maybe (Expr t tp)
Nothing -> do
      -- Bind variable to itself to ensure we catch when it is used again.
      ST RealWorld () -> IO ()
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld () -> IO ()) -> ST RealWorld () -> IO ()
forall a b. (a -> b) -> a -> b
$ HashTable RealWorld (Expr t) (Expr t)
-> Expr t tp -> Expr t tp -> ST RealWorld ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld (Expr t) (Expr t)
tbl Expr t tp
e Expr t tp
e


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

-- | Data structure used for caching evaluation.
data EvalHashTables t
   = EvalHashTables { EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable :: !(PH.HashTable RealWorld (Expr t) (Expr 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 :: 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 =
  case ExprSymFn t idx ret -> SymFnInfo t idx ret
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t idx ret
f of
    UninterpFnInfo{} -> (Bool, ExprSymFn t idx ret) -> IO (Bool, ExprSymFn t idx ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
False, ExprSymFn t idx ret
f)
    DefinedFnInfo Assignment (ExprBoundVar t) idx
vars Expr t ret
e UnfoldPolicy
evalFn -> do
      let n :: Nonce t (idx ::> ret)
n = ExprSymFn t idx ret -> Nonce t (idx ::> ret)
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t idx ret
f
      let nm :: SolverSymbol
nm = ExprSymFn t idx ret -> SolverSymbol
forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName ExprSymFn t idx ret
f
      CachedSymFn Bool
changed ExprSymFn t a r
f' <-
        HashTable RealWorld (Nonce t) (CachedSymFn t)
-> Nonce t (idx ::> ret)
-> IO (CachedSymFn t (idx ::> ret))
-> IO (CachedSymFn t (idx ::> ret))
forall k (k :: k -> Type) (a :: k -> Type) (tp :: k).
(HashableF k, TestEquality k) =>
HashTable RealWorld k a -> k tp -> IO (a tp) -> IO (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
forall t.
EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable EvalHashTables t
tbl) Nonce t (idx ::> ret)
n (IO (CachedSymFn t (idx ::> ret))
 -> IO (CachedSymFn t (idx ::> ret)))
-> IO (CachedSymFn t (idx ::> ret))
-> IO (CachedSymFn t (idx ::> ret))
forall a b. (a -> b) -> a -> b
$ do
          (forall (x :: BaseType). ExprBoundVar t x -> IO ())
-> Assignment (ExprBoundVar t) idx -> IO ()
forall k l (t :: (k -> Type) -> l -> Type) (m :: Type -> Type)
       (f :: k -> Type) a.
(FoldableFC t, Applicative m) =>
(forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
traverseFC_ (HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t x -> IO ()
forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbl)) Assignment (ExprBoundVar t) idx
vars
          Expr t ret
e' <- EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbl ExprBuilder t st fs
sym Expr t ret
e
          if Expr t ret
e Expr t ret -> Expr t ret -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t ret
e' then
            CachedSymFn t (idx ::> ret) -> IO (CachedSymFn t (idx ::> ret))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (CachedSymFn t (idx ::> ret) -> IO (CachedSymFn t (idx ::> ret)))
-> CachedSymFn t (idx ::> ret) -> IO (CachedSymFn t (idx ::> ret))
forall a b. (a -> b) -> a -> b
$! Bool -> ExprSymFn t idx ret -> CachedSymFn t (idx ::> ret)
forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
False ExprSymFn t idx ret
f
           else
            Bool -> ExprSymFn t idx ret -> CachedSymFn t (idx ::> ret)
forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
True (ExprSymFn t idx ret -> CachedSymFn t (idx ::> ret))
-> IO (ExprSymFn t idx ret) -> IO (CachedSymFn t (idx ::> ret))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> SolverSymbol
-> Assignment (BoundVar (ExprBuilder t st fs)) idx
-> SymExpr (ExprBuilder t st fs) ret
-> UnfoldPolicy
-> IO (SymFn (ExprBuilder t st fs) idx ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment (BoundVar sym) args
-> SymExpr sym ret
-> UnfoldPolicy
-> IO (SymFn sym args ret)
definedFn ExprBuilder t st fs
sym SolverSymbol
nm Assignment (BoundVar (ExprBuilder t st fs)) idx
Assignment (ExprBoundVar t) idx
vars SymExpr (ExprBuilder t st fs) ret
Expr t ret
e' UnfoldPolicy
evalFn
      (Bool, ExprSymFn t a r) -> IO (Bool, ExprSymFn t a r)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
changed, ExprSymFn t a r
f')
    MatlabSolverFnInfo{} -> (Bool, ExprSymFn t idx ret) -> IO (Bool, ExprSymFn t idx ret)
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' :: EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t ret
e0 =
  case Expr t ret
e0 of
    SemiRingLiteral{} -> Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    StringExpr{} -> Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    BoolExpr{} -> Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    FloatExpr{} -> Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
    AppExpr AppExpr t ret
ae -> HashTable RealWorld (Expr t) (Expr t)
-> Expr t ret -> IO (Expr t ret) -> IO (Expr t ret)
forall k (k :: k -> Type) (a :: k -> Type) (tp :: k).
(HashableF k, TestEquality k) =>
HashTable RealWorld k a -> k tp -> IO (a tp) -> IO (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 (IO (Expr t ret) -> IO (Expr t ret))
-> IO (Expr t ret) -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$ do
      let a :: App (Expr t) ret
a = AppExpr t ret -> App (Expr t) ret
forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t ret
ae
      App (Expr t) ret
a' <- (forall (tp :: BaseType). Expr t tp -> IO (Expr t tp))
-> App (Expr t) ret -> IO (App (Expr t) ret)
forall (m :: Type -> Type) (f :: BaseType -> Type)
       (e :: BaseType -> Type) (utp :: BaseType).
(Applicative m, OrdF f, Eq (f BaseBoolType), HashableF f,
 HasAbsValue f) =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> App e utp -> m (App f utp)
traverseApp (EvalHashTables t
-> ExprBuilder t st fs -> Expr t tp -> IO (Expr t tp)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) App (Expr t) ret
a
      if App (Expr t) ret
a App (Expr t) ret -> App (Expr t) ret -> Bool
forall a. Eq a => a -> a -> Bool
== App (Expr t) ret
a' then
        Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
       else
        ExprBuilder t st fs
-> (forall (w :: Nat).
    (1 <= w) =>
    ExprBuilder t st fs
    -> UnaryBV (Pred (ExprBuilder t st fs)) w
    -> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w)))
-> App (SymExpr (ExprBuilder t st fs)) ret
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> (forall (w :: Nat).
    (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 :: Nat).
(1 <= w) =>
ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (SymExpr (ExprBuilder t st fs) (BaseBVType w))
forall (w :: Nat) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary App (SymExpr (ExprBuilder t st fs)) ret
App (Expr t) ret
a'
    NonceAppExpr NonceAppExpr t ret
ae -> HashTable RealWorld (Expr t) (Expr t)
-> Expr t ret -> IO (Expr t ret) -> IO (Expr t ret)
forall k (k :: k -> Type) (a :: k -> Type) (tp :: k).
(HashableF k, TestEquality k) =>
HashTable RealWorld k a -> k tp -> IO (a tp) -> IO (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 (IO (Expr t ret) -> IO (Expr t ret))
-> IO (Expr t ret) -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$ do
      case NonceAppExpr t ret -> NonceApp t (Expr t) ret
forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp NonceAppExpr t ret
ae of
        Annotation BaseTypeRepr ret
tpr Nonce t ret
n Expr t ret
a -> do
          Expr t ret
a' <- EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t ret
a
          if Expr t ret
a Expr t ret -> Expr t ret -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t ret
a' then
            Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
          else
            ExprBuilder t st fs -> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (NonceApp t (Expr t) ret -> IO (Expr t ret))
-> NonceApp t (Expr t) ret -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$ BaseTypeRepr ret
-> Nonce t ret -> Expr t ret -> NonceApp t (Expr t) ret
forall (tp :: BaseType) t (e :: BaseType -> Type).
BaseTypeRepr tp -> Nonce t tp -> e tp -> NonceApp t e tp
Annotation BaseTypeRepr ret
tpr Nonce t ret
n Expr t ret
a'
        Forall ExprBoundVar t tp
v Expr t BaseBoolType
e -> do
          HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) ExprBoundVar t tp
v
          -- Regenerate forallPred if e is changed by evaluation.
          Expr t BaseBoolType
-> (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> Expr t ret
-> (Expr t BaseBoolType -> IO (Expr t ret))
-> IO (Expr t ret)
forall e r. Eq e => e -> (e -> IO e) -> r -> (e -> IO r) -> IO r
runIfChanged Expr t BaseBoolType
e (EvalHashTables t
-> ExprBuilder t st fs
-> Expr t BaseBoolType
-> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) Expr t ret
e0 (ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
forallPred ExprBuilder t st fs
sym BoundVar (ExprBuilder t st fs) tp
ExprBoundVar t tp
v)
        Exists ExprBoundVar t tp
v Expr t BaseBoolType
e -> do
          HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) ExprBoundVar t tp
v
          -- Regenerate forallPred if e is changed by evaluation.
          Expr t BaseBoolType
-> (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> Expr t ret
-> (Expr t BaseBoolType -> IO (Expr t ret))
-> IO (Expr t ret)
forall e r. Eq e => e -> (e -> IO e) -> r -> (e -> IO r) -> IO r
runIfChanged Expr t BaseBoolType
e (EvalHashTables t
-> ExprBuilder t st fs
-> Expr t BaseBoolType
-> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) Expr t ret
e0 (ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
existsPred ExprBuilder t st fs
sym BoundVar (ExprBuilder t st fs) tp
ExprBoundVar t tp
v)
        ArrayFromFn ExprSymFn t (idx ::> itp) ret
f -> do
          (Bool
changed, ExprSymFn t (idx ::> itp) ret
f') <- EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t (idx ::> itp) ret
-> IO (Bool, ExprSymFn t (idx ::> itp) ret)
forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
       (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) ret
f
          if Bool -> Bool
not Bool
changed then
            Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) ret
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) ret)
forall sym (idx :: Ctx BaseType) (itp :: BaseType)
       (ret :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (idx ::> itp) ret
-> IO (SymArray sym (idx ::> itp) ret)
arrayFromFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (idx ::> itp) ret
ExprSymFn t (idx ::> itp) ret
f'
        MapOverArrays ExprSymFn t (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args -> do
          (Bool
changed, ExprSymFn t (ctx ::> d) r
f') <- EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t (ctx ::> d) r
-> IO (Bool, ExprSymFn t (ctx ::> d) r)
forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
       (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t (ctx ::> d) r
f
          let evalWrapper :: ArrayResultWrapper (Expr t) (idx ::> itp) utp
                          -> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
              evalWrapper :: ArrayResultWrapper (Expr t) (idx ::> itp) utp
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
evalWrapper (ArrayResultWrapper Expr t (BaseArrayType (idx ::> itp) utp)
a) =
                Expr t (BaseArrayType (idx ::> itp) utp)
-> ArrayResultWrapper (Expr t) (idx ::> itp) utp
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
ArrayResultWrapper (Expr t (BaseArrayType (idx ::> itp) utp)
 -> ArrayResultWrapper (Expr t) (idx ::> itp) utp)
-> IO (Expr t (BaseArrayType (idx ::> itp) utp))
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> EvalHashTables t
-> ExprBuilder t st fs
-> Expr t (BaseArrayType (idx ::> itp) utp)
-> IO (Expr t (BaseArrayType (idx ::> itp) utp))
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t (BaseArrayType (idx ::> itp) utp)
a
          Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args' <- (forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (idx ::> itp) x
 -> IO (ArrayResultWrapper (Expr t) (idx ::> itp) x))
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> IO
     (Assignment
        (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d))
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)
forall (x :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) x
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) x)
evalWrapper Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args
          if Bool -> Bool
not Bool
changed Bool -> Bool -> Bool
&& Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Bool
forall a. Eq a => a -> a -> Bool
== Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args' then
            Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
     (ctx ::> d)
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) r)
forall sym (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
       (idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr sym) (idx ::> itp)) (ctx ::> d)
-> IO (SymArray sym (idx ::> itp) r)
arrayMap ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
ExprSymFn t (ctx ::> d) r
f' Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args'
        ArrayTrueOnEntries ExprSymFn t (idx ::> itp) BaseBoolType
f Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a -> do
          (Bool
changed, ExprSymFn t (idx ::> itp) BaseBoolType
f') <- EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t (idx ::> itp) BaseBoolType
-> IO (Bool, ExprSymFn t (idx ::> itp) BaseBoolType)
forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
       (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) BaseBoolType
f
          Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a' <- EvalHashTables t
-> ExprBuilder t st fs
-> Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
-> IO (Expr t (BaseArrayType (idx ::> itp) BaseBoolType))
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a
          if Bool -> Bool
not Bool
changed Bool -> Bool -> Bool
&& Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
-> Expr t (BaseArrayType (idx ::> itp) BaseBoolType) -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a' then
            Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
-> SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
forall sym (idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (idx ::> itp) BaseBoolType
-> SymArray sym (idx ::> itp) BaseBoolType
-> IO (Pred sym)
arrayTrueOnEntries ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
ExprSymFn t (idx ::> itp) BaseBoolType
f' SymArray (ExprBuilder t st fs) (idx ::> itp) BaseBoolType
Expr t (BaseArrayType (idx ::> itp) BaseBoolType)
a'
        FnApp ExprSymFn t args ret
f Assignment (Expr t) args
a -> do
          (Bool
changed, ExprSymFn t args ret
f') <- EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t args ret
-> IO (Bool, ExprSymFn t args ret)
forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
       (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t args ret
f
          Assignment (Expr t) args
a' <- (forall (tp :: BaseType). Expr t tp -> IO (Expr t tp))
-> Assignment (Expr t) args -> IO (Assignment (Expr t) 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 (EvalHashTables t
-> ExprBuilder t st fs -> Expr t x -> IO (Expr t x)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) Assignment (Expr t) args
a
          if Bool -> Bool
not Bool
changed Bool -> Bool -> Bool
&& Assignment (Expr t) args
a Assignment (Expr t) args -> Assignment (Expr t) args -> Bool
forall a. Eq a => a -> a -> Bool
== Assignment (Expr t) args
a' then
            Expr t ret -> IO (Expr t ret)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
           else
            ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) args ret
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) args ret
ExprSymFn t args ret
f' Assignment (SymExpr (ExprBuilder t st fs)) args
Assignment (Expr t) args
a'

    BoundVarExpr{} -> HashTable RealWorld (Expr t) (Expr t)
-> Expr t ret -> IO (Expr t ret) -> IO (Expr t ret)
forall k (k :: k -> Type) (a :: k -> Type) (tp :: k).
(HashableF k, TestEquality k) =>
HashTable RealWorld k a -> k tp -> IO (a tp) -> IO (a tp)
cachedEval (EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 (IO (Expr t ret) -> IO (Expr t ret))
-> IO (Expr t ret) -> IO (Expr t ret)
forall a b. (a -> b) -> a -> b
$ Expr t ret -> IO (Expr t ret)
forall (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 :: Assignment key args
-> Assignment val args -> ST s (HashTable s key val)
initHashTable Assignment key args
keys Assignment val args
vals = do
  let sz :: Size args
sz = Assignment key args -> Size args
forall k (f :: k -> Type) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size Assignment key args
keys
  HashTable s key val
tbl <- Int -> ST s (HashTable s key val)
forall k1 s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized (Size args -> Int
forall k (ctx :: Ctx k). Size ctx -> Int
Ctx.sizeInt Size args
sz)
  Size args
-> (forall (tp :: k). Index args tp -> ST s ()) -> ST s ()
forall k (ctx :: Ctx k) (m :: Type -> Type).
Applicative m =>
Size ctx -> (forall (tp :: k). Index ctx tp -> m ()) -> m ()
Ctx.forIndexM Size args
sz ((forall (tp :: k). Index args tp -> ST s ()) -> ST s ())
-> (forall (tp :: k). Index args tp -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Index args tp
i -> do
    HashTable s key val -> key tp -> val tp -> ST s ()
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable s key val
tbl (Assignment key args
keys Assignment key args -> Index args tp -> key tp
forall k (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index args tp
i) (Assignment val args
vals Assignment val args -> Index args tp -> val tp
forall k (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index args tp
i)
  HashTable s key val -> ST s (HashTable s key val)
forall (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 :: ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
evalBoundVars ExprBuilder t st fs
sym Expr t ret
e Assignment (ExprBoundVar t) args
vars Assignment (Expr t) args
exprs = do
  HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
-> IO (HashTable RealWorld (Expr t) (Expr t))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
 -> IO (HashTable RealWorld (Expr t) (Expr t)))
-> ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
-> IO (HashTable RealWorld (Expr t) (Expr t))
forall a b. (a -> b) -> a -> b
$ Assignment (Expr t) args
-> Assignment (Expr t) args
-> ST RealWorld (HashTable RealWorld (Expr t) (Expr t))
forall k (key :: k -> Type) (args :: Ctx k) (val :: k -> Type) s.
(HashableF key, TestEquality key) =>
Assignment key args
-> Assignment val args -> ST s (HashTable s key val)
initHashTable ((forall (x :: BaseType). ExprBoundVar t x -> Expr t x)
-> Assignment (ExprBoundVar t) args -> Assignment (Expr t) args
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
forall (x :: BaseType). ExprBoundVar t x -> Expr t x
BoundVarExpr Assignment (ExprBoundVar t) args
vars) Assignment (Expr t) args
exprs
  HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl  <- ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
-> IO (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall a. ST RealWorld a -> IO a
stToIO (ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
 -> IO (HashTable RealWorld (Nonce t) (CachedSymFn t)))
-> ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
-> IO (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall a b. (a -> b) -> a -> b
$ ST RealWorld (HashTable RealWorld (Nonce t) (CachedSymFn t))
forall k s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
  let tbls :: EvalHashTables t
tbls = EvalHashTables :: forall t.
HashTable RealWorld (Expr t) (Expr t)
-> HashTable RealWorld (Nonce t) (CachedSymFn t)
-> EvalHashTables t
EvalHashTables { exprTable :: HashTable RealWorld (Expr t) (Expr t)
exprTable = HashTable RealWorld (Expr t) (Expr t)
expr_tbl
                            , fnTable :: HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable  = HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl
                            }
  EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t ret
e

-- | 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 :: 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 tp
_ ArrayUpdateMap (Expr t) (i ::> itp) tp
entry_map Expr t (BaseArrayType (i ::> itp) tp)
def) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
  , Just Assignment IndexLit (d ::> tp)
cidx <- Maybe (Assignment IndexLit (d ::> tp))
mcidx =
      case Assignment IndexLit (d ::> tp)
-> ArrayUpdateMap (Expr t) (d ::> tp) tp -> Maybe (Expr t tp)
forall (ctx :: Ctx BaseType) (e :: BaseType -> Type)
       (tp :: BaseType).
Assignment IndexLit ctx -> ArrayUpdateMap e ctx tp -> Maybe (e tp)
AUM.lookup Assignment IndexLit (d ::> tp)
cidx ArrayUpdateMap (Expr t) (d ::> tp) tp
ArrayUpdateMap (Expr t) (i ::> itp) tp
entry_map of
        Just Expr t tp
v -> Expr t tp -> IO (Expr t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t tp
v
        Maybe (Expr t tp)
Nothing -> ExprBuilder t st fs
-> Expr t (BaseArrayType (i ::> itp) tp)
-> Maybe (Assignment IndexLit (i ::> itp))
-> Assignment (Expr t) (i ::> itp)
-> IO (Expr t tp)
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) tp)
def Maybe (Assignment IndexLit (d ::> tp))
Maybe (Assignment IndexLit (i ::> itp))
mcidx Assignment (Expr t) (d ::> tp)
Assignment (Expr t) (i ::> itp)
idx
    -- Evaluate function arrays on ground values.
  | Just (ArrayFromFn ExprSymFn t (idx ::> itp) ret
f) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (NonceApp t (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      ExprBuilder t st fs
-> ExprSymFn t (idx ::> itp) ret
-> Assignment (Expr t) (idx ::> itp)
-> IO (Expr t ret)
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)
Assignment (Expr t) (idx ::> itp)
idx

    -- Lookups on constant arrays just return value
  | Just (ConstantArray Assignment BaseTypeRepr (i ::> tp)
_ BaseTypeRepr b
_ Expr t b
v) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      Expr t b -> IO (Expr t b)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t b
v
    -- Lookups on mux arrays just distribute over mux.
  | Just (BaseIte BaseTypeRepr (BaseArrayType (d ::> tp) range)
_ Integer
_ Expr t BaseBoolType
p Expr t (BaseArrayType (d ::> tp) range)
x Expr t (BaseArrayType (d ::> tp) range)
y) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      Expr t range
xv <- ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
x Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
      Expr t range
yv <- ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
y Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
      ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymExpr (ExprBuilder t st fs) range
-> SymExpr (ExprBuilder t st fs) range
-> IO (SymExpr (ExprBuilder t st fs) range)
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)
Expr t BaseBoolType
p SymExpr (ExprBuilder t st fs) range
Expr t range
xv SymExpr (ExprBuilder t st fs) range
Expr t range
yv
  | Just (MapOverArrays ExprSymFn t (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (NonceApp t (Expr t) (BaseArrayType (d ::> tp) range))
forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
      let eval :: ArrayResultWrapper (Expr t) (d::>tp) utp
               -> IO (Expr t utp)
          eval :: ArrayResultWrapper (Expr t) (d ::> tp) utp -> IO (Expr t utp)
eval ArrayResultWrapper (Expr t) (d ::> tp) utp
a = ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) utp)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t utp)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym (ArrayResultWrapper (Expr t) (d ::> tp) utp
-> Expr t (BaseArrayType (d ::> tp) utp)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) (d ::> tp) utp
a) Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
      ExprBuilder t st fs
-> ExprSymFn t (ctx ::> d) r
-> Assignment (Expr t) (ctx ::> d)
-> IO (Expr t r)
forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym ExprSymFn t (ctx ::> d) r
f (Assignment (Expr t) (ctx ::> d) -> IO (Expr t r))
-> IO (Assignment (Expr t) (ctx ::> d)) -> IO (Expr t r)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (idx ::> itp) x -> IO (Expr t x))
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> IO (Assignment (Expr t) (ctx ::> d))
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)
forall (x :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) x -> IO (Expr t x)
eval Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args
    -- Create select index.
  | Bool
otherwise = do
    case Expr t (BaseArrayType (d ::> tp) range)
-> BaseTypeRepr (BaseArrayType (d ::> tp) range)
forall (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 ->
        ExprBuilder t st fs -> App (Expr t) xs -> IO (Expr t xs)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (BaseTypeRepr xs
-> Expr t (BaseArrayType (d ::> tp) xs)
-> Assignment (Expr t) (d ::> tp)
-> App (Expr t) xs
forall (b :: BaseType) (e :: BaseType -> Type) (i :: Ctx BaseType)
       (tp :: BaseType).
BaseTypeRepr b
-> e (BaseArrayType (i ::> tp) b)
-> Assignment e (i ::> tp)
-> App e b
SelectArray BaseTypeRepr xs
range Expr t (BaseArrayType (d ::> tp) range)
Expr t (BaseArrayType (d ::> tp) xs)
arr0 Assignment (Expr t) (d ::> tp)
idx)

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

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

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

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

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

bvUnary :: (1 <= w) => ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary :: ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sym UnaryBV (BoolExpr t) w
u
  -- BGS: We probably don't need to re-truncate the result, but
  -- until we refactor UnaryBV to use BV w instead of integer,
  -- that'll have to wait.
  | Just Integer
v <-  UnaryBV (BoolExpr t) w -> Maybe Integer
forall (p :: BaseType -> Type) (w :: Nat).
IsExpr p =>
UnaryBV (p BaseBoolType) w -> Maybe Integer
UnaryBV.asConstant UnaryBV (BoolExpr t) w
u = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Nat).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Nat). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
v)
  | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (BaseBVType w) -> IO (BVExpr t w)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (UnaryBV (BoolExpr t) w -> App (Expr t) (BaseBVType w)
forall (n :: Nat) (e :: BaseType -> Type).
(1 <= n) =>
UnaryBV (e BaseBoolType) n -> App e (BaseBVType n)
BVUnaryTerm UnaryBV (BoolExpr t) w
u)
  where w :: NatRepr w
w = UnaryBV (BoolExpr t) w -> NatRepr w
forall p (n :: Nat). 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 :: 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 (BoolExpr t) n
u) <- BVExpr t n -> Maybe (App (Expr t) (BaseBVType n))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BVExpr t n
e = UnaryBV (BoolExpr t) n -> Maybe (UnaryBV (BoolExpr t) n)
forall a. a -> Maybe a
Just UnaryBV (BoolExpr t) n
u
  | ?unaryThreshold::Int
Int
?unaryThreshold Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Maybe (UnaryBV (BoolExpr t) n)
forall a. Maybe a
Nothing
  | SemiRingLiteral (SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
w) Coefficient sr
v ProgramLoc
_ <- BVExpr t n
e = UnaryBV (BoolExpr t) n -> Maybe (UnaryBV (BoolExpr t) n)
forall a. a -> Maybe a
Just (UnaryBV (BoolExpr t) n -> Maybe (UnaryBV (BoolExpr t) n))
-> UnaryBV (BoolExpr t) n -> Maybe (UnaryBV (BoolExpr t) n)
forall a b. (a -> b) -> a -> b
$ ExprBuilder t st fs
-> NatRepr w -> Integer -> UnaryBV (Pred (ExprBuilder t st fs)) w
forall sym (n :: Nat).
IsExprBuilder sym =>
sym -> NatRepr n -> Integer -> UnaryBV (Pred sym) n
UnaryBV.constant ExprBuilder t st fs
sym NatRepr w
w (BV n -> Integer
forall (w :: Nat). BV w -> Integer
BV.asUnsigned BV n
Coefficient sr
v)
  | Bool
otherwise = Maybe (UnaryBV (BoolExpr t) n)
forall a. Maybe a
Nothing

-- | This create a unary bitvector representing if the size is not too large.
sbTryUnaryTerm :: (1 <= w, ?unaryThreshold :: Int)
               => ExprBuilder t st fs
               -> Maybe (IO (UnaryBV (BoolExpr t) w))
               -> IO (BVExpr t w)
               -> IO (BVExpr t w)
sbTryUnaryTerm :: ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (BVExpr t w)
-> IO (BVExpr t w)
sbTryUnaryTerm ExprBuilder t st fs
_sym Maybe (IO (UnaryBV (BoolExpr t) w))
Nothing IO (BVExpr t w)
fallback = IO (BVExpr t w)
fallback
sbTryUnaryTerm ExprBuilder t st fs
sym (Just IO (UnaryBV (BoolExpr t) w)
mku) IO (BVExpr t w)
fallback =
  do UnaryBV (BoolExpr t) w
u <- IO (UnaryBV (BoolExpr t) w)
mku
     if UnaryBV (BoolExpr t) w -> Int
forall p (n :: Nat). UnaryBV p n -> Int
UnaryBV.size UnaryBV (BoolExpr t) w
u Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ?unaryThreshold::Int
Int
?unaryThreshold then
       ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
forall (w :: Nat) 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 :: ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym SemiRingProduct (Expr t) sr
pd
  | SemiRingProduct (Expr t) sr -> Bool
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Bool
WSum.nullProd SemiRingProduct (Expr t) sr
pd = ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym (SemiRingProduct (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd) (SemiRingRepr sr -> Coefficient sr
forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.one (SemiRingProduct (Expr t) sr -> SemiRingRepr sr
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd))
  | Just Expr t (SemiRingBase sr)
v <- SemiRingProduct (Expr t) sr -> Maybe (Expr t (SemiRingBase sr))
forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Maybe (f (SemiRingBase sr))
WSum.asProdVar SemiRingProduct (Expr t) sr
pd = Expr t (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
v
  | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr)))
-> App (Expr t) (SemiRingBase sr) -> IO (Expr t (SemiRingBase sr))
forall a b. (a -> b) -> a -> b
$ SemiRingProduct (Expr t) sr -> App (Expr t) (SemiRingBase sr)
forall (e :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct e sr -> App e (SemiRingBase sr)
SemiRingProd SemiRingProduct (Expr t) sr
pd

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

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

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

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

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

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

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

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


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

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

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

  | Bool
otherwise =
      let sz :: Integer
sz = Integer
1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expr t bt -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t bt
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Expr t bt -> Integer
forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t bt
y in
      ExprBuilder t st fs -> App (Expr t) bt -> IO (Expr t bt)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (BaseTypeRepr bt
-> Integer
-> Expr t BaseBoolType
-> Expr t bt
-> Expr t bt
-> App (Expr t) bt
forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (Expr t bt -> BaseTypeRepr bt
forall (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 :: ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> (Expr t (SemiRingBase sr)
    -> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t BaseBoolType)
semiRingLe ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y
      -- Check for syntactic equality.
    | Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr) -> Expr t (SemiRingBase sr) -> Bool
forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

 merge :: (Expr t BaseBoolType, Expr t BaseBoolType)
-> (Expr t BaseBoolType, Expr t BaseBoolType)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
merge (Expr t BaseBoolType
nn1, Expr t BaseBoolType
np1) (Expr t BaseBoolType
nn2, Expr t BaseBoolType
np2) =
   do Expr t BaseBoolType
nn <- IO (IO (Expr t BaseBoolType)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym (Expr t BaseBoolType
 -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
nn1 Pred (ExprBuilder t st fs)
Expr t BaseBoolType
nn2 IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
np1 Pred (ExprBuilder t st fs)
Expr t BaseBoolType
np2)
      Expr t BaseBoolType
np <- IO (IO (Expr t BaseBoolType)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym (Expr t BaseBoolType
 -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
nn1 Pred (ExprBuilder t st fs)
Expr t BaseBoolType
np2 IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
np1 Pred (ExprBuilder t st fs)
Expr t BaseBoolType
nn2)
      (Expr t BaseBoolType, Expr t BaseBoolType)
-> IO (Expr t BaseBoolType, Expr t BaseBoolType)
forall (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 :: BaseTypeRepr (BaseArrayType (idx ::> itp) d)
-> Assignment BaseTypeRepr (idx ::> itp)
arrayResultIdxType (BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idx BaseTypeRepr xs
_) = Assignment BaseTypeRepr (idx ::> itp)
Assignment BaseTypeRepr (idx ::> tp)
idx

-- | This decomposes A ExprBuilder array expression into a set of indices that
-- have been updated, and an underlying index.
data ArrayMapView i f tp
   = ArrayMapView { ArrayMapView i f tp -> ArrayUpdateMap f i tp
_arrayMapViewIndices :: !(AUM.ArrayUpdateMap f i tp)
                  , 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 :: Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
viewArrayMap  Expr t (BaseArrayType i tp)
x
  | Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp
_ ArrayUpdateMap (Expr t) (i ::> itp) tp
m Expr t (BaseArrayType (i ::> itp) tp)
c) <- Expr t (BaseArrayType i tp)
-> Maybe (App (Expr t) (BaseArrayType i tp))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType i tp)
x = ArrayUpdateMap (Expr t) (i ::> itp) tp
-> Expr t (BaseArrayType (i ::> itp) tp)
-> ArrayMapView (i ::> itp) (Expr t) tp
forall (i :: Ctx BaseType) (f :: BaseType -> Type)
       (tp :: BaseType).
ArrayUpdateMap f i tp
-> f (BaseArrayType i tp) -> ArrayMapView i f tp
ArrayMapView ArrayUpdateMap (Expr t) (i ::> itp) tp
m Expr t (BaseArrayType (i ::> itp) tp)
c
  | Bool
otherwise = ArrayUpdateMap (Expr t) i tp
-> Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
forall (i :: Ctx BaseType) (f :: BaseType -> Type)
       (tp :: BaseType).
ArrayUpdateMap f i tp
-> f (BaseArrayType i tp) -> ArrayMapView i f tp
ArrayMapView ArrayUpdateMap (Expr t) i tp
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp
AUM.empty Expr t (BaseArrayType i tp)
x

-- | Construct an 'ArrayMapView' for an element.
underlyingArrayMapExpr :: ArrayResultWrapper (Expr t) i tp
                      -> ArrayResultWrapper (Expr t) i tp
underlyingArrayMapExpr :: ArrayResultWrapper (Expr t) i tp
-> ArrayResultWrapper (Expr t) i tp
underlyingArrayMapExpr ArrayResultWrapper (Expr t) i tp
x
  | Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp
_ ArrayUpdateMap (Expr t) (i ::> itp) tp
_ Expr t (BaseArrayType (i ::> itp) tp)
c) <- Expr t (BaseArrayType i tp)
-> Maybe (App (Expr t) (BaseArrayType i tp))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp (ArrayResultWrapper (Expr t) i tp -> Expr t (BaseArrayType i tp)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) i tp
x) = Expr t (BaseArrayType (i ::> itp) tp)
-> ArrayResultWrapper (Expr t) (i ::> itp) tp
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
ArrayResultWrapper Expr t (BaseArrayType (i ::> itp) tp)
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 :: Assignment (ArrayResultWrapper (Expr t) i) ctx
-> Set (Assignment IndexLit i)
concreteArrayEntries = (forall (x :: BaseType).
 Set (Assignment IndexLit i)
 -> ArrayResultWrapper (Expr t) i x -> Set (Assignment IndexLit i))
-> Set (Assignment IndexLit i)
-> Assignment (ArrayResultWrapper (Expr t) i) ctx
-> Set (Assignment IndexLit i)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) b.
FoldableFC t =>
(forall (x :: k). b -> f x -> b)
-> forall (x :: l). b -> t f x -> b
foldlFC' forall (x :: BaseType).
Set (Assignment IndexLit i)
-> ArrayResultWrapper (Expr t) i x -> Set (Assignment IndexLit i)
f Set (Assignment IndexLit i)
forall a. Set a
Set.empty
  where f :: Set (Ctx.Assignment IndexLit i)
          -> ArrayResultWrapper (Expr t) i tp
          -> Set (Ctx.Assignment IndexLit i)
        f :: 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 tp
_ ArrayUpdateMap (Expr t) (i ::> itp) tp
m Expr t (BaseArrayType (i ::> itp) tp)
_) <- Expr t (BaseArrayType i tp)
-> Maybe (App (Expr t) (BaseArrayType i tp))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp (ArrayResultWrapper (Expr t) i tp -> Expr t (BaseArrayType i tp)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult  ArrayResultWrapper (Expr t) i tp
e) =
            Set (Assignment IndexLit i)
-> Set (Assignment IndexLit i) -> Set (Assignment IndexLit i)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Assignment IndexLit i)
s (ArrayUpdateMap (Expr t) (i ::> itp) tp
-> Set (Assignment IndexLit (i ::> itp))
forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
       (tp :: BaseType).
ArrayUpdateMap e ctx tp -> Set (Assignment IndexLit ctx)
AUM.keysSet ArrayUpdateMap (Expr t) (i ::> itp) tp
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 :: Assignment (Expr t) idx -> Maybe (Assignment IntLit idx)
asIntBounds = (forall (x :: BaseType). Expr t x -> Maybe (IntLit x))
-> forall (x :: Ctx BaseType).
   Assignment (Expr t) x -> Maybe (Assignment IntLit x)
forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC forall t (tp :: BaseType). Expr t tp -> Maybe (IntLit tp)
forall (x :: BaseType). Expr t x -> Maybe (IntLit x)
f
  where f :: Expr t tp -> Maybe (IntLit tp)
        f :: Expr t tp -> Maybe (IntLit tp)
f (SemiRingLiteral SemiRingRepr sr
SR.SemiRingIntegerRepr Coefficient sr
n ProgramLoc
_) = IntLit tp -> Maybe (IntLit tp)
forall a. a -> Maybe a
Just (Integer -> IntLit tp
forall (tp :: BaseType).
(tp ~ BaseIntegerType) =>
Integer -> IntLit tp
IntLit Integer
Coefficient sr
n)
        f Expr t tp
_ = Maybe (IntLit tp)
forall a. Maybe a
Nothing

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

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

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

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

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


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



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

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

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

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

  annotateTerm :: 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 (nonceExprApp -> Annotation _ n _) -> (Nonce t tp, Expr t tp) -> IO (Nonce t tp, Expr t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Nonce t tp
n, SymExpr (ExprBuilder t st fs) tp
Expr t tp
e)
      SymExpr (ExprBuilder t st fs) tp
_ -> do
        let tpr :: BaseTypeRepr tp
tpr = Expr t tp -> BaseTypeRepr tp
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) tp
Expr t tp
e
        Nonce t tp
n <- ExprBuilder t st fs -> IO (Nonce t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sym
        Expr t tp
e' <- ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (BaseTypeRepr tp
-> Nonce t tp -> Expr t tp -> NonceApp t (Expr t) tp
forall (tp :: BaseType) t (e :: BaseType -> Type).
BaseTypeRepr tp -> Nonce t tp -> e tp -> NonceApp t e tp
Annotation BaseTypeRepr tp
tpr Nonce t tp
n SymExpr (ExprBuilder t st fs) tp
Expr t tp
e)
        (Nonce t tp, Expr t tp) -> IO (Nonce t tp, Expr t tp)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Nonce t tp
n, Expr t tp
e')

  getAnnotation :: 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 (nonceExprApp -> Annotation _ n _) -> Nonce t tp -> Maybe (Nonce t tp)
forall a. a -> Maybe a
Just Nonce t tp
n
      SymExpr (ExprBuilder t st fs) tp
_ -> Maybe (SymAnnotation (ExprBuilder t st fs) tp)
forall a. Maybe a
Nothing

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

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

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

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

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

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

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

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

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

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

  andPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y =
    case (Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
Expr t BaseBoolType
x, Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
Expr t BaseBoolType
y) of
      (Just Bool
True, Maybe Bool
_)  -> Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
Expr t BaseBoolType
y
      (Just Bool
False, Maybe Bool
_) -> Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
Expr t BaseBoolType
x
      (Maybe Bool
_, Just Bool
True)  -> Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
Expr t BaseBoolType
x
      (Maybe Bool
_, Just Bool
False) -> Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
Expr t BaseBoolType
y
      (Maybe Bool, Maybe Bool)
_ | Pred (ExprBuilder t st fs)
Expr t BaseBoolType
x Expr t BaseBoolType -> Expr t BaseBoolType -> Bool
forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
Expr t BaseBoolType
y -> Expr t BaseBoolType -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
Expr t BaseBoolType
x -- and is idempotent
        | Bool
otherwise -> Expr t BaseBoolType
-> Expr t BaseBoolType -> IO (Expr t BaseBoolType)
go Pred (ExprBuilder t st fs)
Expr t BaseBoolType
x Pred (ExprBuilder t st fs)
Expr t BaseBoolType
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) <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseBoolType
a
     , Just (ConjPred BoolMap (Expr t)
bs) <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t BaseBoolType
b
     = ExprBuilder t st fs -> BoolMap (Expr t) -> IO (Expr t BaseBoolType)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (BoolMap (Expr t) -> IO (Expr t BaseBoolType))
-> BoolMap (Expr t) -> IO (Expr t BaseBoolType)
forall a b. (a -> b) -> a -> b
$ BoolMap (Expr t) -> BoolMap (Expr t) -> BoolMap (Expr t)
forall (f :: BaseType -> Type).
OrdF f =>
BoolMap f -> BoolMap f -> BoolMap f
BM.combine BoolMap (Expr t)
as BoolMap (Expr t)
bs

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

      -- ite !c x y = ite c y x
    | Just (NotPred Expr t BaseBoolType
c') <- Expr t BaseBoolType -> Maybe (App (Expr t) BaseBoolType)
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Pred (ExprBuilder t st fs)
Expr t BaseBoolType
c = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
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  <- Expr t BaseBoolType -> Maybe Bool
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
Expr t BaseBoolType
x = ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
y

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{-  FIXME? how important are these reductions?

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    -- Push some equalities under if/then/else
    | SemiRingLiteral _ _ _ <- 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) <- Expr t ('BaseBVType w) -> Maybe (App (Expr t) ('BaseBVType w))
forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
y
    = IO (IO (Expr t BaseBoolType)) -> IO (Expr t BaseBoolType)
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
Expr t BaseBoolType
c (Expr t BaseBoolType
 -> Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType)
-> IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Nat).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
a IO (Expr t BaseBoolType -> IO (Expr t BaseBoolType))
-> IO (Expr t BaseBoolType) -> IO (IO (Expr t BaseBoolType))
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
forall sym (w :: Nat).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
Expr t ('BaseBVType w)
b)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    | Bool
otherwise
    = let sr :: SemiRingRepr (SemiRingBV BVBits w)
sr = (BVFlavorRepr BVBits
-> NatRepr w -> SemiRingRepr (SemiRingBV BVBits w)
forall (w :: Nat) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr (SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr BVBits
SR.BVBitsRepr (Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x))
       in ExprBuilder t st fs
-> WeightedSum (Expr t) (SemiRingBV BVBits w)
-> IO (Expr t (SemiRingBase (SemiRingBV BVBits w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (WeightedSum (Expr t) (SemiRingBV BVBits w)
 -> IO (Expr t (SemiRingBase (SemiRingBV BVBits w))))
-> WeightedSum (Expr t) (SemiRingBV BVBits w)
-> IO (Expr t (SemiRingBase (SemiRingBV BVBits w)))
forall a b. (a -> b) -> a -> b
$ SemiRingRepr (SemiRingBV BVBits w)
-> WeightedSum (Expr t) (SemiRingBV BVBits w)
-> Coefficient (SemiRingBV BVBits w)
-> WeightedSum (Expr t) (SemiRingBV BVBits w)
forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr (SemiRingBV BVBits w)
sr (SemiRingRepr (SemiRingBV BVBits w)
-> Expr t (SemiRingBase (SemiRingBV BVBits w))
-> WeightedSum (Expr t) (SemiRingBV BVBits w)
forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr (SemiRingBV BVBits w)
sr SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase (SemiRingBV BVBits w))
x) (NatRepr w -> BV w
forall (w :: Nat). NatRepr w -> BV w
BV.maxUnsigned (Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x))

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

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

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

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

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

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

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

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

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

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

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

  bvNeg :: ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvNeg ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
    | Just BV w
xv <- Expr t (BaseBVType w) -> Maybe (BV w)
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Nat).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (NatRepr w -> BV w -> BV w
forall (w :: Nat). NatRepr w -> BV w -> BV w
BV.negate (Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) BV w
xv)
    | Bool
otherwise =
        do Integer
ut <- OptionSetting BaseIntegerType -> IO Integer
forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (ExprBuilder t st fs -> OptionSetting BaseIntegerType
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
           let ?unaryThreshold = fromInteger ut
           ExprBuilder t st fs
-> Maybe (IO (UnaryBV (Expr t BaseBoolType) w))
-> IO (Expr t (BaseBVType w))
-> IO (Expr t (BaseBVType w))
forall (w :: Nat) 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 <- ExprBuilder t st fs
-> Expr t (BaseBVType w) -> Maybe (UnaryBV (Expr t BaseBoolType) w)
forall t (st :: Type -> Type) fs (n :: Nat).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x
                 IO (UnaryBV (Expr t BaseBoolType) w)
-> Maybe (IO (UnaryBV (Expr t BaseBoolType) w))
forall a. a -> Maybe a
Just (ExprBuilder t st fs
-> UnaryBV (Pred (ExprBuilder t st fs)) w
-> IO (UnaryBV (Pred (ExprBuilder t st fs)) w)
forall sym (n :: Nat).
(1 <= n, IsExprBuilder sym) =>
sym -> UnaryBV (Pred sym) n -> IO (UnaryBV (Pred sym) n)
UnaryBV.neg ExprBuilder t st fs
sym UnaryBV (Pred (ExprBuilder t st fs)) w
UnaryBV (Expr t BaseBoolType) w
ux))
             (do let sr :: SemiRingRepr (SemiRingBV BVArith w)
sr = BVFlavorRepr BVArith
-> NatRepr w -> SemiRingRepr (SemiRingBV BVArith w)
forall (w :: Nat) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr (SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr BVArith
SR.BVArithRepr (Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x)
                 ExprBuilder t st fs
-> SemiRingRepr (SemiRingBV BVArith w)
-> Coefficient (SemiRingBV BVArith w)
-> Expr t (SemiRingBase (SemiRingBV BVArith w))
-> IO (Expr t (SemiRingBase (SemiRingBV BVArith w)))
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr (SemiRingBV BVArith w)
sr (NatRepr w -> Integer -> BV w
forall (w :: Nat). NatRepr w -> Integer -> BV w
BV.mkBV (Expr t (BaseBVType w) -> NatRepr w
forall (e :: BaseType -> Type) (w :: Nat).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
Expr t (BaseBVType w)
x) (-Integer
1)) SymBV (ExprBuilder t st fs) w
Expr t (SemiRingBase (SemiRingBV BVArith w))
x)

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

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

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

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

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

  mkStruct :: ExprBuilder t st fs
-> Assignment (SymExpr (ExprBuilder t st fs)) flds
-> IO (SymStruct (ExprBuilder t st fs) flds)
mkStruct ExprBuilder t st fs
sym Assignment (SymExpr (ExprBuilder t st fs)) flds
args = do
    ExprBuilder t st fs
-> App (Expr t) (BaseStructType flds)
-> IO (Expr t (BaseStructType flds))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (App (Expr t) (BaseStructType flds)
 -> IO (Expr t (BaseStructType flds)))
-> App (Expr t) (BaseStructType flds)
-> IO (Expr t (BaseStructType flds))
forall a b. (a -> b) -> a -> b
$ Assignment BaseTypeRepr flds
-> Assignment (Expr t) flds -> App (Expr t) (BaseStructType flds)
forall (flds :: Ctx BaseType) (e :: BaseType -> Type).
Assignment BaseTypeRepr flds
-> Assignment e flds -> App e (BaseStructType flds)
StructCtor ((forall (x :: BaseType). Expr t x -> BaseTypeRepr x)
-> Assignment (Expr t) flds -> Assignment BaseTypeRepr flds
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 (x :: BaseType). Expr t x -> BaseTypeRepr x
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr (ExprBuilder t st fs)) flds
Assignment (Expr t) flds
args) Assignment (SymExpr (ExprBuilder t st fs)) flds
Assignment (Expr t) flds
args

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    -- When the array is an update of concrete entries, map over the entries.
    | Set (Assignment IndexLit (idx ::> itp))
s <- Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Set (Assignment IndexLit (idx ::> itp))
forall t (i :: Ctx BaseType) (ctx :: Ctx BaseType).
Assignment (ArrayResultWrapper (Expr t) i) ctx
-> Set (Assignment IndexLit i)
concreteArrayEntries Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays
    , Bool -> Bool
not (Set (Assignment IndexLit (idx ::> itp)) -> Bool
forall a. Set a -> Bool
Set.null Set (Assignment IndexLit (idx ::> itp))
s) = do
        -- Distribute over base values.
        --
        -- The underlyingArrayMapElf function strings a top-level arrayMap value.
        --
        -- It is ok because we don't care what the value of base is at any index
        -- in s.
        Expr t (BaseArrayType (idx ::> itp) r)
base <- ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
     (ctx ::> d)
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) r)
forall sym (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
       (idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (ctx ::> d) r
-> Assignment
     (ArrayResultWrapper (SymExpr sym) (idx ::> itp)) (ctx ::> d)
-> IO (SymArray sym (idx ::> itp) r)
arrayMap ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
f ((forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (idx ::> itp) x
 -> ArrayResultWrapper (Expr t) (idx ::> itp) x)
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
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
forall (x :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) x
-> ArrayResultWrapper (Expr t) (idx ::> itp) x
underlyingArrayMapExpr Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays)
        BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
ret <- BaseTypeRepr (BaseArrayType (idx ::> itp) r)
-> IO (BaseTypeRepr (BaseArrayType (idx ::> itp) r))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (idx ::> itp) r)
-> BaseTypeRepr (BaseArrayType (idx ::> itp) r)
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 :: Assignment IndexLit (idx ::> itp)
-> Assignment (Expr t) (idx ::> itp)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
-> IO (Expr t d)
evalArgs Assignment IndexLit (idx ::> itp)
const_idx Assignment (Expr t) (idx ::> itp)
sym_idx ArrayResultWrapper (Expr t) (idx ::> itp) d
a = do
              ExprBuilder t st fs
-> Expr t (BaseArrayType (idx ::> itp) d)
-> Maybe (Assignment IndexLit (idx ::> itp))
-> Assignment (Expr t) (idx ::> itp)
-> IO (Expr t d)
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
       (tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym (ArrayResultWrapper (Expr t) (idx ::> itp) d
-> Expr t (BaseArrayType (idx ::> itp) d)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) (idx ::> itp) d
a) (Assignment IndexLit (idx ::> itp)
-> Maybe (Assignment IndexLit (idx ::> itp))
forall a. a -> Maybe a
Just Assignment IndexLit (idx ::> itp)
const_idx) Assignment (Expr t) (idx ::> itp)
sym_idx
        let evalIndex :: ExprSymFn t ctx ret
                      -> Ctx.Assignment (ArrayResultWrapper (Expr t) (i::>itp)) ctx
                      -> Ctx.Assignment IndexLit (i::>itp)
                      -> IO (Expr t ret)
            evalIndex :: ExprSymFn t ctx ret
-> Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
-> Assignment IndexLit (i ::> itp)
-> IO (Expr t ret)
evalIndex ExprSymFn t ctx ret
g Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
arrays0 Assignment IndexLit (i ::> itp)
const_idx = do
              Assignment (Expr t) (i ::> itp)
sym_idx <- (forall (x :: BaseType). IndexLit x -> IO (Expr t x))
-> Assignment IndexLit (i ::> itp)
-> IO (Assignment (Expr t) (i ::> itp))
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 (ExprBuilder t st fs
-> IndexLit x -> IO (SymExpr (ExprBuilder t st fs) x)
forall sym (idx :: BaseType).
IsExprBuilder sym =>
sym -> IndexLit idx -> IO (SymExpr sym idx)
indexLit ExprBuilder t st fs
sym) Assignment IndexLit (i ::> itp)
const_idx
              ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) ctx ret
-> Assignment (SymExpr (ExprBuilder t st fs)) ctx
-> IO (SymExpr (ExprBuilder t st fs) ret)
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) ctx ret
ExprSymFn t ctx ret
g (Assignment (Expr t) ctx -> IO (Expr t ret))
-> IO (Assignment (Expr t) ctx) -> IO (Expr t ret)
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (i ::> itp) x -> IO (Expr t x))
-> Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
-> IO (Assignment (Expr t) ctx)
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 (Assignment IndexLit (i ::> itp)
-> Assignment (Expr t) (i ::> itp)
-> ArrayResultWrapper (Expr t) (i ::> itp) x
-> IO (Expr t x)
forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
Assignment IndexLit (idx ::> itp)
-> Assignment (Expr t) (idx ::> itp)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
-> IO (Expr t d)
evalArgs Assignment IndexLit (i ::> itp)
const_idx Assignment (Expr t) (i ::> itp)
sym_idx) Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
arrays0
        ArrayUpdateMap (Expr t) (idx ::> itp) xs
m <- BaseTypeRepr xs
-> [(Assignment IndexLit (idx ::> itp), Expr t xs)]
-> ArrayUpdateMap (Expr t) (idx ::> itp) xs
forall (e :: BaseType -> Type) (tp :: BaseType)
       (ctx :: Ctx BaseType).
(HasAbsValue e, HashableF e) =>
BaseTypeRepr tp
-> [(Assignment IndexLit ctx, e tp)] -> ArrayUpdateMap e ctx tp
AUM.fromAscList BaseTypeRepr xs
ret ([(Assignment IndexLit (idx ::> itp), Expr t xs)]
 -> ArrayUpdateMap (Expr t) (idx ::> itp) xs)
-> IO [(Assignment IndexLit (idx ::> itp), Expr t xs)]
-> IO (ArrayUpdateMap (Expr t) (idx ::> itp) xs)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (Assignment IndexLit (idx ::> itp)
 -> IO (Assignment IndexLit (idx ::> itp), Expr t xs))
-> [Assignment IndexLit (idx ::> itp)]
-> IO [(Assignment IndexLit (idx ::> itp), Expr t xs)]
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Assignment IndexLit (idx ::> itp)
k -> (Assignment IndexLit (idx ::> itp)
k,) (Expr t xs -> (Assignment IndexLit (idx ::> itp), Expr t xs))
-> IO (Expr t xs)
-> IO (Assignment IndexLit (idx ::> itp), Expr t xs)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ExprSymFn t (ctx ::> d) xs
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Assignment IndexLit (idx ::> itp)
-> IO (Expr t xs)
forall (ctx :: Ctx BaseType) (ret :: BaseType) (i :: Ctx BaseType)
       (itp :: BaseType).
ExprSymFn t ctx ret
-> Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
-> Assignment IndexLit (i ::> itp)
-> IO (Expr t ret)
evalIndex SymFn (ExprBuilder t st fs) (ctx ::> d) r
ExprSymFn t (ctx ::> d) xs
f Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays Assignment IndexLit (idx ::> itp)
k) (Set (Assignment IndexLit (idx ::> itp))
-> [Assignment IndexLit (idx ::> itp)]
forall a. Set a -> [a]
Set.toAscList Set (Assignment IndexLit (idx ::> itp))
s)
        ExprBuilder t st fs
-> ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) xs
-> SymArray (ExprBuilder t st fs) (idx ::> itp) xs
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) xs)
forall sym (idx :: Ctx BaseType) (itp :: BaseType)
       (tp :: BaseType).
IsExprBuilder sym =>
sym
-> ArrayUpdateMap (SymExpr sym) (idx ::> itp) tp
-> SymArray sym (idx ::> itp) tp
-> IO (SymArray sym (idx ::> itp) tp)
arrayUpdateAtIdxLits ExprBuilder t st fs
sym ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) xs
ArrayUpdateMap (Expr t) (idx ::> itp) xs
m SymArray (ExprBuilder t st fs) (idx ::> itp) xs
Expr t (BaseArrayType (idx ::> itp) r)
base
      -- When entries are constants, then just evaluate constant.
    | Just Assignment (Expr t) (ctx ::> d)
cns <-  (forall (x :: BaseType).
 ArrayResultWrapper (Expr t) (idx ::> itp) x -> Maybe (Expr t x))
-> Assignment
     (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> Maybe (Assignment (Expr t) (ctx ::> d))
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 -> Expr t (BaseArrayType (idx ::> itp) x) -> Maybe (Expr t x)
forall (e :: BaseType -> Type) (idx :: Ctx BaseType)
       (bt :: BaseType).
IsExpr e =>
e (BaseArrayType idx bt) -> Maybe (e bt)
asConstantArray (ArrayResultWrapper (Expr t) (idx ::> itp) x
-> Expr t (BaseArrayType (idx ::> itp) x)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) (idx ::> itp) x
a)) Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays = do
      Expr t r
r <- ExprBuilder t st fs
-> ExprSymFn t (ctx ::> d) r
-> Assignment (Expr t) (ctx ::> d)
-> IO (Expr t r)
forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
       (ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
ExprSymFn t (ctx ::> d) r
f Assignment (Expr t) (ctx ::> d)
cns
      case Expr t (BaseArrayType (idx ::> itp) d)
-> BaseTypeRepr (BaseArrayType (idx ::> itp) d)
forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType (ArrayResultWrapper (Expr t) (idx ::> itp) d
-> Expr t (BaseArrayType (idx ::> itp) d)
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
       (tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
forall k (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment
  (ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
  (ctx ::> d)
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
arrays)) of
        BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idxRepr BaseTypeRepr xs
_ -> do
          ExprBuilder t st fs
-> Assignment BaseTypeRepr (idx ::> tp)
-> SymExpr (ExprBuilder t st fs) r
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) r)
forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> Assignment BaseTypeRepr (idx ::> tp)
-> SymExpr sym b
-> IO (SymArray sym (idx ::> tp) b)
constantArray ExprBuilder t st fs
sym Assignment BaseTypeRepr (idx ::> tp)
idxRepr SymExpr (ExprBuilder t st fs) r
Expr t r
r

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  integerToBV :: 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 SR.SemiRingIntegerRepr i _ <- SymInteger (ExprBuilder t st fs)
xr =
      ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Nat).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Nat). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
Coefficient sr
i)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  realPi :: ExprBuilder t st fs -> IO (SymReal (ExprBuilder t st fs))
realPi ExprBuilder t st fs
sym = do
    if ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym then
      ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double
forall a. Floating a => a
pi :: Double))
     else
      ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym App (Expr t) BaseRealType
forall (e :: BaseType -> Type). App e BaseRealType
Pi

  realSin :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realSin ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x =
    case Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x of
      Just Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
0
      Just Rational
c | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
sin (Rational -> Double
toDouble Rational
c)))
      Maybe Rational
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealSin SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realCos :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realCos ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x =
    case Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x of
      Just Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
      Just Rational
c | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
cos (Rational -> Double
toDouble Rational
c)))
      Maybe Rational
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealCos SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realAtan2 :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realAtan2 ExprBuilder t st fs
sb SymReal (ExprBuilder t st fs)
y SymReal (ExprBuilder t st fs)
x = do
    case (Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y, Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x) of
      (Just Rational
0, Maybe Rational
_) -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sb Rational
0
      (Just Rational
yc, Just Rational
xc) | Rational
xc Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
/= Rational
0, ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sb -> do
        ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sb (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 (Rational -> Double
toDouble Rational
yc) (Rational -> Double
toDouble Rational
xc)))
      (Maybe Rational, Maybe Rational)
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (Expr t BaseRealType
-> Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> e BaseRealType -> App e BaseRealType
RealATan2 SymReal (ExprBuilder t st fs)
Expr t BaseRealType
y SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realSinh :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realSinh ExprBuilder t st fs
sb SymReal (ExprBuilder t st fs)
x =
    case Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x of
      Just Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sb Rational
0
      Just Rational
c | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sb -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sb (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
sinh (Rational -> Double
toDouble Rational
c)))
      Maybe Rational
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealSinh SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realCosh :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realCosh ExprBuilder t st fs
sb SymReal (ExprBuilder t st fs)
x =
    case Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x of
      Just Rational
0 -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sb Rational
1
      Just Rational
c | ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sb -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sb (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
cosh (Rational -> Double
toDouble Rational
c)))
      Maybe Rational
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealCosh SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realExp :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realExp ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
    | Just Rational
0 <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x = ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
    | Just Rational
c <- Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x, ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym = ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
exp (Rational -> Double
toDouble Rational
c)))
    | Bool
otherwise = ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealExp SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

  realLog :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realLog ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x =
    case Expr t BaseRealType -> Maybe Rational
forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x of
      Just Rational
c | Rational
c Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
0, ExprBuilder t st fs -> Bool
forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
log (Rational -> Double
toDouble Rational
c)))
      Maybe Rational
_ -> ExprBuilder t st fs
-> App (Expr t) BaseRealType -> IO (Expr t BaseRealType)
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (Expr t BaseRealType -> App (Expr t) BaseRealType
forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealLog SymReal (ExprBuilder t st fs)
Expr t BaseRealType
x)

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

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

  floatPZero :: ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatPZero ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) 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 :: ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNZero ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) 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 :: ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNaN   ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) 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 :: ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatPInf  ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) 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 :: ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNInf  ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) 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 :: ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNeg ExprBuilder t st fs
sym (FloatExpr fpp x _) = ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BigFloat -> BigFloat
BF.bfNeg BigFloat
x)
  floatNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = (FloatPrecisionRepr fpp
 -> Expr t (BaseFloatType fpp) -> App (Expr t) (BaseFloatType fpp))
-> ExprBuilder t st fs
-> Expr t (BaseFloatType fpp)
-> IO (Expr t (BaseFloatType fpp))
forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
       (st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
 -> e (BaseFloatType fpp) -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOp FloatPrecisionRepr fpp
-> Expr t (BaseFloatType fpp) -> App (Expr t) (BaseFloatType fpp)
forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp)
FloatNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
Expr t (BaseFloatType fpp)
x

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  floatToBV :: 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 _ bf _ <- SymFloat (ExprBuilder t st fs) fpp
x
    , Just Integer
i <- RoundingMode -> BigFloat -> Maybe Integer
floatToInteger RoundingMode
r BigFloat
bf
    , Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr w -> Integer
forall (w :: Nat). NatRepr w -> Integer
maxUnsigned NatRepr w
w
    = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Nat).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Nat). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)

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

  floatToSBV :: 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 _ bf _ <- SymFloat (ExprBuilder t st fs) fpp
x
    , Just Integer
i <- RoundingMode -> BigFloat -> Maybe Integer
floatToInteger RoundingMode
r BigFloat
bf
    , NatRepr w -> Integer
forall (w :: Nat). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= NatRepr w -> Integer
forall (w :: Nat). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
    = ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
forall sym (w :: Nat).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (NatRepr w -> Integer -> BV w
forall (w :: Nat). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)

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

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

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

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

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

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

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

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



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

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

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


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


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

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

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

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

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

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

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

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

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

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

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

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

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


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

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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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


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

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

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

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

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