{-# 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
, newExprBuilder
, getSymbolVarBimap
, sbMakeExpr
, sbNonceExpr
, curProgramLoc
, unaryThreshold
, cacheStartSize
, userState
, exprCounter
, startCaching
, stopCaching
, exprBuilderSplitConfig
, exprBuilderFreshConfig
, bvUnary
, intSum
, realSum
, bvSum
, scalarMul
, unaryThresholdOption
, cacheStartSizeOption
, cacheTerms
, Expr(..)
, asApp
, asNonceApp
, iteSize
, exprLoc
, ppExpr
, ppExprTop
, exprMaybeId
, asConjunction
, asDisjunction
, Polarity(..)
, BM.negatePolarity
, AppExpr
, appExprId
, appExprLoc
, appExprApp
, NonceAppExpr
, nonceExprId
, nonceExprLoc
, nonceExprApp
, BoolExpr
, IntegerExpr
, RealExpr
, FloatExpr
, BVExpr
, CplxExpr
, StringExpr
, App(..)
, traverseApp
, appType
, NonceApp(..)
, nonceAppType
, ExprBoundVar
, bvarId
, bvarLoc
, bvarName
, bvarType
, bvarKind
, bvarAbstractValue
, VarKind(..)
, boundVars
, ppBoundVar
, evalBoundVars
, ExprSymFn(..)
, SymFnInfo(..)
, symFnArgTypes
, symFnReturnType
, SomeExprSymFn(..)
, ExprSymFnWrapper(..)
, SymbolVarBimap
, SymbolBinding(..)
, emptySymbolVarBimap
, lookupBindingOfSymbol
, lookupSymbolOfBinding
, IdxCache
, newIdxCache
, lookupIdx
, lookupIdxValue
, insertIdxValue
, deleteIdxValue
, clearIdxCache
, idxCacheEval
, idxCacheEval'
, type FloatMode
, FloatModeRepr(..)
, FloatIEEE
, FloatUninterpreted
, FloatReal
, Flags
, BVOrSet
, bvOrToList
, bvOrSingleton
, bvOrInsert
, bvOrUnion
, bvOrAbs
, traverseBVOrSet
, SymExpr
, What4.Interface.bvWidth
, What4.Interface.exprType
, What4.Interface.IndexLit(..)
, What4.Interface.ArrayResultWrapper(..)
) where
import qualified Control.Exception as Ex
import Control.Lens hiding (asIndex, (:>), Empty)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.ST
import Control.Monad.Trans.Writer.Strict (writer, runWriter)
import qualified Data.BitVector.Sized as BV
import Data.Bimap (Bimap)
import qualified Data.Bimap as Bimap
import Data.Hashable
import Data.IORef
import Data.Kind
import Data.List.NonEmpty (NonEmpty(..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid (Any(..))
import Data.Parameterized.Classes
import Data.Parameterized.Context as Ctx
import qualified Data.Parameterized.HashTable as PH
import qualified Data.Parameterized.Map as PM
import Data.Parameterized.NatRepr
import Data.Parameterized.Nonce
import Data.Parameterized.Some
import Data.Parameterized.TraversableFC
import Data.Ratio (numerator, denominator)
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Float (castFloatToWord32, castDoubleToWord64)
import qualified LibBF as BF
import What4.BaseTypes
import What4.Concrete
import qualified What4.Config as CFG
import What4.FloatMode
import What4.Interface
import What4.InterpretedFloatingPoint
import What4.ProgramLoc
import qualified What4.SemiRing as SR
import qualified What4.SpecialFunctions as SFn
import What4.Symbol
import What4.Expr.Allocator
import What4.Expr.App
import qualified What4.Expr.ArrayUpdateMap as AUM
import What4.Expr.BoolMap (BoolMap, Polarity(..), BoolMapView(..))
import qualified What4.Expr.BoolMap as BM
import What4.Expr.MATLAB
import What4.Expr.WeightedSum (WeightedSum, SemiRingProduct)
import qualified What4.Expr.WeightedSum as WSum
import qualified What4.Expr.StringSeq as SSeq
import What4.Expr.UnaryBV (UnaryBV)
import qualified What4.Expr.UnaryBV as UnaryBV
import qualified What4.Expr.VarIdentification as VI
import What4.Utils.AbstractDomains
import What4.Utils.Arithmetic
import qualified What4.Utils.BVDomain as BVD
import What4.Utils.Complex
import What4.Utils.FloatHelpers
import What4.Utils.StringLiteral
toDouble :: Rational -> Double
toDouble :: Rational -> Double
toDouble = forall a. Fractional a => Rational -> a
fromRational
cachedEval :: (HashableF k, TestEquality k, MonadIO m)
=> PH.HashTable RealWorld k a
-> k tp
-> m (a tp)
-> m (a tp)
cachedEval :: forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
(tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval HashTable RealWorld k a
tbl k tp
k m (a tp)
action = do
Maybe (a tp)
mr <- forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall {k} (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> ST s (Maybe (val tp))
PH.lookup HashTable RealWorld k a
tbl k tp
k
case Maybe (a tp)
mr of
Just a tp
r -> forall (m :: Type -> Type) a. Monad m => a -> m a
return a tp
r
Maybe (a tp)
Nothing -> do
a tp
r <- m (a tp)
action
seq :: forall a b. a -> b -> b
seq a tp
r forall a b. (a -> b) -> a -> b
$ do
forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld k a
tbl k tp
k a tp
r
forall (m :: Type -> Type) a. Monad m => a -> m a
return a tp
r
newtype SymbolVarBimap t = SymbolVarBimap (Bimap SolverSymbol (SymbolBinding t))
data SymbolBinding t
= forall tp . VarSymbolBinding !(ExprBoundVar t tp)
| forall args ret . FnSymbolBinding !(ExprSymFn t args ret)
instance Eq (SymbolBinding t) where
VarSymbolBinding ExprBoundVar t tp
x == :: SymbolBinding t -> SymbolBinding t -> Bool
== VarSymbolBinding ExprBoundVar t tp
y = forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality ExprBoundVar t tp
x ExprBoundVar t tp
y)
FnSymbolBinding ExprSymFn t args ret
x == FnSymbolBinding ExprSymFn t args ret
y = forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
x) (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
y))
SymbolBinding t
_ == SymbolBinding t
_ = Bool
False
instance Ord (SymbolBinding t) where
compare :: SymbolBinding t -> SymbolBinding t -> Ordering
compare (VarSymbolBinding ExprBoundVar t tp
x) (VarSymbolBinding ExprBoundVar t tp
y) =
forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF ExprBoundVar t tp
x ExprBoundVar t tp
y)
compare VarSymbolBinding{} SymbolBinding t
_ = Ordering
LT
compare SymbolBinding t
_ VarSymbolBinding{} = Ordering
GT
compare (FnSymbolBinding ExprSymFn t args ret
x) (FnSymbolBinding ExprSymFn t args ret
y) =
forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering (forall k (ktp :: k -> Type) (x :: k) (y :: k).
OrdF ktp =>
ktp x -> ktp y -> OrderingF x y
compareF (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
x) (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t args ret
y))
emptySymbolVarBimap :: SymbolVarBimap t
emptySymbolVarBimap :: forall t. SymbolVarBimap t
emptySymbolVarBimap = forall t. Bimap SolverSymbol (SymbolBinding t) -> SymbolVarBimap t
SymbolVarBimap forall a b. Bimap a b
Bimap.empty
lookupBindingOfSymbol :: SolverSymbol -> SymbolVarBimap t -> Maybe (SymbolBinding t)
lookupBindingOfSymbol :: forall t.
SolverSymbol -> SymbolVarBimap t -> Maybe (SymbolBinding t)
lookupBindingOfSymbol SolverSymbol
s (SymbolVarBimap Bimap SolverSymbol (SymbolBinding t)
m) = forall a b (m :: Type -> Type).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
Bimap.lookup SolverSymbol
s Bimap SolverSymbol (SymbolBinding t)
m
lookupSymbolOfBinding :: SymbolBinding t -> SymbolVarBimap t -> Maybe SolverSymbol
lookupSymbolOfBinding :: forall t. SymbolBinding t -> SymbolVarBimap t -> Maybe SolverSymbol
lookupSymbolOfBinding SymbolBinding t
b (SymbolVarBimap Bimap SolverSymbol (SymbolBinding t)
m) = forall a b (m :: Type -> Type).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
Bimap.lookupR SymbolBinding t
b Bimap SolverSymbol (SymbolBinding t)
m
data MatlabFnWrapper t c where
MatlabFnWrapper :: !(MatlabSolverFn (Expr t) a r) -> MatlabFnWrapper t (a::> r)
instance TestEquality (MatlabFnWrapper t) where
testEquality :: forall (a :: Ctx BaseType) (b :: Ctx BaseType).
MatlabFnWrapper t a -> MatlabFnWrapper t b -> Maybe (a :~: b)
testEquality (MatlabFnWrapper MatlabSolverFn (Expr t) a r
f) (MatlabFnWrapper MatlabSolverFn (Expr t) a r
g) = do
(a '::> r) :~: (a '::> r)
Refl <- forall (f :: BaseType -> Type) (ax :: Ctx BaseType)
(rx :: BaseType) (ay :: Ctx BaseType) (ry :: BaseType).
TestEquality f =>
MatlabSolverFn f ax rx
-> MatlabSolverFn f ay ry -> Maybe ((ax ::> rx) :~: (ay ::> ry))
testSolverFnEq MatlabSolverFn (Expr t) a r
f MatlabSolverFn (Expr t) a r
g
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall {k} (a :: k). a :~: a
Refl
instance HashableF (MatlabFnWrapper t) where
hashWithSaltF :: forall (tp :: Ctx BaseType). Int -> MatlabFnWrapper t tp -> Int
hashWithSaltF Int
s (MatlabFnWrapper MatlabSolverFn (Expr t) a r
f) = forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s MatlabSolverFn (Expr t) a r
f
data ExprSymFnWrapper t c
= forall a r . (c ~ (a ::> r)) => ExprSymFnWrapper (ExprSymFn t a r)
data SomeExprSymFn t = forall args ret . SomeExprSymFn (ExprSymFn t args ret)
instance Eq (SomeExprSymFn t) where
(SomeExprSymFn ExprSymFn t args ret
fn1) == :: SomeExprSymFn t -> SomeExprSymFn t -> Bool
== (SomeExprSymFn ExprSymFn t args ret
fn2) =
forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall (fn :: Ctx BaseType -> BaseType -> Type)
(args1 :: Ctx BaseType) (ret1 :: BaseType) (args2 :: Ctx BaseType)
(ret2 :: BaseType).
IsSymFn fn =>
fn args1 ret1
-> fn args2 ret2 -> Maybe ((args1 ::> ret1) :~: (args2 ::> ret2))
fnTestEquality ExprSymFn t args ret
fn1 ExprSymFn t args ret
fn2
instance Ord (SomeExprSymFn t) where
compare :: SomeExprSymFn t -> SomeExprSymFn t -> Ordering
compare (SomeExprSymFn ExprSymFn t args ret
fn1) (SomeExprSymFn ExprSymFn t args ret
fn2) =
forall {k} (x :: k) (y :: k). OrderingF x y -> Ordering
toOrdering forall a b. (a -> b) -> a -> b
$ forall (fn :: Ctx BaseType -> BaseType -> Type)
(args1 :: Ctx BaseType) (ret1 :: BaseType) (args2 :: Ctx BaseType)
(ret2 :: BaseType).
IsSymFn fn =>
fn args1 ret1
-> fn args2 ret2 -> OrderingF (args1 ::> ret1) (args2 ::> ret2)
fnCompare ExprSymFn t args ret
fn1 ExprSymFn t args ret
fn2
instance Show (SomeExprSymFn t) where
show :: SomeExprSymFn t -> String
show (SomeExprSymFn ExprSymFn t args ret
f) = forall a. Show a => a -> String
show ExprSymFn t args ret
f
data Flags (fi :: FloatMode)
data ExprBuilder t (st :: Type -> Type) (fs :: Type)
= forall fm. (fs ~ (Flags fm)) =>
SB { forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> BoolExpr t
sbTrue :: !(BoolExpr t)
, forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> BoolExpr t
sbFalse :: !(BoolExpr t)
, forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> RealExpr t
sbZero :: !(RealExpr t)
, forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Config
sbConfiguration :: !CFG.Config
, forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce :: !Bool
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold :: !(CFG.OptionSetting BaseIntegerType)
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize :: !(CFG.OptionSetting BaseIntegerType)
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter :: !(NonceGenerator IO t)
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator :: !(IORef (ExprAllocator t))
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef Integer
sbNonLinearOps :: !(IORef Integer)
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef ProgramLoc
sbProgramLoc :: !(IORef ProgramLoc)
, forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> st t
sbUserState :: !(st t)
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings :: !(IORef (SymbolVarBimap t))
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> IORef
(Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st fs)))
sbUninterpFnCache :: !(IORef (Map (SolverSymbol, Some (Ctx.Assignment BaseTypeRepr)) (SomeSymFn (ExprBuilder t st fs))))
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
sbMatlabFnCache :: !(PH.HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t))
, forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger :: !(IORef (Maybe (SolverEvent -> IO ())))
, ()
sbFloatMode :: !(FloatModeRepr fm)
}
type instance SymFn (ExprBuilder t st fs) = ExprSymFn t
type instance SymExpr (ExprBuilder t st fs) = Expr t
type instance BoundVar (ExprBuilder t st fs) = ExprBoundVar t
type instance SymAnnotation (ExprBuilder t st fs) = Nonce t
exprCounter :: Getter (ExprBuilder t st fs) (NonceGenerator IO t)
exprCounter :: forall t (st :: Type -> Type) fs.
Getter (ExprBuilder t st fs) (NonceGenerator IO t)
exprCounter = forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter
userState :: Lens' (ExprBuilder t st fs) (st t)
userState :: forall t (st :: Type -> Type) fs.
Lens' (ExprBuilder t st fs) (st t)
userState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> st t
sbUserState (\ExprBuilder t st fs
sym st t
st -> ExprBuilder t st fs
sym{ sbUserState :: st t
sbUserState = st t
st })
unaryThreshold :: Getter (ExprBuilder t st fs) (CFG.OptionSetting BaseIntegerType)
unaryThreshold :: forall t (st :: Type -> Type) fs.
Getter (ExprBuilder t st fs) (OptionSetting BaseIntegerType)
unaryThreshold = forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold
cacheStartSize :: Getter (ExprBuilder t st fs) (CFG.OptionSetting BaseIntegerType)
cacheStartSize :: forall t (st :: Type -> Type) fs.
Getter (ExprBuilder t st fs) (OptionSetting BaseIntegerType)
cacheStartSize = forall (p :: Type -> Type -> Type) (f :: Type -> Type) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize
exprBuilderSplitConfig :: ExprBuilder t st fs -> IO (ExprBuilder t st fs)
exprBuilderSplitConfig :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO (ExprBuilder t st fs)
exprBuilderSplitConfig ExprBuilder t st fs
sym =
do Config
cfg' <- Config -> IO Config
CFG.splitConfig (forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Config
sbConfiguration ExprBuilder t st fs
sym)
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprBuilder t st fs
sym{ sbConfiguration :: Config
sbConfiguration = Config
cfg' }
exprBuilderFreshConfig :: ExprBuilder t st fs -> IO (ExprBuilder t st fs)
exprBuilderFreshConfig :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO (ExprBuilder t st fs)
exprBuilderFreshConfig ExprBuilder t st fs
sym =
do let gen :: NonceGenerator IO t
gen = forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sym
ExprAllocator t
es <- forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage NonceGenerator IO t
gen
IORef ProgramLoc
loc_ref <- forall a. a -> IO (IORef a)
newIORef ProgramLoc
initializationLoc
IORef (ExprAllocator t)
storage_ref <- forall a. a -> IO (IORef a)
newIORef ExprAllocator t
es
IORef (Maybe (SolverEvent -> IO ()))
logger_ref <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
IORef (SymbolVarBimap t)
bindings_ref <- forall a. a -> IO (IORef a)
newIORef forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings ExprBuilder t st fs
sym)
Config
cfg <- Integer -> [ConfigDesc] -> IO Config
CFG.initialConfig Integer
0
[ ConfigDesc
unaryThresholdDesc
, ConfigDesc
cacheStartSizeDesc
]
OptionSetting BaseIntegerType
unarySetting <- forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
unaryThresholdOption Config
cfg
OptionSetting BaseIntegerType
cacheStartSetting <- forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
cacheStartSizeOption Config
cfg
[ConfigDesc] -> Config -> IO ()
CFG.extendConfig [forall t.
NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> ConfigDesc
cacheOptDesc NonceGenerator IO t
gen IORef (ExprAllocator t)
storage_ref OptionSetting BaseIntegerType
cacheStartSetting] Config
cfg
IORef Integer
nonLinearOps <- forall a. a -> IO (IORef a)
newIORef Integer
0
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprBuilder t st fs
sym { sbConfiguration :: Config
sbConfiguration = Config
cfg
, sbFloatReduce :: Bool
sbFloatReduce = Bool
True
, sbUnaryThreshold :: OptionSetting BaseIntegerType
sbUnaryThreshold = OptionSetting BaseIntegerType
unarySetting
, sbCacheStartSize :: OptionSetting BaseIntegerType
sbCacheStartSize = OptionSetting BaseIntegerType
cacheStartSetting
, sbProgramLoc :: IORef ProgramLoc
sbProgramLoc = IORef ProgramLoc
loc_ref
, sbCurAllocator :: IORef (ExprAllocator t)
sbCurAllocator = IORef (ExprAllocator t)
storage_ref
, sbNonLinearOps :: IORef Integer
sbNonLinearOps = IORef Integer
nonLinearOps
, sbVarBindings :: IORef (SymbolVarBimap t)
sbVarBindings = IORef (SymbolVarBimap t)
bindings_ref
, sbSolverLogger :: IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger = IORef (Maybe (SolverEvent -> IO ()))
logger_ref
}
newtype IdxCache t (f :: BaseType -> Type)
= IdxCache { forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap :: IORef (PM.MapF (Nonce t) f) }
newIdxCache :: MonadIO m => m (IdxCache t f)
newIdxCache :: forall (m :: Type -> Type) t (f :: BaseType -> Type).
MonadIO m =>
m (IdxCache t f)
newIdxCache = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall t (f :: BaseType -> Type).
IORef (MapF (Nonce t) f) -> IdxCache t f
IdxCache forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall {v} (k :: v -> Type) (a :: v -> Type). MapF k a
PM.empty
{-# INLINE lookupIdxValue #-}
lookupIdxValue :: MonadIO m => IdxCache t f -> Expr t tp -> m (Maybe (f tp))
lookupIdxValue :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Expr t tp -> m (Maybe (f tp))
lookupIdxValue IdxCache t f
_ SemiRingLiteral{} = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
_ StringExpr{} = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
_ BoolExpr{} = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
_ FloatExpr{} = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
lookupIdxValue IdxCache t f
c (NonceAppExpr NonceAppExpr t tp
e) = forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c (forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t tp
e)
lookupIdxValue IdxCache t f
c (AppExpr AppExpr t tp
e) = forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c (forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t tp
e)
lookupIdxValue IdxCache t f
c (BoundVarExpr ExprBoundVar t tp
i) = forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c (forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
i)
{-# INLINE lookupIdx #-}
lookupIdx :: (MonadIO m) => IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c Nonce t tp
n = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall {v} (k :: v -> Type) (tp :: v) (a :: v -> Type).
OrdF k =>
k tp -> MapF k a -> Maybe (a tp)
PM.lookup Nonce t tp
n forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef (forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c)
{-# INLINE insertIdxValue #-}
insertIdxValue :: MonadIO m => IdxCache t f -> Nonce t tp -> f tp -> m ()
insertIdxValue :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> f tp -> m ()
insertIdxValue IdxCache t f
c Nonce t tp
e f tp
v = seq :: forall a b. a -> b -> b
seq f tp
v forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c) forall a b. (a -> b) -> a -> b
$ (\MapF (Nonce t) f
m -> (forall {v} (k :: v -> Type) (tp :: v) (a :: v -> Type).
OrdF k =>
k tp -> a tp -> MapF k a -> MapF k a
PM.insert Nonce t tp
e f tp
v MapF (Nonce t) f
m, ()))
{-# INLINE deleteIdxValue #-}
deleteIdxValue :: MonadIO m => IdxCache t f -> Nonce t (tp :: BaseType) -> m ()
deleteIdxValue :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m ()
deleteIdxValue IdxCache t f
c Nonce t tp
e = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c) forall a b. (a -> b) -> a -> b
$ (\MapF (Nonce t) f
m -> (forall {v} (k :: v -> Type) (tp :: v) (a :: v -> Type).
OrdF k =>
k tp -> MapF k a -> MapF k a
PM.delete Nonce t tp
e MapF (Nonce t) f
m, ()))
clearIdxCache :: MonadIO m => IdxCache t f -> m ()
clearIdxCache :: forall (m :: Type -> Type) t (f :: BaseType -> Type).
MonadIO m =>
IdxCache t f -> m ()
clearIdxCache IdxCache t f
c = forall (m :: Type -> Type) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
atomicWriteIORef (forall t (f :: BaseType -> Type).
IdxCache t f -> IORef (MapF (Nonce t) f)
cMap IdxCache t f
c) forall {v} (k :: v -> Type) (a :: v -> Type). MapF k a
PM.empty
exprMaybeId :: Expr t tp -> Maybe (Nonce t tp)
exprMaybeId :: forall t (tp :: BaseType). Expr t tp -> Maybe (Nonce t tp)
exprMaybeId SemiRingLiteral{} = forall a. Maybe a
Nothing
exprMaybeId StringExpr{} = forall a. Maybe a
Nothing
exprMaybeId BoolExpr{} = forall a. Maybe a
Nothing
exprMaybeId FloatExpr{} = forall a. Maybe a
Nothing
exprMaybeId (NonceAppExpr NonceAppExpr t tp
e) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). NonceAppExpr t tp -> Nonce t tp
nonceExprId NonceAppExpr t tp
e
exprMaybeId (AppExpr AppExpr t tp
e) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). AppExpr t tp -> Nonce t tp
appExprId AppExpr t tp
e
exprMaybeId (BoundVarExpr ExprBoundVar t tp
e) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). ExprBoundVar t tp -> Nonce t tp
bvarId ExprBoundVar t tp
e
{-# INLINE idxCacheEval #-}
idxCacheEval :: (MonadIO m)
=> IdxCache t f
-> Expr t tp
-> m (f tp)
-> m (f tp)
idxCacheEval :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Expr t tp -> m (f tp) -> m (f tp)
idxCacheEval IdxCache t f
c Expr t tp
e m (f tp)
m = do
case forall t (tp :: BaseType). Expr t tp -> Maybe (Nonce t tp)
exprMaybeId Expr t tp
e of
Maybe (Nonce t tp)
Nothing -> m (f tp)
m
Just Nonce t tp
n -> forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (f tp) -> m (f tp)
idxCacheEval' IdxCache t f
c Nonce t tp
n m (f tp)
m
{-# INLINE idxCacheEval' #-}
idxCacheEval' :: (MonadIO m)
=> IdxCache t f
-> Nonce t tp
-> m (f tp)
-> m (f tp)
idxCacheEval' :: forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (f tp) -> m (f tp)
idxCacheEval' IdxCache t f
c Nonce t tp
n m (f tp)
m = do
Maybe (f tp)
mr <- forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> m (Maybe (f tp))
lookupIdx IdxCache t f
c Nonce t tp
n
case Maybe (f tp)
mr of
Just f tp
r -> forall (m :: Type -> Type) a. Monad m => a -> m a
return f tp
r
Maybe (f tp)
Nothing -> do
f tp
r <- m (f tp)
m
forall (m :: Type -> Type) t (f :: BaseType -> Type)
(tp :: BaseType).
MonadIO m =>
IdxCache t f -> Nonce t tp -> f tp -> m ()
insertIdxValue IdxCache t f
c Nonce t tp
n f tp
r
forall (m :: Type -> Type) a. Monad m => a -> m a
return f tp
r
curProgramLoc :: ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym = forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef ProgramLoc
sbProgramLoc ExprBuilder t st fs
sym)
sbNonceExpr :: ExprBuilder t st fs
-> NonceApp t (Expr t) tp
-> IO (Expr t tp)
sbNonceExpr :: forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym NonceApp t (Expr t) tp
a = do
ExprAllocator t
s <- forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sym)
ProgramLoc
pc <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
forall t.
ExprAllocator t
-> forall (tp :: BaseType).
ProgramLoc
-> NonceApp t (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
nonceExpr ExprAllocator t
s ProgramLoc
pc NonceApp t (Expr t) tp
a (forall (e :: BaseType -> Type) t (tp :: BaseType).
IsExpr e =>
(forall (u :: BaseType). e u -> AbstractValue u)
-> NonceApp t e tp -> AbstractValue tp
quantAbsEval forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue NonceApp t (Expr t) tp
a)
semiRingLit :: ExprBuilder t st fs
-> SR.SemiRingRepr sr
-> SR.Coefficient sr
-> IO (Expr t (SR.SemiRingBase sr))
semiRingLit :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sb SemiRingRepr sr
sr Coefficient sr
x = do
ProgramLoc
l <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sb
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr sr
sr Coefficient sr
x ProgramLoc
l
sbMakeExpr :: ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr :: forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym App (Expr t) tp
a = do
ExprAllocator t
s <- forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sym)
ProgramLoc
pc <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
let v :: AbstractValue tp
v = forall (e :: BaseType -> Type) (tp :: BaseType).
(IsExpr e, HashableF e, OrdF e) =>
(forall (u :: BaseType). e u -> AbstractValue u)
-> App e tp -> AbstractValue tp
abstractEval forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue App (Expr t) tp
a
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (forall (e :: BaseType -> Type) (tp :: BaseType). App e tp -> Bool
isNonLinearApp App (Expr t) tp
a) forall a b. (a -> b) -> a -> b
$
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef Integer
sbNonLinearOps ExprBuilder t st fs
sym) (\Integer
n -> (Integer
nforall a. Num a => a -> a -> a
+Integer
1,()))
case forall (e :: BaseType -> Type) (tp :: BaseType).
App e tp -> BaseTypeRepr tp
appType App (Expr t) tp
a of
BaseTypeRepr tp
BaseBoolRepr | Just Bool
b <- AbstractValue tp
v -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
BaseTypeRepr tp
BaseIntegerRepr | Just Integer
c <- forall tp. ValueRange tp -> Maybe tp
asSingleRange AbstractValue tp
v -> forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
c
BaseTypeRepr tp
BaseRealRepr | Just Rational
c <- forall tp. ValueRange tp -> Maybe tp
asSingleRange (RealAbstractValue -> ValueRange Rational
ravRange AbstractValue tp
v) -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
c
BaseBVRepr NatRepr w
w | Just Integer
x <- forall (w :: Natural). BVDomain w -> Maybe Integer
BVD.asSingleton AbstractValue tp
v -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
x)
BaseTypeRepr tp
_ -> forall t.
ExprAllocator t
-> forall (tp :: BaseType).
ProgramLoc -> App (Expr t) tp -> AbstractValue tp -> IO (Expr t tp)
appExpr ExprAllocator t
s ProgramLoc
pc App (Expr t) tp
a AbstractValue tp
v
updateVarBinding :: ExprBuilder t st fs
-> SolverSymbol
-> SymbolBinding t
-> IO ()
updateVarBinding :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm SymbolBinding t
v
| SolverSymbol
nm forall a. Eq a => a -> a -> Bool
== SolverSymbol
emptySymbol = forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
| Bool
otherwise =
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings ExprBuilder t st fs
sym) forall a b. (a -> b) -> a -> b
$ (\SymbolVarBimap t
x -> SymbolBinding t
v seq :: forall a b. a -> b -> b
`seq` (forall {t}.
SolverSymbol
-> SymbolBinding t -> SymbolVarBimap t -> SymbolVarBimap t
ins SolverSymbol
nm SymbolBinding t
v SymbolVarBimap t
x, ()))
where ins :: SolverSymbol
-> SymbolBinding t -> SymbolVarBimap t -> SymbolVarBimap t
ins SolverSymbol
n SymbolBinding t
x (SymbolVarBimap Bimap SolverSymbol (SymbolBinding t)
m) = forall t. Bimap SolverSymbol (SymbolBinding t) -> SymbolVarBimap t
SymbolVarBimap (forall a b. (Ord a, Ord b) => a -> b -> Bimap a b -> Bimap a b
Bimap.insert SolverSymbol
n SymbolBinding t
x Bimap SolverSymbol (SymbolBinding t)
m)
sbMakeBoundVar :: ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar :: forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp VarKind
k Maybe (AbstractValue tp)
absVal = do
Nonce t tp
n <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sym
ProgramLoc
pc <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! BVar { bvarId :: Nonce t tp
bvarId = Nonce t tp
n
, bvarLoc :: ProgramLoc
bvarLoc = ProgramLoc
pc
, bvarName :: SolverSymbol
bvarName = SolverSymbol
nm
, bvarType :: BaseTypeRepr tp
bvarType = BaseTypeRepr tp
tp
, bvarKind :: VarKind
bvarKind = VarKind
k
, bvarAbstractValue :: Maybe (AbstractValue tp)
bvarAbstractValue = Maybe (AbstractValue tp)
absVal
}
sbFreshIndex :: ExprBuilder t st fs -> IO (Nonce t (tp::BaseType))
sbFreshIndex :: forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sb = forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)
sbFreshSymFnNonce :: ExprBuilder t st fs -> IO (Nonce t (ctx:: Ctx BaseType))
sbFreshSymFnNonce :: forall t (st :: Type -> Type) fs (ctx :: Ctx BaseType).
ExprBuilder t st fs -> IO (Nonce t ctx)
sbFreshSymFnNonce ExprBuilder t st fs
sb = forall (m :: Type -> Type) s k (tp :: k).
NonceGenerator m s -> m (Nonce s tp)
freshNonce (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)
unaryThresholdOption :: CFG.ConfigOption BaseIntegerType
unaryThresholdOption :: ConfigOption BaseIntegerType
unaryThresholdOption = forall (tp :: BaseType).
BaseTypeRepr tp -> String -> ConfigOption tp
CFG.configOption BaseTypeRepr BaseIntegerType
BaseIntegerRepr String
"backend.unary_threshold"
unaryThresholdDesc :: CFG.ConfigDesc
unaryThresholdDesc :: ConfigDesc
unaryThresholdDesc = forall (tp :: BaseType).
ConfigOption tp
-> OptionStyle tp
-> Maybe (Doc Void)
-> Maybe (ConcreteVal tp)
-> ConfigDesc
CFG.mkOpt ConfigOption BaseIntegerType
unaryThresholdOption OptionStyle BaseIntegerType
sty Maybe (Doc Void)
help (forall a. a -> Maybe a
Just (Integer -> ConcreteVal BaseIntegerType
ConcreteInteger Integer
0))
where sty :: OptionStyle BaseIntegerType
sty = Bound Integer -> OptionStyle BaseIntegerType
CFG.integerWithMinOptSty (forall r. r -> Bound r
CFG.Inclusive Integer
0)
help :: Maybe (Doc Void)
help = forall a. a -> Maybe a
Just Doc Void
"Maximum number of values in unary bitvector encoding."
newExprBuilder ::
FloatModeRepr fm
-> st t
-> NonceGenerator IO t
-> IO (ExprBuilder t st (Flags fm))
newExprBuilder :: forall (fm :: FloatMode) (st :: Type -> Type) t.
FloatModeRepr fm
-> st t -> NonceGenerator IO t -> IO (ExprBuilder t st (Flags fm))
newExprBuilder FloatModeRepr fm
floatMode st t
st NonceGenerator IO t
gen = do
ExprAllocator t
es <- forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage NonceGenerator IO t
gen
let t :: Expr t 'BaseBoolType
t = forall t. Bool -> ProgramLoc -> Expr t 'BaseBoolType
BoolExpr Bool
True ProgramLoc
initializationLoc
let f :: Expr t 'BaseBoolType
f = forall t. Bool -> ProgramLoc -> Expr t 'BaseBoolType
BoolExpr Bool
False ProgramLoc
initializationLoc
let z :: Expr t (SemiRingBase 'SemiRingReal)
z = forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr Rational
0 ProgramLoc
initializationLoc
IORef ProgramLoc
loc_ref <- forall a. a -> IO (IORef a)
newIORef ProgramLoc
initializationLoc
IORef (ExprAllocator t)
storage_ref <- forall a. a -> IO (IORef a)
newIORef ExprAllocator t
es
IORef (SymbolVarBimap t)
bindings_ref <- forall a. a -> IO (IORef a)
newIORef forall t. SymbolVarBimap t
emptySymbolVarBimap
IORef
(Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st (Flags fm))))
uninterp_fn_cache_ref <- forall a. a -> IO (IORef a)
newIORef forall k a. Map k a
Map.empty
HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
matlabFnCache <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
IORef (Maybe (SolverEvent -> IO ()))
loggerRef <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
Config
cfg <- Integer -> [ConfigDesc] -> IO Config
CFG.initialConfig Integer
0
[ ConfigDesc
unaryThresholdDesc
, ConfigDesc
cacheStartSizeDesc
]
OptionSetting BaseIntegerType
unarySetting <- forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
unaryThresholdOption Config
cfg
OptionSetting BaseIntegerType
cacheStartSetting <- forall (tp :: BaseType).
ConfigOption tp -> Config -> IO (OptionSetting tp)
CFG.getOptionSetting ConfigOption BaseIntegerType
cacheStartSizeOption Config
cfg
[ConfigDesc] -> Config -> IO ()
CFG.extendConfig [forall t.
NonceGenerator IO t
-> IORef (ExprAllocator t)
-> OptionSetting BaseIntegerType
-> ConfigDesc
cacheOptDesc NonceGenerator IO t
gen IORef (ExprAllocator t)
storage_ref OptionSetting BaseIntegerType
cacheStartSetting] Config
cfg
IORef Integer
nonLinearOps <- forall a. a -> IO (IORef a)
newIORef Integer
0
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! SB { sbTrue :: BoolExpr t
sbTrue = forall {t}. Expr t 'BaseBoolType
t
, sbFalse :: BoolExpr t
sbFalse = forall {t}. Expr t 'BaseBoolType
f
, sbZero :: RealExpr t
sbZero = forall {t}. Expr t BaseRealType
z
, sbConfiguration :: Config
sbConfiguration = Config
cfg
, sbFloatReduce :: Bool
sbFloatReduce = Bool
True
, sbUnaryThreshold :: OptionSetting BaseIntegerType
sbUnaryThreshold = OptionSetting BaseIntegerType
unarySetting
, sbCacheStartSize :: OptionSetting BaseIntegerType
sbCacheStartSize = OptionSetting BaseIntegerType
cacheStartSetting
, sbProgramLoc :: IORef ProgramLoc
sbProgramLoc = IORef ProgramLoc
loc_ref
, sbExprCounter :: NonceGenerator IO t
sbExprCounter = NonceGenerator IO t
gen
, sbCurAllocator :: IORef (ExprAllocator t)
sbCurAllocator = IORef (ExprAllocator t)
storage_ref
, sbNonLinearOps :: IORef Integer
sbNonLinearOps = IORef Integer
nonLinearOps
, sbUserState :: st t
sbUserState = st t
st
, sbVarBindings :: IORef (SymbolVarBimap t)
sbVarBindings = IORef (SymbolVarBimap t)
bindings_ref
, sbUninterpFnCache :: IORef
(Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st (Flags fm))))
sbUninterpFnCache = IORef
(Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st (Flags fm))))
uninterp_fn_cache_ref
, sbMatlabFnCache :: HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
sbMatlabFnCache = HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
matlabFnCache
, sbSolverLogger :: IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger = IORef (Maybe (SolverEvent -> IO ()))
loggerRef
, sbFloatMode :: FloatModeRepr fm
sbFloatMode = FloatModeRepr fm
floatMode
}
getSymbolVarBimap :: ExprBuilder t st fs -> IO (SymbolVarBimap t)
getSymbolVarBimap :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO (SymbolVarBimap t)
getSymbolVarBimap ExprBuilder t st fs
sym = forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (SymbolVarBimap t)
sbVarBindings ExprBuilder t st fs
sym)
stopCaching :: ExprBuilder t st fs -> IO ()
stopCaching :: forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> IO ()
stopCaching ExprBuilder t st fs
sb = do
ExprAllocator t
s <- forall t. NonceGenerator IO t -> IO (ExprAllocator t)
newStorage (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)
forall a. IORef a -> a -> IO ()
atomicWriteIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sb) ExprAllocator t
s
startCaching :: ExprBuilder t st fs -> IO ()
startCaching :: forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> IO ()
startCaching ExprBuilder t st fs
sb = do
Integer
sz <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbCacheStartSize ExprBuilder t st fs
sb)
ExprAllocator t
s <- forall t. NonceGenerator IO t -> Int -> IO (ExprAllocator t)
newCachedStorage (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb) (forall a. Num a => Integer -> a
fromInteger Integer
sz)
forall a. IORef a -> a -> IO ()
atomicWriteIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (ExprAllocator t)
sbCurAllocator ExprBuilder t st fs
sb) ExprAllocator t
s
bvBinDivOp :: (1 <= w)
=> (NatRepr w -> BV.BV w -> BV.BV w -> BV.BV w)
-> (NatRepr w -> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp :: forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp NatRepr w -> BV w -> BV w -> BV w
f NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w)
c ExprBuilder t st fs
sb BVExpr t w
x BVExpr t w
y = do
let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth BVExpr t w
x
case (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV BVExpr t w
x, forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV BVExpr t w
y) of
(Just BV w
i, Just BV w
j) | BV w
j forall a. Eq a => a -> a -> Bool
/= forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr w
w forall a b. (a -> b) -> a -> b
$ NatRepr w -> BV w -> BV w -> BV w
f NatRepr w
w BV w
i BV w
j
(Maybe (BV w), Maybe (BV w))
_ -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb forall a b. (a -> b) -> a -> b
$ NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w)
c NatRepr w
w BVExpr t w
x BVExpr t w
y
asConcreteIndices :: IsExpr e
=> Ctx.Assignment e ctx
-> Maybe (Ctx.Assignment IndexLit ctx)
asConcreteIndices :: forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
IsExpr e =>
Assignment e ctx -> Maybe (Assignment IndexLit ctx)
asConcreteIndices = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> Maybe (IndexLit tp)
f
where f :: IsExpr e => e tp -> Maybe (IndexLit tp)
f :: forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> Maybe (IndexLit tp)
f e tp
x =
case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e tp
x of
BaseTypeRepr tp
BaseIntegerRepr -> Integer -> IndexLit BaseIntegerType
IntIndexLit forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger e tp
x
BaseBVRepr NatRepr w
w -> forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> IndexLit ('BaseBVType w)
BVIndexLit NatRepr w
w forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV e tp
x
BaseTypeRepr tp
_ -> forall a. Maybe a
Nothing
symbolicIndices :: forall sym ctx
. IsExprBuilder sym
=> sym
-> Ctx.Assignment IndexLit ctx
-> IO (Ctx.Assignment (SymExpr sym) ctx)
symbolicIndices :: forall sym (ctx :: Ctx BaseType).
IsExprBuilder sym =>
sym -> Assignment IndexLit ctx -> IO (Assignment (SymExpr sym) ctx)
symbolicIndices sym
sym = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC forall (tp :: BaseType). IndexLit tp -> IO (SymExpr sym tp)
f
where f :: IndexLit tp -> IO (SymExpr sym tp)
f :: forall (tp :: BaseType). IndexLit tp -> IO (SymExpr sym tp)
f (IntIndexLit Integer
n) = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym Integer
n
f (BVIndexLit NatRepr w
w BV w
i) = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit sym
sym NatRepr w
w BV w
i
betaReduce :: ExprBuilder t st fs
-> ExprSymFn t args ret
-> Ctx.Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce :: forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym ExprSymFn t args ret
f Assignment (Expr t) args
args =
case forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args ret
f of
UninterpFnInfo{} ->
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! forall t (args :: Ctx BaseType) (tp :: BaseType)
(e :: BaseType -> Type).
ExprSymFn t args tp -> Assignment e args -> NonceApp t e tp
FnApp ExprSymFn t args ret
f Assignment (Expr t) args
args
DefinedFnInfo Assignment (ExprBoundVar t) args
bound_vars Expr t ret
e UnfoldPolicy
_ -> do
forall t (st :: Type -> Type) fs (ret :: BaseType)
(args :: Ctx BaseType).
ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
evalBoundVars ExprBuilder t st fs
sym Expr t ret
e Assignment (ExprBoundVar t) args
bound_vars Assignment (Expr t) args
args
MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
fn_id Assignment (ExprBoundVar t) args
_ Expr t ret
_ -> do
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsExprBuilder sym =>
MatlabSolverFn (SymExpr sym) args ret
-> sym -> Assignment (SymExpr sym) args -> IO (SymExpr sym ret)
evalMatlabSolverFn MatlabSolverFn (Expr t) args ret
fn_id ExprBuilder t st fs
sym Assignment (Expr t) args
args
runIfChanged :: (Eq e, Monad m)
=> e
-> (e -> m e)
-> r
-> (e -> m r)
-> m r
runIfChanged :: forall e (m :: Type -> Type) r.
(Eq e, Monad m) =>
e -> (e -> m e) -> r -> (e -> m r) -> m r
runIfChanged e
x e -> m e
f r
unChanged e -> m r
onChange = do
e
y <- e -> m e
f e
x
if e
x forall a. Eq a => a -> a -> Bool
== e
y then
forall (m :: Type -> Type) a. Monad m => a -> m a
return r
unChanged
else
e -> m r
onChange e
y
recordBoundVar :: PH.HashTable RealWorld (Expr t) (Expr t)
-> ExprBoundVar t tp
-> IO ()
recordBoundVar :: forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar HashTable RealWorld (Expr t) (Expr t)
tbl ExprBoundVar t tp
v = do
let e :: Expr t tp
e = forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t tp
v
Maybe (Expr t tp)
mr <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall {k} (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> ST s (Maybe (val tp))
PH.lookup HashTable RealWorld (Expr t) (Expr t)
tbl Expr t tp
e
case Maybe (Expr t tp)
mr of
Just Expr t tp
r -> do
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (Expr t tp
r forall a. Eq a => a -> a -> Bool
/= Expr t tp
e) forall a b. (a -> b) -> a -> b
$ do
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Simulator internal error; do not support rebinding variables."
Maybe (Expr t tp)
Nothing -> do
forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld (Expr t) (Expr t)
tbl Expr t tp
e Expr t tp
e
data CachedSymFn t c
= forall a r
. (c ~ (a ::> r))
=> CachedSymFn Bool (ExprSymFn t a r)
data EvalHashTables t
= EvalHashTables { forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable :: !(PH.HashTable RealWorld (Expr t) (Expr t))
, forall t.
EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable :: !(PH.HashTable RealWorld (Nonce t) (CachedSymFn t))
}
evalSimpleFn :: EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool,ExprSymFn t idx ret)
evalSimpleFn :: forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
(ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbl ExprBuilder t st fs
sym ExprSymFn t idx ret
f = do
let n :: Nonce t (idx ::> ret)
n = forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId ExprSymFn t idx ret
f
case forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t idx ret
f of
UninterpFnInfo{} -> do
CachedSymFn Bool
changed ExprSymFn t a r
f' <- forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
(tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (forall t.
EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable EvalHashTables t
tbl) Nonce t (idx ::> ret)
n forall a b. (a -> b) -> a -> b
$
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
False ExprSymFn t idx ret
f
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
changed, ExprSymFn t a r
f')
DefinedFnInfo Assignment (ExprBoundVar t) idx
vars Expr t ret
e UnfoldPolicy
evalFn -> do
let nm :: SolverSymbol
nm = forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName ExprSymFn t idx ret
f
CachedSymFn Bool
changed ExprSymFn t a r
f' <-
forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
(tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (forall t.
EvalHashTables t -> HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable EvalHashTables t
tbl) Nonce t (idx ::> ret)
n forall a b. (a -> b) -> a -> b
$ do
forall {k} {l} (t :: (k -> Type) -> l -> Type) (m :: Type -> Type)
(f :: k -> Type) a.
(FoldableFC t, Applicative m) =>
(forall (x :: k). f x -> m a) -> forall (x :: l). t f x -> m ()
traverseFC_ (forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbl)) Assignment (ExprBoundVar t) idx
vars
Expr t ret
e' <- forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbl ExprBuilder t st fs
sym Expr t ret
e
if Expr t ret
e forall a. Eq a => a -> a -> Bool
== Expr t ret
e' then
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
False ExprSymFn t idx ret
f
else
forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
True forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment (BoundVar sym) args
-> SymExpr sym ret
-> UnfoldPolicy
-> IO (SymFn sym args ret)
definedFn ExprBuilder t st fs
sym SolverSymbol
nm Assignment (ExprBoundVar t) idx
vars Expr t ret
e' UnfoldPolicy
evalFn
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
changed, ExprSymFn t a r
f')
MatlabSolverFnInfo{} -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (Bool
False, ExprSymFn t idx ret
f)
evalBoundVars' :: forall t st fs ret
. EvalHashTables t
-> ExprBuilder t st fs
-> Expr t ret
-> IO (Expr t ret)
evalBoundVars' :: forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t ret
e0 =
case Expr t ret
e0 of
SemiRingLiteral{} -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
StringExpr{} -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
BoolExpr{} -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
FloatExpr{} -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
AppExpr AppExpr t ret
ae -> forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
(tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 forall a b. (a -> b) -> a -> b
$ do
let a :: App (Expr t) ret
a = forall t (tp :: BaseType). AppExpr t tp -> App (Expr t) tp
appExprApp AppExpr t ret
ae
App (Expr t) ret
a' <- forall (m :: Type -> Type) (f :: BaseType -> Type)
(e :: BaseType -> Type) (utp :: BaseType).
(Applicative m, OrdF f, Eq (f 'BaseBoolType), HashableF f,
HasAbsValue f) =>
(forall (tp :: BaseType). e tp -> m (f tp))
-> App e utp -> m (App f utp)
traverseApp (forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) App (Expr t) ret
a
if App (Expr t) ret
a forall a. Eq a => a -> a -> Bool
== App (Expr t) ret
a' then
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
else
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> (forall (w :: Natural).
(1 <= w) =>
sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w)))
-> App (SymExpr sym) tp
-> IO (SymExpr sym tp)
reduceApp ExprBuilder t st fs
sym forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary App (Expr t) ret
a'
NonceAppExpr NonceAppExpr t ret
ae -> forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
(tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 forall a b. (a -> b) -> a -> b
$ do
case forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp NonceAppExpr t ret
ae of
Annotation BaseTypeRepr ret
tpr Nonce t ret
n Expr t ret
a -> do
Expr t ret
a' <- forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t ret
a
if Expr t ret
a forall a. Eq a => a -> a -> Bool
== Expr t ret
a' then
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
else
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (tp :: BaseType) t (e :: BaseType -> Type).
BaseTypeRepr tp -> Nonce t tp -> e tp -> NonceApp t e tp
Annotation BaseTypeRepr ret
tpr Nonce t ret
n Expr t ret
a'
Forall ExprBoundVar t tp1
v Expr t 'BaseBoolType
e -> do
forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) ExprBoundVar t tp1
v
forall e (m :: Type -> Type) r.
(Eq e, Monad m) =>
e -> (e -> m e) -> r -> (e -> m r) -> m r
runIfChanged Expr t 'BaseBoolType
e (forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) Expr t ret
e0 (forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
forallPred ExprBuilder t st fs
sym ExprBoundVar t tp1
v)
Exists ExprBoundVar t tp1
v Expr t 'BaseBoolType
e -> do
forall t (tp :: BaseType).
HashTable RealWorld (Expr t) (Expr t) -> ExprBoundVar t tp -> IO ()
recordBoundVar (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) ExprBoundVar t tp1
v
forall e (m :: Type -> Type) r.
(Eq e, Monad m) =>
e -> (e -> m e) -> r -> (e -> m r) -> m r
runIfChanged Expr t 'BaseBoolType
e (forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) Expr t ret
e0 (forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> BoundVar sym tp -> Pred sym -> IO (Pred sym)
existsPred ExprBuilder t st fs
sym ExprBoundVar t tp1
v)
ArrayFromFn ExprSymFn t (idx ::> itp) ret
f -> do
(Bool
changed, ExprSymFn t (idx ::> itp) ret
f') <- forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
(ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) ret
f
if Bool -> Bool
not Bool
changed then
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
else
forall sym (idx :: Ctx BaseType) (itp :: BaseType)
(ret :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (idx ::> itp) ret
-> IO (SymArray sym (idx ::> itp) ret)
arrayFromFn ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) ret
f'
MapOverArrays ExprSymFn t (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args -> do
(Bool
changed, ExprSymFn t (ctx ::> d) r
f') <- forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
(ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t (ctx ::> d) r
f
let evalWrapper :: ArrayResultWrapper (Expr t) (idx ::> itp) utp
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
evalWrapper :: forall (idx :: Ctx BaseType) (itp :: BaseType) (utp :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) utp
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
evalWrapper (ArrayResultWrapper Expr t (BaseArrayType (idx ::> itp) utp)
a) =
forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
ArrayResultWrapper forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t (BaseArrayType (idx ::> itp) utp)
a
Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args' <- forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC forall (idx :: Ctx BaseType) (itp :: BaseType) (utp :: BaseType).
ArrayResultWrapper (Expr t) (idx ::> itp) utp
-> IO (ArrayResultWrapper (Expr t) (idx ::> itp) utp)
evalWrapper Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args
if Bool -> Bool
not Bool
changed Bool -> Bool -> Bool
&& Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args forall a. Eq a => a -> a -> Bool
== Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args' then
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
else
forall sym (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
(idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (ctx ::> d) r
-> Assignment
(ArrayResultWrapper (SymExpr sym) (idx ::> itp)) (ctx ::> d)
-> IO (SymArray sym (idx ::> itp) r)
arrayMap ExprBuilder t st fs
sym ExprSymFn t (ctx ::> d) r
f' Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args'
ArrayTrueOnEntries ExprSymFn t (idx ::> itp) 'BaseBoolType
f Expr t (BaseArrayType (idx ::> itp) 'BaseBoolType)
a -> do
(Bool
changed, ExprSymFn t (idx ::> itp) 'BaseBoolType
f') <- forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
(ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) 'BaseBoolType
f
Expr t (BaseArrayType (idx ::> itp) 'BaseBoolType)
a' <- forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t (BaseArrayType (idx ::> itp) 'BaseBoolType)
a
if Bool -> Bool
not Bool
changed Bool -> Bool -> Bool
&& Expr t (BaseArrayType (idx ::> itp) 'BaseBoolType)
a forall a. Eq a => a -> a -> Bool
== Expr t (BaseArrayType (idx ::> itp) 'BaseBoolType)
a' then
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
else
forall sym (idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (idx ::> itp) 'BaseBoolType
-> SymArray sym (idx ::> itp) 'BaseBoolType
-> IO (Pred sym)
arrayTrueOnEntries ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) 'BaseBoolType
f' Expr t (BaseArrayType (idx ::> itp) 'BaseBoolType)
a'
FnApp ExprSymFn t args ret
f Assignment (Expr t) args
a -> do
(Bool
changed, ExprSymFn t args ret
f') <- forall t (st :: Type -> Type) fs (idx :: Ctx BaseType)
(ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs
-> ExprSymFn t idx ret
-> IO (Bool, ExprSymFn t idx ret)
evalSimpleFn EvalHashTables t
tbls ExprBuilder t st fs
sym ExprSymFn t args ret
f
Assignment (Expr t) args
a' <- forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC (forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym) Assignment (Expr t) args
a
if Bool -> Bool
not Bool
changed Bool -> Bool -> Bool
&& Assignment (Expr t) args
a forall a. Eq a => a -> a -> Bool
== Assignment (Expr t) args
a' then
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
else
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t st fs
sym ExprSymFn t args ret
f' Assignment (Expr t) args
a'
BoundVarExpr{} -> forall {k} (k :: k -> Type) (m :: Type -> Type) (a :: k -> Type)
(tp :: k).
(HashableF k, TestEquality k, MonadIO m) =>
HashTable RealWorld k a -> k tp -> m (a tp) -> m (a tp)
cachedEval (forall t. EvalHashTables t -> HashTable RealWorld (Expr t) (Expr t)
exprTable EvalHashTables t
tbls) Expr t ret
e0 forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t ret
e0
initHashTable :: (HashableF key, TestEquality key)
=> Ctx.Assignment key args
-> Ctx.Assignment val args
-> ST s (PH.HashTable s key val)
initHashTable :: forall {k} (key :: k -> Type) (args :: Ctx k) (val :: k -> Type) s.
(HashableF key, TestEquality key) =>
Assignment key args
-> Assignment val args -> ST s (HashTable s key val)
initHashTable Assignment key args
keys Assignment val args
vals = do
let sz :: Size args
sz = forall {k} (f :: k -> Type) (ctx :: Ctx k).
Assignment f ctx -> Size ctx
Ctx.size Assignment key args
keys
HashTable s key val
tbl <- forall {k1} s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized (forall {k} (ctx :: Ctx k). Size ctx -> Int
Ctx.sizeInt Size args
sz)
forall {k} (ctx :: Ctx k) (m :: Type -> Type).
Applicative m =>
Size ctx -> (forall (tp :: k). Index ctx tp -> m ()) -> m ()
Ctx.forIndexM Size args
sz forall a b. (a -> b) -> a -> b
$ \Index args tp
i -> do
forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable s key val
tbl (Assignment key args
keys forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index args tp
i) (Assignment val args
vals forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index args tp
i)
forall (m :: Type -> Type) a. Monad m => a -> m a
return HashTable s key val
tbl
evalBoundVars :: ExprBuilder t st fs
-> Expr t ret
-> Ctx.Assignment (ExprBoundVar t) args
-> Ctx.Assignment (Expr t) args
-> IO (Expr t ret)
evalBoundVars :: forall t (st :: Type -> Type) fs (ret :: BaseType)
(args :: Ctx BaseType).
ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
evalBoundVars ExprBuilder t st fs
sym Expr t ret
e Assignment (ExprBoundVar t) args
vars Assignment (Expr t) args
exprs = do
HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall {k} (key :: k -> Type) (args :: Ctx k) (val :: k -> Type) s.
(HashableF key, TestEquality key) =>
Assignment key args
-> Assignment val args -> ST s (HashTable s key val)
initHashTable (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr Assignment (ExprBoundVar t) args
vars) Assignment (Expr t) args
exprs
HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
let tbls :: EvalHashTables t
tbls = EvalHashTables { exprTable :: HashTable RealWorld (Expr t) (Expr t)
exprTable = HashTable RealWorld (Expr t) (Expr t)
expr_tbl
, fnTable :: HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable = HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl
}
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym Expr t ret
e
sbConcreteLookup :: forall t st fs d tp range
. ExprBuilder t st fs
-> Expr t (BaseArrayType (d::>tp) range)
-> Maybe (Ctx.Assignment IndexLit (d::>tp))
-> Ctx.Assignment (Expr t) (d::>tp)
-> IO (Expr t range)
sbConcreteLookup :: forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
| Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
entry_map Expr t ('BaseArrayType (i ::> itp) tp1)
def) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
, Just Assignment IndexLit (d ::> tp)
cidx <- Maybe (Assignment IndexLit (d ::> tp))
mcidx =
case forall (ctx :: Ctx BaseType) (e :: BaseType -> Type)
(tp :: BaseType).
Assignment IndexLit ctx -> ArrayUpdateMap e ctx tp -> Maybe (e tp)
AUM.lookup Assignment IndexLit (d ::> tp)
cidx ArrayUpdateMap (Expr t) (i ::> itp) tp1
entry_map of
Just Expr t tp1
v -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t tp1
v
Maybe (Expr t tp1)
Nothing -> forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t ('BaseArrayType (i ::> itp) tp1)
def Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
| Just (ArrayFromFn ExprSymFn t (idx ::> itp) ret
f) <- forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym ExprSymFn t (idx ::> itp) ret
f Assignment (Expr t) (d ::> tp)
idx
| Just (ConstantArray Assignment BaseTypeRepr (i ::> tp1)
_ BaseTypeRepr b
_ Expr t b
v) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t b
v
| Just (UpdateArray BaseTypeRepr b
range Assignment BaseTypeRepr (i ::> tp1)
idx_tps Expr t ('BaseArrayType (i ::> tp1) b)
arr Assignment (Expr t) (i ::> tp1)
update_idx Expr t b
v) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
, Assignment BaseTypeRepr ctx
Ctx.Empty Ctx.:> BaseBVRepr{} <- Assignment BaseTypeRepr (i ::> tp1)
idx_tps
, Assignment (Expr t) ctx
Ctx.Empty Ctx.:> Expr t tp
idx0 <- Assignment (Expr t) (d ::> tp)
idx
, Assignment (Expr t) ctx
Ctx.Empty Ctx.:> Expr t tp
update_idx0 <- Assignment (Expr t) (i ::> tp1)
update_idx = do
Expr t ('BaseBVType w)
diff <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym Expr t tp
idx0 Expr t tp
update_idx0
Expr t 'BaseBoolType
is_diff_zero <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t ('BaseBVType w)
diff forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType w)
diff) (forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t ('BaseBVType w)
diff))
case forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
is_diff_zero of
Just Bool
True -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t b
v
Just Bool
False -> forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t ('BaseArrayType (i ::> tp1) b)
arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
Maybe Bool
_ -> do
(Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
sliced_idx) <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 Assignment (Expr t) (d ::> tp)
idx
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (tp :: BaseType) (e :: BaseType -> Type) (i :: Ctx BaseType)
(tp1 :: BaseType).
BaseTypeRepr tp
-> e (BaseArrayType (i ::> tp1) tp)
-> Assignment e (i ::> tp1)
-> App e tp
SelectArray BaseTypeRepr b
range Expr t (BaseArrayType (d ::> tp) range)
sliced_arr Assignment (Expr t) (d ::> tp)
sliced_idx)
| Just (CopyArray NatRepr w
w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_dest_arr Expr t (BaseBVType w)
dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr Expr t (BaseBVType w)
src_begin_idx Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
dest_end_idx Expr t (BaseBVType w)
_src_end_idx) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
, Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
, Integer
lookup_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
, Just Integer
dest_begin_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
dest_begin_idx
, Just Integer
dest_end_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
dest_end_idx
, Integer
dest_begin_idx_unsigned forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned
, Integer
lookup_idx_unsigned forall a. Ord a => a -> a -> Bool
< Integer
dest_end_idx_unsigned = do
Expr t (BaseBVType w)
new_lookup_idx <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t (BaseBVType w)
src_begin_idx forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
(forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w forall a b. (a -> b) -> a -> b
$ forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w forall a b. (a -> b) -> a -> b
$ Integer
lookup_idx_unsigned forall a. Num a => a -> a -> a
- Integer
dest_begin_idx_unsigned)
forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> IO (SymExpr sym b)
arrayLookup ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> Type) (tp :: k).
f tp -> Assignment f (EmptyCtx ::> tp)
singleton Expr t (BaseBVType w)
new_lookup_idx
| Just (CopyArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Expr t (BaseBVType w)
dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_src_arr Expr t (BaseBVType w)
_src_begin_idx Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
_dest_end_idx Expr t (BaseBVType w)
_src_end_idx) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
, Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
, Integer
lookup_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
, Just Integer
dest_begin_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
dest_begin_idx
, Integer
lookup_idx_unsigned forall a. Ord a => a -> a -> Bool
< Integer
dest_begin_idx_unsigned =
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
| Just (CopyArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Expr t (BaseBVType w)
_dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_src_arr Expr t (BaseBVType w)
_src_begin_idx Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
dest_end_idx Expr t (BaseBVType w)
_src_end_idx) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
, Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
, Integer
lookup_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
, Just Integer
dest_end_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
dest_end_idx
, Integer
dest_end_idx_unsigned forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned =
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
| Just (SetArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_arr Expr t (BaseBVType w)
begin_idx Expr t a
val Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
end_idx) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
, Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
, Integer
lookup_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
, Just Integer
begin_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
begin_idx
, Just Integer
end_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
end_idx
, Integer
begin_idx_unsigned forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned
, Integer
lookup_idx_unsigned forall a. Ord a => a -> a -> Bool
< Integer
end_idx_unsigned =
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t a
val
| Just (SetArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
begin_idx Expr t a
_val Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
_end_idx) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
, Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
, Integer
lookup_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
, Just Integer
begin_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
begin_idx
, Integer
lookup_idx_unsigned forall a. Ord a => a -> a -> Bool
< Integer
begin_idx_unsigned =
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
| Just (SetArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
_begin_idx Expr t a
_val Expr t (BaseBVType w)
_len Expr t (BaseBVType w)
end_idx) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0
, Just (Assignment IndexLit ctx
Empty :> (BVIndexLit NatRepr w
_ BV w
lookup_idx_bv)) <- Maybe (Assignment IndexLit (d ::> tp))
mcidx
, Integer
lookup_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
lookup_idx_bv
, Just Integer
end_idx_unsigned <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
end_idx
, Integer
end_idx_unsigned forall a. Ord a => a -> a -> Bool
<= Integer
lookup_idx_unsigned =
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
| Just (MapOverArrays ExprSymFn t (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
let eval :: ArrayResultWrapper (Expr t) (d::>tp) utp
-> IO (Expr t utp)
eval :: forall (utp :: BaseType).
ArrayResultWrapper (Expr t) (d ::> tp) utp -> IO (Expr t utp)
eval ArrayResultWrapper (Expr t) (d ::> tp) utp
a = forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) (d ::> tp) utp
a) Maybe (Assignment IndexLit (d ::> tp))
mcidx Assignment (Expr t) (d ::> tp)
idx
forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym ExprSymFn t (ctx ::> d) r
f forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC forall (utp :: BaseType).
ArrayResultWrapper (Expr t) (d ::> tp) utp -> IO (Expr t utp)
eval Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args
| Bool
otherwise = do
case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t (BaseArrayType (d ::> tp) range)
arr0 of
BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
range -> do
(Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
sliced_idx) <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 Assignment (Expr t) (d ::> tp)
idx
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (tp :: BaseType) (e :: BaseType -> Type) (i :: Ctx BaseType)
(tp1 :: BaseType).
BaseTypeRepr tp
-> e (BaseArrayType (i ::> tp1) tp)
-> Assignment e (i ::> tp1)
-> App e tp
SelectArray BaseTypeRepr xs
range Expr t (BaseArrayType (d ::> tp) range)
sliced_arr Assignment (Expr t) (d ::> tp)
sliced_idx)
sliceArrayLookupUpdate ::
ExprBuilder t st fs ->
Expr t (BaseArrayType (d::>tp) range) ->
Ctx.Assignment (Expr t) (d::>tp) ->
IO (Expr t (BaseArrayType (d::>tp) range), Ctx.Assignment (Expr t) (d::>tp))
sliceArrayLookupUpdate :: forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 Assignment (Expr t) (d ::> tp)
lookup_idx
| Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
entry_map Expr t ('BaseArrayType (i ::> itp) tp1)
arr) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 =
case forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
IsExpr e =>
Assignment e ctx -> Maybe (Assignment IndexLit ctx)
asConcreteIndices Assignment (Expr t) (d ::> tp)
lookup_idx of
Just Assignment IndexLit (d ::> tp)
lookup_concrete_idx ->
case forall (ctx :: Ctx BaseType) (e :: BaseType -> Type)
(tp :: BaseType).
Assignment IndexLit ctx -> ArrayUpdateMap e ctx tp -> Maybe (e tp)
AUM.lookup Assignment IndexLit (d ::> tp)
lookup_concrete_idx ArrayUpdateMap (Expr t) (i ::> itp) tp1
entry_map of
Just Expr t tp1
val -> do
Expr t ('BaseArrayType (i ::> itp) tp1)
arr_base <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t ('BaseArrayType (i ::> itp) tp1)
arr
Expr t (BaseArrayType (d ::> tp) range)
sliced_arr <- forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> SymExpr sym b
-> IO (SymArray sym (idx ::> tp) b)
arrayUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (i ::> itp) tp1)
arr_base Assignment (Expr t) (d ::> tp)
lookup_idx Expr t tp1
val
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
lookup_idx)
Maybe (Expr t tp1)
Nothing -> forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (i ::> itp) tp1)
arr Assignment (Expr t) (d ::> tp)
lookup_idx
Maybe (Assignment IndexLit (d ::> tp))
Nothing ->
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
arr0, Assignment (Expr t) (d ::> tp)
lookup_idx)
| Just (CopyArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Expr t (BaseBVType w)
dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr Expr t (BaseBVType w)
src_begin_idx Expr t (BaseBVType w)
len Expr t (BaseBVType w)
dest_end_idx Expr t (BaseBVType w)
_src_end_idx) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
Expr t 'BaseBoolType
p0 <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym Expr t (BaseBVType w)
dest_begin_idx (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx)
Expr t 'BaseBoolType
p1 <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUlt ExprBuilder t st fs
sym (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx) Expr t (BaseBVType w)
dest_end_idx
case (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
p0, forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
p1) of
(Just Bool
True, Just Bool
True) -> do
Expr t tp
new_lookup_idx <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t (BaseBVType w)
src_begin_idx forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx) Expr t (BaseBVType w)
dest_begin_idx
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> Type) (tp :: k).
f tp -> Assignment f (EmptyCtx ::> tp)
singleton Expr t tp
new_lookup_idx
(Just Bool
False, Maybe Bool
_) ->
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Assignment (Expr t) (d ::> tp)
lookup_idx
(Maybe Bool
_, Just Bool
False) ->
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Assignment (Expr t) (d ::> tp)
lookup_idx
(Maybe Bool, Maybe Bool)
_ -> do
(Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_dest_arr, Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_dest_idx) <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
dest_arr Assignment (Expr t) (d ::> tp)
lookup_idx
Expr t (BaseBVType w)
sliced_dest_begin_idx <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t (BaseBVType w)
dest_begin_idx forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_dest_idx) (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx)
Expr t (BaseArrayType (d ::> tp) range)
sliced_arr <- forall sym (w :: Natural) (a :: BaseType).
(IsExprBuilder sym, 1 <= w) =>
sym
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymBV sym w
-> IO (SymArray sym (SingleCtx (BaseBVType w)) a)
arrayCopy ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_dest_arr Expr t (BaseBVType w)
sliced_dest_begin_idx Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
src_arr Expr t (BaseBVType w)
src_begin_idx Expr t (BaseBVType w)
len
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_dest_idx)
| Just (SetArray NatRepr w
_w BaseTypeRepr a
_a_repr Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
begin_idx Expr t a
val Expr t (BaseBVType w)
len Expr t (BaseBVType w)
end_idx) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
Expr t 'BaseBoolType
p0 <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym Expr t (BaseBVType w)
begin_idx (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx)
Expr t 'BaseBoolType
p1 <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUlt ExprBuilder t st fs
sym (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx) Expr t (BaseBVType w)
end_idx
case (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
p0, forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
p1) of
(Just Bool
True, Just Bool
True) -> do
Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr_base <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr
Expr t (BaseArrayType (d ::> tp) range)
sliced_arr <- forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> SymExpr sym b
-> IO (SymArray sym (idx ::> tp) b)
arrayUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr_base Assignment (Expr t) (d ::> tp)
lookup_idx Expr t a
val
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
lookup_idx)
(Just Bool
False, Maybe Bool
_) ->
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Assignment (Expr t) (d ::> tp)
lookup_idx
(Maybe Bool
_, Just Bool
False) ->
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Assignment (Expr t) (d ::> tp)
lookup_idx
(Maybe Bool, Maybe Bool)
_ -> do
(Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_arr, Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_idx) <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Assignment (Expr t) (d ::> tp)
lookup_idx
Expr t (BaseBVType w)
sliced_begin_idx <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t (BaseBVType w)
begin_idx forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<<
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_idx) (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment (Expr t) (d ::> tp)
lookup_idx)
Expr t (BaseArrayType (d ::> tp) range)
sliced_arr' <- forall sym (w :: Natural) (a :: BaseType).
(IsExprBuilder sym, 1 <= w) =>
sym
-> SymArray sym (SingleCtx (BaseBVType w)) a
-> SymBV sym w
-> SymExpr sym a
-> SymBV sym w
-> IO (SymArray sym (SingleCtx (BaseBVType w)) a)
arraySet ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
sliced_arr Expr t (BaseBVType w)
sliced_begin_idx Expr t a
val Expr t (BaseBVType w)
len
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr', Assignment (Expr t) (SingleCtx (BaseBVType w))
sliced_idx)
| Just (BaseIte BaseTypeRepr (BaseArrayType (d ::> tp) range)
_ Integer
_ Expr t 'BaseBoolType
p Expr t (BaseArrayType (d ::> tp) range)
x Expr t (BaseArrayType (d ::> tp) range)
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 = do
(Expr t (BaseArrayType (d ::> tp) range)
x', Assignment (Expr t) (d ::> tp)
i') <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
x Assignment (Expr t) (d ::> tp)
lookup_idx
(Expr t (BaseArrayType (d ::> tp) range)
y', Assignment (Expr t) (d ::> tp)
j') <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Assignment (Expr t) (d ::> tp)
-> IO
(Expr t (BaseArrayType (d ::> tp) range),
Assignment (Expr t) (d ::> tp))
sliceArrayLookupUpdate ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
y Assignment (Expr t) (d ::> tp)
lookup_idx
Expr t (BaseArrayType (d ::> tp) range)
sliced_arr <- forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
p Expr t (BaseArrayType (d ::> tp) range)
x' Expr t (BaseArrayType (d ::> tp) range)
y'
Assignment (Expr t) (d ::> tp)
sliced_idx <- forall {k} (m :: Type -> Type) (f :: k -> Type) (g :: k -> Type)
(h :: k -> Type) (a :: Ctx k).
Applicative m =>
(forall (x :: k). f x -> g x -> m (h x))
-> Assignment f a -> Assignment g a -> m (Assignment h a)
Ctx.zipWithM (forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
p) Assignment (Expr t) (d ::> tp)
i' Assignment (Expr t) (d ::> tp)
j'
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
sliced_arr, Assignment (Expr t) (d ::> tp)
sliced_idx)
| Bool
otherwise = forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t (BaseArrayType (d ::> tp) range)
arr0, Assignment (Expr t) (d ::> tp)
lookup_idx)
arrayUpdateBase ::
ExprBuilder t st fs ->
Expr t (BaseArrayType (d::>tp) range) ->
IO (Expr t (BaseArrayType (d::>tp) range))
arrayUpdateBase :: forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
arr0 = case forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType (d ::> tp) range)
arr0 of
Just (UpdateArray BaseTypeRepr b
_ Assignment BaseTypeRepr (i ::> tp1)
_ Expr t ('BaseArrayType (i ::> tp1) b)
arr Assignment (Expr t) (i ::> tp1)
_ Expr t b
_) -> forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t ('BaseArrayType (i ::> tp1) b)
arr
Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
_ Expr t ('BaseArrayType (i ::> itp) tp1)
arr) -> forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t ('BaseArrayType (i ::> itp) tp1)
arr
Just (CopyArray NatRepr w
_ BaseTypeRepr a
_ Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
_ Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
_ Expr t (BaseBVType w)
_ Expr t (BaseBVType w)
_ Expr t (BaseBVType w)
_ Expr t (BaseBVType w)
_) -> forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr
Just (SetArray NatRepr w
_ BaseTypeRepr a
_ Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr Expr t (BaseBVType w)
_ Expr t a
_ Expr t (BaseBVType w)
_ Expr t (BaseBVType w)
_) -> forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t ('BaseArrayType (SingleCtx (BaseBVType w)) a)
arr
Just (BaseIte BaseTypeRepr (BaseArrayType (d ::> tp) range)
_ Integer
_ Expr t 'BaseBoolType
p Expr t (BaseArrayType (d ::> tp) range)
x Expr t (BaseArrayType (d ::> tp) range)
y) -> do
Expr t (BaseArrayType (d ::> tp) range)
x' <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
x
Expr t (BaseArrayType (d ::> tp) range)
y' <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> IO (Expr t (BaseArrayType (d ::> tp) range))
arrayUpdateBase ExprBuilder t st fs
sym Expr t (BaseArrayType (d ::> tp) range)
y
forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
p Expr t (BaseArrayType (d ::> tp) range)
x' Expr t (BaseArrayType (d ::> tp) range)
y'
Maybe (App (Expr t) (BaseArrayType (d ::> tp) range))
_ -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseArrayType (d ::> tp) range)
arr0
intSum :: ExprBuilder t st fs -> WeightedSum (Expr t) SR.SemiRingInteger -> IO (IntegerExpr t)
intSum :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> WeightedSum (Expr t) SemiRingInteger -> IO (IntegerExpr t)
intSum ExprBuilder t st fs
sym WeightedSum (Expr t) SemiRingInteger
s = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) SemiRingInteger
s
realSum :: ExprBuilder t st fs -> WeightedSum (Expr t) SR.SemiRingReal -> IO (RealExpr t)
realSum :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> WeightedSum (Expr t) 'SemiRingReal -> IO (RealExpr t)
realSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingReal
s = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) 'SemiRingReal
s
bvSum :: ExprBuilder t st fs -> WeightedSum (Expr t) (SR.SemiRingBV flv w) -> IO (BVExpr t w)
bvSum :: forall t (st :: Type -> Type) fs (flv :: BVFlavor) (w :: Natural).
ExprBuilder t st fs
-> WeightedSum (Expr t) (SemiRingBV flv w) -> IO (BVExpr t w)
bvSum ExprBuilder t st fs
sym WeightedSum (Expr t) (SemiRingBV flv w)
s = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) (SemiRingBV flv w)
s
conjPred :: ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred :: forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym BoolMap (Expr t)
bm =
case forall (f :: BaseType -> Type). BoolMap f -> BoolMapView f
BM.viewBoolMap BoolMap (Expr t)
bm of
BoolMapView (Expr t)
BoolMapUnit -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
BoolMapView (Expr t)
BoolMapDualUnit -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym
BoolMapTerms ((BoolExpr t
x,Polarity
p):|[]) ->
case Polarity
p of
Polarity
Positive -> forall (m :: Type -> Type) a. Monad m => a -> m a
return BoolExpr t
x
Polarity
Negative -> forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym BoolExpr t
x
BoolMapView (Expr t)
_ -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type). BoolMap e -> App e 'BaseBoolType
ConjPred BoolMap (Expr t)
bm
bvUnary :: (1 <= w) => ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary :: forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sym UnaryBV (BoolExpr t) w
u
| Just Integer
v <- forall (p :: BaseType -> Type) (w :: Natural).
IsExpr p =>
UnaryBV (p 'BaseBoolType) w -> Maybe Integer
UnaryBV.asConstant UnaryBV (BoolExpr t) w
u = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
v)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (n :: Natural) (e :: BaseType -> Type).
(1 <= n) =>
UnaryBV (e 'BaseBoolType) n -> App e ('BaseBVType n)
BVUnaryTerm UnaryBV (BoolExpr t) w
u)
where w :: NatRepr w
w = forall p (n :: Natural). UnaryBV p n -> NatRepr n
UnaryBV.width UnaryBV (BoolExpr t) w
u
asUnaryBV :: (?unaryThreshold :: Int)
=> ExprBuilder t st fs
-> BVExpr t n
-> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV :: forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym BVExpr t n
e
| Just (BVUnaryTerm UnaryBV (Expr t 'BaseBoolType) n
u) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp BVExpr t n
e = forall a. a -> Maybe a
Just UnaryBV (Expr t 'BaseBoolType) n
u
| ?unaryThreshold::Int
?unaryThreshold forall a. Eq a => a -> a -> Bool
== Int
0 = forall a. Maybe a
Nothing
| SemiRingLiteral (SR.SemiRingBVRepr BVFlavorRepr fv
_ NatRepr w
w) Coefficient sr
v ProgramLoc
_ <- BVExpr t n
e = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall sym (n :: Natural).
IsExprBuilder sym =>
sym -> NatRepr n -> Integer -> UnaryBV (Pred sym) n
UnaryBV.constant ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). BV w -> Integer
BV.asUnsigned Coefficient sr
v)
| Bool
otherwise = forall a. Maybe a
Nothing
sbTryUnaryTerm :: (1 <= w, ?unaryThreshold :: Int)
=> ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (BVExpr t w)
-> IO (BVExpr t w)
sbTryUnaryTerm :: forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w, ?unaryThreshold::Int) =>
ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (BVExpr t w)
-> IO (BVExpr t w)
sbTryUnaryTerm ExprBuilder t st fs
_sym Maybe (IO (UnaryBV (BoolExpr t) w))
Nothing IO (BVExpr t w)
fallback = IO (BVExpr t w)
fallback
sbTryUnaryTerm ExprBuilder t st fs
sym (Just IO (UnaryBV (BoolExpr t) w)
mku) IO (BVExpr t w)
fallback =
do UnaryBV (BoolExpr t) w
u <- IO (UnaryBV (BoolExpr t) w)
mku
if forall p (n :: Natural). UnaryBV p n -> Int
UnaryBV.size UnaryBV (BoolExpr t) w
u forall a. Ord a => a -> a -> Bool
< ?unaryThreshold::Int
?unaryThreshold then
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sym UnaryBV (BoolExpr t) w
u
else
IO (BVExpr t w)
fallback
semiRingProd ::
ExprBuilder t st fs ->
SemiRingProduct (Expr t) sr ->
IO (Expr t (SR.SemiRingBase sr))
semiRingProd :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym SemiRingProduct (Expr t) sr
pd
| forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Bool
WSum.nullProd SemiRingProduct (Expr t) sr
pd = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd) (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.one (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd))
| Just Expr t (SemiRingBase sr)
v <- forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> Maybe (f (SemiRingBase sr))
WSum.asProdVar SemiRingProduct (Expr t) sr
pd = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
v
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct e sr -> App e (SemiRingBase sr)
SemiRingProd SemiRingProduct (Expr t) sr
pd
semiRingSum ::
ExprBuilder t st fs ->
WeightedSum (Expr t) sr ->
IO (Expr t (SR.SemiRingBase sr))
semiRingSum :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
s
| Just Coefficient sr
c <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) sr
s = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s) Coefficient sr
c
| Just Expr t (SemiRingBase sr)
r <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (f (SemiRingBase sr))
WSum.asVar WeightedSum (Expr t) sr
s = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
r
| Bool
otherwise = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym WeightedSum (Expr t) sr
s
sum' ::
ExprBuilder t st fs ->
WeightedSum (Expr t) sr ->
IO (Expr t (SR.SemiRingBase sr))
sum' :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym WeightedSum (Expr t) sr
s = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (sr :: SemiRing).
WeightedSum e sr -> App e (SemiRingBase sr)
SemiRingSum WeightedSum (Expr t) sr
s
{-# INLINE sum' #-}
scalarMul ::
ExprBuilder t st fs ->
SR.SemiRingRepr sr ->
SR.Coefficient sr ->
Expr t (SR.SemiRingBase sr) ->
IO (Expr t (SR.SemiRingBase sr))
scalarMul :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c Expr t (SemiRingBase sr)
x
| forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr) Coefficient sr
c = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
| forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.one SemiRingRepr sr
sr) Coefficient sr
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x
| Just Coefficient sr
r <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x =
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (forall (sr :: SemiRing).
SemiRingRepr sr
-> Coefficient sr -> Coefficient sr -> Coefficient sr
SR.mul SemiRingRepr sr
sr Coefficient sr
c Coefficient sr
r)
| Just WeightedSum (Expr t) sr
s <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (WeightedSum (Expr t) sr)
asSemiRingSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x =
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> Coefficient sr -> WeightedSum f sr -> WeightedSum f sr
WSum.scale SemiRingRepr sr
sr Coefficient sr
c WeightedSum (Expr t) sr
s)
| Bool
otherwise =
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> Coefficient sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.scaledVar SemiRingRepr sr
sr Coefficient sr
c Expr t (SemiRingBase sr)
x)
semiRingIte ::
ExprBuilder t st fs ->
SR.SemiRingRepr sr ->
Expr t BaseBoolType ->
Expr t (SR.SemiRingBase sr) ->
Expr t (SR.SemiRingBase sr) ->
IO (Expr t (SR.SemiRingBase sr))
semiRingIte :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t 'BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t 'BaseBoolType
c Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y
| Just Bool
True <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x
| Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
y
| Just (NotPred Expr t 'BaseBoolType
c') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
c
= forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t 'BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t 'BaseBoolType
c' Expr t (SemiRingBase sr)
y Expr t (SemiRingBase sr)
x
| Expr t (SemiRingBase sr)
x forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x
| (WeightedSum (Expr t) sr
z, WeightedSum (Expr t) sr
x',WeightedSum (Expr t) sr
y') <- forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
WeightedSum f sr
-> WeightedSum f sr
-> (WeightedSum f sr, WeightedSum f sr, WeightedSum f sr)
WSum.extractCommon (forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) (forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y)
, Bool -> Bool
not (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr sr
sr WeightedSum (Expr t) sr
z) = do
Expr t (SemiRingBase sr)
xr <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
x'
Expr t (SemiRingBase sr)
yr <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
y'
let sz :: Integer
sz = Integer
1 forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
xr forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
yr
Expr t (SemiRingBase sr)
r <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e 'BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) Integer
sz Expr t 'BaseBoolType
c Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.addVar SemiRingRepr sr
sr WeightedSum (Expr t) sr
z Expr t (SemiRingBase sr)
r
| Bool
otherwise =
let sz :: Integer
sz = Integer
1 forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
x forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t (SemiRingBase sr)
y in
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e 'BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) Integer
sz Expr t 'BaseBoolType
c Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y)
mkIte ::
ExprBuilder t st fs ->
Expr t BaseBoolType ->
Expr t bt ->
Expr t bt ->
IO (Expr t bt)
mkIte :: forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t 'BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
c Expr t bt
x Expr t bt
y
| Just Bool
True <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t bt
x
| Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Expr t 'BaseBoolType
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t bt
y
| Just (NotPred Expr t 'BaseBoolType
c') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
c
= forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t 'BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
c' Expr t bt
y Expr t bt
x
| Expr t bt
x forall a. Eq a => a -> a -> Bool
== Expr t bt
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t bt
x
| Bool
otherwise =
let sz :: Integer
sz = Integer
1 forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t bt
x forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Expr t bt
y in
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e 'BaseBoolType -> e tp -> e tp -> App e tp
BaseIte (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t bt
x) Integer
sz Expr t 'BaseBoolType
c Expr t bt
x Expr t bt
y)
semiRingLe ::
ExprBuilder t st fs ->
SR.OrderedSemiRingRepr sr ->
(Expr t (SR.SemiRingBase sr) -> Expr t (SR.SemiRingBase sr) -> IO (Expr t BaseBoolType))
->
Expr t (SR.SemiRingBase sr) ->
Expr t (SR.SemiRingBase sr) ->
IO (Expr t BaseBoolType)
semiRingLe :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t 'BaseBoolType)
semiRingLe ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y
| Expr t (SemiRingBase sr)
x forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
| Just Coefficient sr
c <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x
, forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
, Just (SemiRingProd SemiRingProduct (Expr t) sr
pd) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
y
, Just sr :~: sr
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality SemiRingRepr sr
sr (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd)
= forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t 'BaseBoolType)
prodNonneg ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr SemiRingProduct (Expr t) sr
pd
| Just Coefficient sr
c <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y
, forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
, Just (SemiRingProd SemiRingProduct (Expr t) sr
pd) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
x
, Just sr :~: sr
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality SemiRingRepr sr
sr (forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
pd)
= forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t 'BaseBoolType)
prodNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr SemiRingProduct (Expr t) sr
pd
| SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- Expr t (SemiRingBase sr)
x
, Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t 'BaseBoolType
c Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
y
= forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
a forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
b)
| Just (BaseIte BaseTypeRepr (SemiRingBase sr)
tp Integer
_ Expr t 'BaseBoolType
c Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
x
, SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- Expr t (SemiRingBase sr)
y
, Just SemiRingBase sr :~: SemiRingBase sr
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality BaseTypeRepr (SemiRingBase sr)
tp (forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr)
= forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
y forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
b Expr t (SemiRingBase sr)
y)
| (WeightedSum (Expr t) sr
z, WeightedSum (Expr t) sr
x',WeightedSum (Expr t) sr
y') <- forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
WeightedSum f sr
-> WeightedSum f sr
-> (WeightedSum f sr, WeightedSum f sr, WeightedSum f sr)
WSum.extractCommon (forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) (forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y)
, Bool -> Bool
not (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr sr
sr WeightedSum (Expr t) sr
z) = do
Expr t (SemiRingBase sr)
xr <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
x'
Expr t (SemiRingBase sr)
yr <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
y'
Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) (e :: BaseType -> Type).
OrderedSemiRingRepr sr
-> e (SemiRingBase sr)
-> e (SemiRingBase sr)
-> App e 'BaseBoolType
SemiRingLe OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y
where sr :: SemiRingRepr sr
sr = forall (sr :: SemiRing). OrderedSemiRingRepr sr -> SemiRingRepr sr
SR.orderedSemiRing OrderedSemiRingRepr sr
osr
semiRingEq ::
ExprBuilder t st fs ->
SR.SemiRingRepr sr ->
(Expr t (SR.SemiRingBase sr) -> Expr t (SR.SemiRingBase sr) -> IO (Expr t BaseBoolType))
->
Expr t (SR.SemiRingBase sr) ->
Expr t (SR.SemiRingBase sr) ->
IO (Expr t BaseBoolType)
semiRingEq :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t 'BaseBoolType)
semiRingEq ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y
| Expr t (SemiRingBase sr)
x forall a. Eq a => a -> a -> Bool
== Expr t (SemiRingBase sr)
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
| SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- Expr t (SemiRingBase sr)
x
, Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t 'BaseBoolType
c Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
y
= forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
a forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
b)
| Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t 'BaseBoolType
c Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
x
, SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- Expr t (SemiRingBase sr)
y
= forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
y forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType)
rec Expr t (SemiRingBase sr)
b Expr t (SemiRingBase sr)
y)
| (WeightedSum (Expr t) sr
z, WeightedSum (Expr t) sr
x',WeightedSum (Expr t) sr
y') <- forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
WeightedSum f sr
-> WeightedSum f sr
-> (WeightedSum f sr, WeightedSum f sr, WeightedSum f sr)
WSum.extractCommon (forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) (forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y)
, Bool -> Bool
not (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr sr
sr WeightedSum (Expr t) sr
z) =
case (forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) sr
x', forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) sr
y') of
(Just Coefficient sr
a, Just Coefficient sr
b) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
a Coefficient sr
b)
(Maybe (Coefficient sr), Maybe (Coefficient sr))
_ -> do Expr t (SemiRingBase sr)
xr <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
x'
Expr t (SemiRingBase sr)
yr <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) sr
y'
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) (forall a. Ord a => a -> a -> a
min Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr) (forall a. Ord a => a -> a -> a
max Expr t (SemiRingBase sr)
xr Expr t (SemiRingBase sr)
yr)
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr sr
sr) (forall a. Ord a => a -> a -> a
min Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y) (forall a. Ord a => a -> a -> a
max Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y)
semiRingAdd ::
forall t st fs sr.
ExprBuilder t st fs ->
SR.SemiRingRepr sr ->
Expr t (SR.SemiRingBase sr) ->
Expr t (SR.SemiRingBase sr) ->
IO (Expr t (SR.SemiRingBase sr))
semiRingAdd :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y =
case (forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x, forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y) of
(SR_Constant Coefficient sr
c, SemiRingView t sr
_) | forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
y
(SemiRingView t sr
_, SR_Constant Coefficient sr
c) | forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr sr
sr Coefficient sr
c (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (SemiRingBase sr)
x
(SR_Constant Coefficient sr
xc, SR_Constant Coefficient sr
yc) ->
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (forall (sr :: SemiRing).
SemiRingRepr sr
-> Coefficient sr -> Coefficient sr -> Coefficient sr
SR.add SemiRingRepr sr
sr Coefficient sr
xc Coefficient sr
yc)
(SR_Constant Coefficient sr
xc, SR_Sum WeightedSum (Expr t) sr
ys) ->
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
sr WeightedSum (Expr t) sr
ys Coefficient sr
xc)
(SR_Sum WeightedSum (Expr t) sr
xs, SR_Constant Coefficient sr
yc) ->
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
sr WeightedSum (Expr t) sr
xs Coefficient sr
yc)
(SR_Constant Coefficient sr
xc, SemiRingView t sr
_)
| Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t 'BaseBoolType
cond Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
y
, Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr Expr t (SemiRingBase sr)
a Bool -> Bool -> Bool
|| Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr Expr t (SemiRingBase sr)
b -> do
Expr t (SemiRingBase sr)
xa <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
a
Expr t (SemiRingBase sr)
xb <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
b
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t 'BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t 'BaseBoolType
cond Expr t (SemiRingBase sr)
xa Expr t (SemiRingBase sr)
xb
| Bool
otherwise ->
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
sr (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.var SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y) Coefficient sr
xc)
(SemiRingView t sr
_, SR_Constant Coefficient sr
yc)
| Just (BaseIte BaseTypeRepr (SemiRingBase sr)
_ Integer
_ Expr t 'BaseBoolType
cond Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (SemiRingBase sr)
x
, Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr Expr t (SemiRingBase sr)
a Bool -> Bool -> Bool
|| Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr Expr t (SemiRingBase sr)
b -> do
Expr t (SemiRingBase sr)
ay <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
a Expr t (SemiRingBase sr)
y
Expr t (SemiRingBase sr)
by <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
b Expr t (SemiRingBase sr)
y
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t 'BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t 'BaseBoolType
cond Expr t (SemiRingBase sr)
ay Expr t (SemiRingBase sr)
by
| Bool
otherwise ->
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
sum' ExprBuilder t st fs
sym (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr sr
sr (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.var SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) Coefficient sr
yc)
(SR_Sum WeightedSum (Expr t) sr
xs, SR_Sum WeightedSum (Expr t) sr
ys) -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> WeightedSum f sr -> WeightedSum f sr
WSum.add SemiRingRepr sr
sr WeightedSum (Expr t) sr
xs WeightedSum (Expr t) sr
ys)
(SR_Sum WeightedSum (Expr t) sr
xs, SemiRingView t sr
_) -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.addVar SemiRingRepr sr
sr WeightedSum (Expr t) sr
xs Expr t (SemiRingBase sr)
y)
(SemiRingView t sr
_ , SR_Sum WeightedSum (Expr t) sr
ys) -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> WeightedSum f sr -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.addVar SemiRingRepr sr
sr WeightedSum (Expr t) sr
ys Expr t (SemiRingBase sr)
x)
(SemiRingView t sr, SemiRingView t sr)
_ -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr
-> f (SemiRingBase sr) -> f (SemiRingBase sr) -> WeightedSum f sr
WSum.addVars SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y)
where isConstantSemiRingExpr :: Expr t (SR.SemiRingBase sr) -> Bool
isConstantSemiRingExpr :: Expr t (SemiRingBase sr) -> Bool
isConstantSemiRingExpr (forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr -> SR_Constant Coefficient sr
_) = Bool
True
isConstantSemiRingExpr Expr t (SemiRingBase sr)
_ = Bool
False
semiRingMul ::
ExprBuilder t st fs ->
SR.SemiRingRepr sr ->
Expr t (SR.SemiRingBase sr) ->
Expr t (SR.SemiRingBase sr) ->
IO (Expr t (SR.SemiRingBase sr))
semiRingMul :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y =
case (forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x, forall (sr :: SemiRing) t.
SemiRingRepr sr -> Expr t (SemiRingBase sr) -> SemiRingView t sr
viewSemiRing SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y) of
(SR_Constant Coefficient sr
c, SemiRingView t sr
_) -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c Expr t (SemiRingBase sr)
y
(SemiRingView t sr
_, SR_Constant Coefficient sr
c) -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c Expr t (SemiRingBase sr)
x
(SR_Sum (forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr
-> Maybe (Coefficient sr, f (SemiRingBase sr), Coefficient sr)
WSum.asAffineVar -> Just (Coefficient sr
c,Expr t (SemiRingBase sr)
x',Coefficient sr
o)), SemiRingView t sr
_) ->
do Expr t (SemiRingBase sr)
cxy <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x' Expr t (SemiRingBase sr)
y
Expr t (SemiRingBase sr)
oy <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
o Expr t (SemiRingBase sr)
y
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
cxy Expr t (SemiRingBase sr)
oy
(SemiRingView t sr
_, SR_Sum (forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr
-> Maybe (Coefficient sr, f (SemiRingBase sr), Coefficient sr)
WSum.asAffineVar -> Just (Coefficient sr
c,Expr t (SemiRingBase sr)
y',Coefficient sr
o))) ->
do Expr t (SemiRingBase sr)
cxy <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
c forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
y'
Expr t (SemiRingBase sr)
ox <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr sr
sr Coefficient sr
o Expr t (SemiRingBase sr)
x
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr sr
sr Expr t (SemiRingBase sr)
cxy Expr t (SemiRingBase sr)
ox
(SR_Prod SemiRingProduct (Expr t) sr
px, SR_Prod SemiRingProduct (Expr t) sr
py) -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul SemiRingProduct (Expr t) sr
px SemiRingProduct (Expr t) sr
py)
(SR_Prod SemiRingProduct (Expr t) sr
px, SemiRingView t sr
_) -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul SemiRingProduct (Expr t) sr
px (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> SemiRingProduct f sr
WSum.prodVar SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y))
(SemiRingView t sr
_, SR_Prod SemiRingProduct (Expr t) sr
py) -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> SemiRingProduct f sr
WSum.prodVar SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) SemiRingProduct (Expr t) sr
py)
(SemiRingView t sr, SemiRingView t sr)
_ -> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingProduct (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingProd ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingProduct f sr
-> SemiRingProduct f sr -> SemiRingProduct f sr
WSum.prodMul (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> SemiRingProduct f sr
WSum.prodVar SemiRingRepr sr
sr Expr t (SemiRingBase sr)
x) (forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
SemiRingRepr sr -> f (SemiRingBase sr) -> SemiRingProduct f sr
WSum.prodVar SemiRingRepr sr
sr Expr t (SemiRingBase sr)
y))
prodNonneg ::
ExprBuilder t st fs ->
SR.OrderedSemiRingRepr sr ->
WSum.SemiRingProduct (Expr t) sr ->
IO (Expr t BaseBoolType)
prodNonneg :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t 'BaseBoolType)
prodNonneg ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr SemiRingProduct (Expr t) sr
pd =
do let sr :: SemiRingRepr sr
sr = forall (sr :: SemiRing). OrderedSemiRingRepr sr -> SemiRingRepr sr
SR.orderedSemiRing OrderedSemiRingRepr sr
osr
Expr t (SemiRingBase sr)
zero <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
forall a b. (a, b) -> a
fst forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> SemiRingProduct (Expr t) sr
-> IO (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
computeNonnegNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
zero SemiRingProduct (Expr t) sr
pd
prodNonpos ::
ExprBuilder t st fs ->
SR.OrderedSemiRingRepr sr ->
WSum.SemiRingProduct (Expr t) sr ->
IO (Expr t BaseBoolType)
prodNonpos :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> SemiRingProduct (Expr t) sr
-> IO (Expr t 'BaseBoolType)
prodNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr SemiRingProduct (Expr t) sr
pd =
do let sr :: SemiRingRepr sr
sr = forall (sr :: SemiRing). OrderedSemiRingRepr sr -> SemiRingRepr sr
SR.orderedSemiRing OrderedSemiRingRepr sr
osr
Expr t (SemiRingBase sr)
zero <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr sr
sr (forall (sr :: SemiRing). SemiRingRepr sr -> Coefficient sr
SR.zero SemiRingRepr sr
sr)
forall a b. (a, b) -> b
snd forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> SemiRingProduct (Expr t) sr
-> IO (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
computeNonnegNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
zero SemiRingProduct (Expr t) sr
pd
computeNonnegNonpos ::
ExprBuilder t st fs ->
SR.OrderedSemiRingRepr sr ->
Expr t (SR.SemiRingBase sr) ->
WSum.SemiRingProduct (Expr t) sr ->
IO (Expr t BaseBoolType, Expr t BaseBoolType)
computeNonnegNonpos :: forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> SemiRingProduct (Expr t) sr
-> IO (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
computeNonnegNonpos ExprBuilder t st fs
sym OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
zero SemiRingProduct (Expr t) sr
pd =
forall a. a -> Maybe a -> a
fromMaybe (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym, forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: Type -> Type) r (f :: BaseType -> Type)
(sr :: SemiRing).
Monad m =>
(r -> r -> m r)
-> (f (SemiRingBase sr) -> m r)
-> SemiRingProduct f sr
-> m (Maybe r)
WSum.prodEvalM (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
-> (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
-> IO (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
merge Expr t (SemiRingBase sr)
-> IO (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
single SemiRingProduct (Expr t) sr
pd
where
single :: Expr t (SemiRingBase sr)
-> IO (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
single Expr t (SemiRingBase sr)
x = (,) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> (forall (w :: Natural).
(1 <= w) =>
sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w)))
-> App (SymExpr sym) tp
-> IO (SymExpr sym tp)
reduceApp ExprBuilder t st fs
sym forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary (forall (sr :: SemiRing) (e :: BaseType -> Type).
OrderedSemiRingRepr sr
-> e (SemiRingBase sr)
-> e (SemiRingBase sr)
-> App e 'BaseBoolType
SemiRingLe OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
zero Expr t (SemiRingBase sr)
x)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> (forall (w :: Natural).
(1 <= w) =>
sym -> UnaryBV (Pred sym) w -> IO (SymExpr sym (BaseBVType w)))
-> App (SymExpr sym) tp
-> IO (SymExpr sym tp)
reduceApp ExprBuilder t st fs
sym forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary (forall (sr :: SemiRing) (e :: BaseType -> Type).
OrderedSemiRingRepr sr
-> e (SemiRingBase sr)
-> e (SemiRingBase sr)
-> App e 'BaseBoolType
SemiRingLe OrderedSemiRingRepr sr
osr Expr t (SemiRingBase sr)
x Expr t (SemiRingBase sr)
zero)
merge :: (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
-> (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
-> IO (Expr t 'BaseBoolType, Expr t 'BaseBoolType)
merge (Expr t 'BaseBoolType
nn1, Expr t 'BaseBoolType
np1) (Expr t 'BaseBoolType
nn2, Expr t 'BaseBoolType
np2) =
do Expr t 'BaseBoolType
nn <- forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
nn1 Expr t 'BaseBoolType
nn2 forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
np1 Expr t 'BaseBoolType
np2)
Expr t 'BaseBoolType
np <- forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
nn1 Expr t 'BaseBoolType
np2 forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
np1 Expr t 'BaseBoolType
nn2)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Expr t 'BaseBoolType
nn, Expr t 'BaseBoolType
np)
arrayResultIdxType :: BaseTypeRepr (BaseArrayType (idx ::> itp) d)
-> Ctx.Assignment BaseTypeRepr (idx ::> itp)
arrayResultIdxType :: forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
BaseTypeRepr (BaseArrayType (idx ::> itp) d)
-> Assignment BaseTypeRepr (idx ::> itp)
arrayResultIdxType (BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idx BaseTypeRepr xs
_) = Assignment BaseTypeRepr (idx ::> tp)
idx
data ArrayMapView i f tp
= ArrayMapView { forall (i :: Ctx BaseType) (f :: BaseType -> Type)
(tp :: BaseType).
ArrayMapView i f tp -> ArrayUpdateMap f i tp
_arrayMapViewIndices :: !(AUM.ArrayUpdateMap f i tp)
, forall (i :: Ctx BaseType) (f :: BaseType -> Type)
(tp :: BaseType).
ArrayMapView i f tp -> f (BaseArrayType i tp)
_arrayMapViewExpr :: !(f (BaseArrayType i tp))
}
viewArrayMap :: Expr t (BaseArrayType i tp)
-> ArrayMapView i (Expr t) tp
viewArrayMap :: forall t (i :: Ctx BaseType) (tp :: BaseType).
Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
viewArrayMap Expr t (BaseArrayType i tp)
x
| Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
m Expr t ('BaseArrayType (i ::> itp) tp1)
c) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseArrayType i tp)
x = forall (i :: Ctx BaseType) (f :: BaseType -> Type)
(tp :: BaseType).
ArrayUpdateMap f i tp
-> f (BaseArrayType i tp) -> ArrayMapView i f tp
ArrayMapView ArrayUpdateMap (Expr t) (i ::> itp) tp1
m Expr t ('BaseArrayType (i ::> itp) tp1)
c
| Bool
otherwise = forall (i :: Ctx BaseType) (f :: BaseType -> Type)
(tp :: BaseType).
ArrayUpdateMap f i tp
-> f (BaseArrayType i tp) -> ArrayMapView i f tp
ArrayMapView forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
(tp :: BaseType).
ArrayUpdateMap e ctx tp
AUM.empty Expr t (BaseArrayType i tp)
x
underlyingArrayMapExpr :: ArrayResultWrapper (Expr t) i tp
-> ArrayResultWrapper (Expr t) i tp
underlyingArrayMapExpr :: forall t (i :: Ctx BaseType) (tp :: BaseType).
ArrayResultWrapper (Expr t) i tp
-> ArrayResultWrapper (Expr t) i tp
underlyingArrayMapExpr ArrayResultWrapper (Expr t) i tp
x
| Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
_ Expr t ('BaseArrayType (i ::> itp) tp1)
c) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) i tp
x) = forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
f (BaseArrayType idx tp) -> ArrayResultWrapper f idx tp
ArrayResultWrapper Expr t ('BaseArrayType (i ::> itp) tp1)
c
| Bool
otherwise = ArrayResultWrapper (Expr t) i tp
x
concreteArrayEntries :: forall t i ctx
. Ctx.Assignment (ArrayResultWrapper (Expr t) i) ctx
-> Set (Ctx.Assignment IndexLit i)
concreteArrayEntries :: forall t (i :: Ctx BaseType) (ctx :: Ctx BaseType).
Assignment (ArrayResultWrapper (Expr t) i) ctx
-> Set (Assignment IndexLit i)
concreteArrayEntries = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type) b.
FoldableFC t =>
(forall (x :: k). b -> f x -> b)
-> forall (x :: l). b -> t f x -> b
foldlFC' forall (tp :: BaseType).
Set (Assignment IndexLit i)
-> ArrayResultWrapper (Expr t) i tp -> Set (Assignment IndexLit i)
f forall a. Set a
Set.empty
where f :: Set (Ctx.Assignment IndexLit i)
-> ArrayResultWrapper (Expr t) i tp
-> Set (Ctx.Assignment IndexLit i)
f :: forall (tp :: BaseType).
Set (Assignment IndexLit i)
-> ArrayResultWrapper (Expr t) i tp -> Set (Assignment IndexLit i)
f Set (Assignment IndexLit i)
s ArrayResultWrapper (Expr t) i tp
e
| Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
_ BaseTypeRepr tp1
_ ArrayUpdateMap (Expr t) (i ::> itp) tp1
m Expr t ('BaseArrayType (i ::> itp) tp1)
_) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) i tp
e) =
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (Assignment IndexLit i)
s (forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
(tp :: BaseType).
ArrayUpdateMap e ctx tp -> Set (Assignment IndexLit ctx)
AUM.keysSet ArrayUpdateMap (Expr t) (i ::> itp) tp1
m)
| Bool
otherwise = Set (Assignment IndexLit i)
s
data IntLit tp = (tp ~ BaseIntegerType) => IntLit Integer
asIntBounds :: Ctx.Assignment (Expr t) idx -> Maybe (Ctx.Assignment IntLit idx)
asIntBounds :: forall t (idx :: Ctx BaseType).
Assignment (Expr t) idx -> Maybe (Assignment IntLit idx)
asIntBounds = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC forall t (tp :: BaseType). Expr t tp -> Maybe (IntLit tp)
f
where f :: Expr t tp -> Maybe (IntLit tp)
f :: forall t (tp :: BaseType). Expr t tp -> Maybe (IntLit tp)
f (SemiRingLiteral SemiRingRepr sr
SR.SemiRingIntegerRepr Coefficient sr
n ProgramLoc
_) = forall a. a -> Maybe a
Just (forall (tp :: BaseType).
(tp ~ BaseIntegerType) =>
Integer -> IntLit tp
IntLit Coefficient sr
n)
f Expr t tp
_ = forall a. Maybe a
Nothing
foldBoundLeM :: (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM :: forall r. (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM r -> Integer -> IO r
f r
r Integer
n
| Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
0 = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure r
r
| Bool
otherwise =
do r
r' <- forall r. (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM r -> Integer -> IO r
f r
r (Integer
nforall a. Num a => a -> a -> a
-Integer
1)
r -> Integer -> IO r
f r
r' Integer
n
foldIndicesInRangeBounds :: forall sym idx r
. IsExprBuilder sym
=> sym
-> (r -> Ctx.Assignment (SymExpr sym) idx -> IO r)
-> r
-> Ctx.Assignment IntLit idx
-> IO r
foldIndicesInRangeBounds :: forall sym (idx :: Ctx BaseType) r.
IsExprBuilder sym =>
sym
-> (r -> Assignment (SymExpr sym) idx -> IO r)
-> r
-> Assignment IntLit idx
-> IO r
foldIndicesInRangeBounds sym
sym r -> Assignment (SymExpr sym) idx -> IO r
f0 r
a0 Assignment IntLit idx
bnds0 = do
case Assignment IntLit idx
bnds0 of
Assignment IntLit idx
Ctx.Empty -> r -> Assignment (SymExpr sym) idx -> IO r
f0 r
a0 forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty
Assignment IntLit ctx
bnds Ctx.:> IntLit Integer
b -> forall sym (idx :: Ctx BaseType) r.
IsExprBuilder sym =>
sym
-> (r -> Assignment (SymExpr sym) idx -> IO r)
-> r
-> Assignment IntLit idx
-> IO r
foldIndicesInRangeBounds sym
sym (forall (idx0 :: Ctx BaseType).
(r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> r -> Assignment (SymExpr sym) idx0 -> IO r
g r -> Assignment (SymExpr sym) idx -> IO r
f0) r
a0 Assignment IntLit ctx
bnds
where g :: (r -> Ctx.Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> r
-> Ctx.Assignment (SymExpr sym) idx0
-> IO r
g :: forall (idx0 :: Ctx BaseType).
(r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> r -> Assignment (SymExpr sym) idx0 -> IO r
g r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r
f r
a Assignment (SymExpr sym) idx0
i = forall r. (r -> Integer -> IO r) -> r -> Integer -> IO r
foldBoundLeM (forall (idx0 :: Ctx BaseType).
(r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> Assignment (SymExpr sym) idx0 -> r -> Integer -> IO r
h r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r
f Assignment (SymExpr sym) idx0
i) r
a Integer
b
h :: (r -> Ctx.Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> Ctx.Assignment (SymExpr sym) idx0
-> r
-> Integer
-> IO r
h :: forall (idx0 :: Ctx BaseType).
(r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r)
-> Assignment (SymExpr sym) idx0 -> r -> Integer -> IO r
h r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r
f Assignment (SymExpr sym) idx0
i r
a Integer
j = do
SymExpr sym BaseIntegerType
je <- forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym Integer
j
r -> Assignment (SymExpr sym) (idx0 ::> BaseIntegerType) -> IO r
f r
a (Assignment (SymExpr sym) idx0
i forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymExpr sym BaseIntegerType
je)
checkAbsorption ::
BoolMap (Expr t) ->
[(BoolExpr t, Polarity)] ->
Bool
checkAbsorption :: forall t. BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
checkAbsorption BoolMap (Expr t)
_bm [] = Bool
False
checkAbsorption BoolMap (Expr t)
bm ((BoolExpr t
x,Polarity
p):[(BoolExpr t, Polarity)]
_)
| Just Polarity
p' <- forall (f :: BaseType -> Type).
OrdF f =>
BoolMap f -> f 'BaseBoolType -> Maybe Polarity
BM.contains BoolMap (Expr t)
bm BoolExpr t
x, Polarity
p forall a. Eq a => a -> a -> Bool
== Polarity
p' = Bool
True
checkAbsorption BoolMap (Expr t)
bm ((BoolExpr t, Polarity)
_:[(BoolExpr t, Polarity)]
xs) = forall t. BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
checkAbsorption BoolMap (Expr t)
bm [(BoolExpr t, Polarity)]
xs
tryAndAbsorption ::
BoolExpr t ->
BoolExpr t ->
Bool
tryAndAbsorption :: forall t. BoolExpr t -> BoolExpr t -> Bool
tryAndAbsorption (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (NotPred (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as)))) (forall t.
Expr t 'BaseBoolType -> [(Expr t 'BaseBoolType, Polarity)]
asConjunction -> [(BoolExpr t, Polarity)]
bs)
= forall t. BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
checkAbsorption (forall (f :: BaseType -> Type). OrdF f => BoolMap f -> BoolMap f
BM.reversePolarities BoolMap (Expr t)
as) [(BoolExpr t, Polarity)]
bs
tryAndAbsorption BoolExpr t
_ BoolExpr t
_ = Bool
False
tryOrAbsorption ::
BoolExpr t ->
BoolExpr t ->
Bool
tryOrAbsorption :: forall t. BoolExpr t -> BoolExpr t -> Bool
tryOrAbsorption (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as)) (forall t.
Expr t 'BaseBoolType -> [(Expr t 'BaseBoolType, Polarity)]
asDisjunction -> [(BoolExpr t, Polarity)]
bs)
= forall t. BoolMap (Expr t) -> [(BoolExpr t, Polarity)] -> Bool
checkAbsorption BoolMap (Expr t)
as [(BoolExpr t, Polarity)]
bs
tryOrAbsorption BoolExpr t
_ BoolExpr t
_ = Bool
False
instance IsExprBuilder (ExprBuilder t st fs) where
getConfiguration :: ExprBuilder t st fs -> Config
getConfiguration = forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Config
sbConfiguration
setSolverLogListener :: ExprBuilder t st fs -> Maybe (SolverEvent -> IO ()) -> IO ()
setSolverLogListener ExprBuilder t st fs
sb = forall a. IORef a -> a -> IO ()
atomicWriteIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger ExprBuilder t st fs
sb)
getSolverLogListener :: ExprBuilder t st fs -> IO (Maybe (SolverEvent -> IO ()))
getSolverLogListener ExprBuilder t st fs
sb = forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger ExprBuilder t st fs
sb)
logSolverEvent :: ExprBuilder t st fs -> SolverEvent -> IO ()
logSolverEvent ExprBuilder t st fs
sb SolverEvent
ev =
forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef (Maybe (SolverEvent -> IO ()))
sbSolverLogger ExprBuilder t st fs
sb) forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (SolverEvent -> IO ())
Nothing -> forall (m :: Type -> Type) a. Monad m => a -> m a
return ()
Just SolverEvent -> IO ()
f -> SolverEvent -> IO ()
f SolverEvent
ev
getStatistics :: ExprBuilder t st fs -> IO Statistics
getStatistics ExprBuilder t st fs
sb = do
Integer
allocs <- forall (m :: Type -> Type) s. NonceGenerator m s -> m Integer
countNoncesGenerated (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> NonceGenerator IO t
sbExprCounter ExprBuilder t st fs
sb)
Integer
nonLinearOps <- forall a. IORef a -> IO a
readIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef Integer
sbNonLinearOps ExprBuilder t st fs
sb)
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Statistics { statAllocs :: Integer
statAllocs = Integer
allocs
, statNonLinearOps :: Integer
statNonLinearOps = Integer
nonLinearOps }
annotateTerm :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SymExpr (ExprBuilder t st fs) tp
-> IO
(SymAnnotation (ExprBuilder t st fs) tp,
SymExpr (ExprBuilder t st fs) tp)
annotateTerm ExprBuilder t st fs
sym SymExpr (ExprBuilder t st fs) tp
e =
case SymExpr (ExprBuilder t st fs) tp
e of
NonceAppExpr (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp -> Annotation BaseTypeRepr tp
_ Nonce t tp
n Expr t tp
_) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (Nonce t tp
n, SymExpr (ExprBuilder t st fs) tp
e)
SymExpr (ExprBuilder t st fs) tp
_ -> do
let tpr :: BaseTypeRepr tp
tpr = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) tp
e
Nonce t tp
n <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> IO (Nonce t tp)
sbFreshIndex ExprBuilder t st fs
sym
Expr t tp
e' <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym (forall (tp :: BaseType) t (e :: BaseType -> Type).
BaseTypeRepr tp -> Nonce t tp -> e tp -> NonceApp t e tp
Annotation BaseTypeRepr tp
tpr Nonce t tp
n SymExpr (ExprBuilder t st fs) tp
e)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Nonce t tp
n, Expr t tp
e')
getAnnotation :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SymExpr (ExprBuilder t st fs) tp
-> Maybe (SymAnnotation (ExprBuilder t st fs) tp)
getAnnotation ExprBuilder t st fs
_sym SymExpr (ExprBuilder t st fs) tp
e =
case SymExpr (ExprBuilder t st fs) tp
e of
NonceAppExpr (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp -> Annotation BaseTypeRepr tp
_ Nonce t tp
n Expr t tp
_) -> forall a. a -> Maybe a
Just Nonce t tp
n
SymExpr (ExprBuilder t st fs) tp
_ -> forall a. Maybe a
Nothing
getUnannotatedTerm :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SymExpr (ExprBuilder t st fs) tp
-> Maybe (SymExpr (ExprBuilder t st fs) tp)
getUnannotatedTerm ExprBuilder t st fs
_sym SymExpr (ExprBuilder t st fs) tp
e =
case SymExpr (ExprBuilder t st fs) tp
e of
NonceAppExpr (forall t (tp :: BaseType).
NonceAppExpr t tp -> NonceApp t (Expr t) tp
nonceExprApp -> Annotation BaseTypeRepr tp
_ Nonce t tp
_ Expr t tp
x) -> forall a. a -> Maybe a
Just Expr t tp
x
SymExpr (ExprBuilder t st fs) tp
_ -> forall a. Maybe a
Nothing
getCurrentProgramLoc :: ExprBuilder t st fs -> IO ProgramLoc
getCurrentProgramLoc = forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc
setCurrentProgramLoc :: ExprBuilder t st fs -> ProgramLoc -> IO ()
setCurrentProgramLoc ExprBuilder t st fs
sym ProgramLoc
l = forall a. IORef a -> a -> IO ()
atomicWriteIORef (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IORef ProgramLoc
sbProgramLoc ExprBuilder t st fs
sym) ProgramLoc
l
truePred :: ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
truePred = forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> BoolExpr t
sbTrue
falsePred :: ExprBuilder t st fs -> Pred (ExprBuilder t st fs)
falsePred = forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> BoolExpr t
sbFalse
notPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
notPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x
| Just Bool
b <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x
= forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! Bool -> Bool
not Bool
b)
| Just (NotPred Expr t 'BaseBoolType
x') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Pred (ExprBuilder t st fs)
x
= forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t 'BaseBoolType
x'
| Bool
otherwise
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e 'BaseBoolType -> App e 'BaseBoolType
NotPred Pred (ExprBuilder t st fs)
x)
eqPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
eqPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y
| Pred (ExprBuilder t st fs)
x forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
y
= forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
| Just (NotPred Expr t 'BaseBoolType
x') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Pred (ExprBuilder t st fs)
x
= forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
xorPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
x' Pred (ExprBuilder t st fs)
y
| Just (NotPred Expr t 'BaseBoolType
y') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Pred (ExprBuilder t st fs)
y
= forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
xorPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Expr t 'BaseBoolType
y'
| Bool
otherwise
= case (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x, forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y) of
(Just Bool
False, Maybe Bool
_) -> forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
y
(Just Bool
True, Maybe Bool
_) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
(Maybe Bool
_, Just Bool
False) -> forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x
(Maybe Bool
_, Just Bool
True) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
(Maybe Bool, Maybe Bool)
_ -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq BaseTypeRepr 'BaseBoolType
BaseBoolRepr (forall a. Ord a => a -> a -> a
min Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y) (forall a. Ord a => a -> a -> a
max Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y)
xorPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
xorPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
eqPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y
andPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
andPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y =
case (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x, forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y) of
(Just Bool
True, Maybe Bool
_) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
(Just Bool
False, Maybe Bool
_) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
(Maybe Bool
_, Just Bool
True) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
(Maybe Bool
_, Just Bool
False) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
(Maybe Bool, Maybe Bool)
_ | Pred (ExprBuilder t st fs)
x forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
y -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
| Bool
otherwise -> Expr t 'BaseBoolType
-> Expr t 'BaseBoolType -> IO (Expr t 'BaseBoolType)
go Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y
where
go :: Expr t 'BaseBoolType
-> Expr t 'BaseBoolType -> IO (Expr t 'BaseBoolType)
go Expr t 'BaseBoolType
a Expr t 'BaseBoolType
b
| Just (ConjPred BoolMap (Expr t)
as) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
a
, Just (ConjPred BoolMap (Expr t)
bs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
b
= forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (f :: BaseType -> Type).
OrdF f =>
BoolMap f -> BoolMap f -> BoolMap f
BM.combine BoolMap (Expr t)
as BoolMap (Expr t)
bs
| forall t. BoolExpr t -> BoolExpr t -> Bool
tryAndAbsorption Expr t 'BaseBoolType
a Expr t 'BaseBoolType
b
= forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t 'BaseBoolType
b
| forall t. BoolExpr t -> BoolExpr t -> Bool
tryAndAbsorption Expr t 'BaseBoolType
b Expr t 'BaseBoolType
a
= forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t 'BaseBoolType
a
| Just (ConjPred BoolMap (Expr t)
as) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
a
= forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
f 'BaseBoolType -> Polarity -> BoolMap f -> BoolMap f
BM.addVar (forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asPosAtom Expr t 'BaseBoolType
b) BoolMap (Expr t)
as
| Just (ConjPred BoolMap (Expr t)
bs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
b
= forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
f 'BaseBoolType -> Polarity -> BoolMap f -> BoolMap f
BM.addVar (forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asPosAtom Expr t 'BaseBoolType
a) BoolMap (Expr t)
bs
| Bool
otherwise
= forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
[(f 'BaseBoolType, Polarity)] -> BoolMap f
BM.fromVars [forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asPosAtom Expr t 'BaseBoolType
a, forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asPosAtom Expr t 'BaseBoolType
b]
orPred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
orPred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y =
case (forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x, forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y) of
(Just Bool
True, Maybe Bool
_) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
(Just Bool
False, Maybe Bool
_) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
(Maybe Bool
_, Just Bool
True) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
(Maybe Bool
_, Just Bool
False) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
(Maybe Bool, Maybe Bool)
_ | Pred (ExprBuilder t st fs)
x forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
y -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
| Bool
otherwise -> Expr t 'BaseBoolType
-> Expr t 'BaseBoolType -> IO (Expr t 'BaseBoolType)
go Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y
where
go :: Expr t 'BaseBoolType
-> Expr t 'BaseBoolType -> IO (Expr t 'BaseBoolType)
go Expr t 'BaseBoolType
a Expr t 'BaseBoolType
b
| Just (NotPred (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as))) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
a
, Just (NotPred (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
bs))) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
b
= forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (forall (f :: BaseType -> Type).
OrdF f =>
BoolMap f -> BoolMap f -> BoolMap f
BM.combine BoolMap (Expr t)
as BoolMap (Expr t)
bs)
| forall t. BoolExpr t -> BoolExpr t -> Bool
tryOrAbsorption Expr t 'BaseBoolType
a Expr t 'BaseBoolType
b
= forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t 'BaseBoolType
b
| forall t. BoolExpr t -> BoolExpr t -> Bool
tryOrAbsorption Expr t 'BaseBoolType
b Expr t 'BaseBoolType
a
= forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t 'BaseBoolType
a
| Just (NotPred (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
as))) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
a
= forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
f 'BaseBoolType -> Polarity -> BoolMap f -> BoolMap f
BM.addVar (forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asNegAtom Expr t 'BaseBoolType
b) BoolMap (Expr t)
as)
| Just (NotPred (forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp -> Just (ConjPred BoolMap (Expr t)
bs))) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t 'BaseBoolType
b
= forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
f 'BaseBoolType -> Polarity -> BoolMap f -> BoolMap f
BM.addVar (forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asNegAtom Expr t 'BaseBoolType
a) BoolMap (Expr t)
bs)
| Bool
otherwise
= forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> BoolMap (Expr t) -> IO (BoolExpr t)
conjPred ExprBuilder t st fs
sym (forall (f :: BaseType -> Type).
(HashableF f, OrdF f) =>
[(f 'BaseBoolType, Polarity)] -> BoolMap f
BM.fromVars [forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asNegAtom Expr t 'BaseBoolType
a, forall t. Expr t 'BaseBoolType -> (Expr t 'BaseBoolType, Polarity)
asNegAtom Expr t 'BaseBoolType
b])
itePred :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
itePred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y
| Pred (ExprBuilder t st fs)
c forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
x = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
y
| Pred (ExprBuilder t st fs)
c forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
y = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
x
| Pred (ExprBuilder t st fs)
x forall a. Eq a => a -> a -> Bool
== Pred (ExprBuilder t st fs)
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
| Just Bool
True <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
x
| Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
c = forall (m :: Type -> Type) a. Monad m => a -> m a
return Pred (ExprBuilder t st fs)
y
| Just (NotPred Expr t 'BaseBoolType
c') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Pred (ExprBuilder t st fs)
c = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sb Expr t 'BaseBoolType
c' Pred (ExprBuilder t st fs)
y Pred (ExprBuilder t st fs)
x
| Just Bool
True <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
y
| Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
x = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
y forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c
| Just Bool
True <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
x forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c
| Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
y = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sb Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
x
| Bool
otherwise =
let sz :: Integer
sz = Integer
1 forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Pred (ExprBuilder t st fs)
x forall a. Num a => a -> a -> a
+ forall t (tp :: BaseType). Expr t tp -> Integer
iteSize Pred (ExprBuilder t st fs)
y in
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb forall a b. (a -> b) -> a -> b
$ forall (tp :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp
-> Integer -> e 'BaseBoolType -> e tp -> e tp -> App e tp
BaseIte BaseTypeRepr 'BaseBoolType
BaseBoolRepr Integer
sz Pred (ExprBuilder t st fs)
c Pred (ExprBuilder t st fs)
x Pred (ExprBuilder t st fs)
y
intLit :: ExprBuilder t st fs
-> Integer -> IO (SymInteger (ExprBuilder t st fs))
intLit ExprBuilder t st fs
sym Integer
n = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr Integer
n
intNeg :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intNeg ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (-Integer
1) SymInteger (ExprBuilder t st fs)
x
intAdd :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intAdd ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
intMul :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intMul ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
intIte :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t 'BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr Pred (ExprBuilder t st fs)
c SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
intEq :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
intEq ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
| Just Bool
b <- forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckEq (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
y)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| Just (SBVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
y
= let wx :: NatRepr w
wx = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
wy :: NatRepr w
wy = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv
in case forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
wx NatRepr w
wy of
NatCaseLT LeqProof (w + 1) w
LeqProof -> do
Expr t (BaseBVType w)
x' <- forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
wy Expr t (BaseBVType w)
xbv
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
ybv
NatCases w w
NatCaseEQ ->
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
ybv
NatCaseGT LeqProof (w + 1) w
LeqProof -> do
Expr t (BaseBVType w)
y' <- forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
wx Expr t (BaseBVType w)
ybv
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
y'
| Just (BVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, Just (BVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
y
= let wx :: NatRepr w
wx = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
wy :: NatRepr w
wy = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv
in case forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
wx NatRepr w
wy of
NatCaseLT LeqProof (w + 1) w
LeqProof -> do
Expr t (BaseBVType w)
x' <- forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
wy Expr t (BaseBVType w)
xbv
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
ybv
NatCases w w
NatCaseEQ ->
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
ybv
NatCaseGT LeqProof (w + 1) w
LeqProof -> do
Expr t (BaseBVType w)
y' <- forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
wx Expr t (BaseBVType w)
ybv
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
y'
| Just (SBVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, Just Coefficient SemiRingInteger
yi <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
y
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv in
if Coefficient SemiRingInteger
yi forall a. Ord a => a -> a -> Bool
< forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w Bool -> Bool -> Bool
|| Coefficient SemiRingInteger
yi forall a. Ord a => a -> a -> Bool
> forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
then forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
else forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient SemiRingInteger
yi)
| Just Coefficient SemiRingInteger
xi <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
x
, Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv in
if Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
< forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w Bool -> Bool -> Bool
|| Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
> forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
then forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
else forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
ybv forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient SemiRingInteger
xi)
| Just (BVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, Just Coefficient SemiRingInteger
yi <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
y
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv in
if Coefficient SemiRingInteger
yi forall a. Ord a => a -> a -> Bool
< forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w Bool -> Bool -> Bool
|| Coefficient SemiRingInteger
yi forall a. Ord a => a -> a -> Bool
> forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
then forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
else forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient SemiRingInteger
yi)
| Just Coefficient SemiRingInteger
xi <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
x
, Just (BVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv in
if Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
< forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w Bool -> Bool -> Bool
|| Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
> forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
then forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
else forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
ybv forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient SemiRingInteger
xi)
| Bool
otherwise = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t 'BaseBoolType)
semiRingEq ExprBuilder t st fs
sym SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym) SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
intLe :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
intLe ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
| Just Bool
b <- forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckLe (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
y)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| Just (SBVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
y
= do let wx :: NatRepr w
wx = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
let wy :: NatRepr w
wy = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv
case forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
wx NatRepr w
wy of
NatCaseLT LeqProof (w + 1) w
LeqProof -> do
Expr t (BaseBVType w)
x' <- forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
wy Expr t (BaseBVType w)
xbv
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
ybv
NatCases w w
NatCaseEQ -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
ybv
NatCaseGT LeqProof (w + 1) w
LeqProof -> do
Expr t (BaseBVType w)
y' <- forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
wx Expr t (BaseBVType w)
ybv
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
y'
| Just (BVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, Just (BVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
y
= do let wx :: NatRepr w
wx = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv
let wy :: NatRepr w
wy = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv
case forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
wx NatRepr w
wy of
NatCaseLT LeqProof (w + 1) w
LeqProof -> do
Expr t (BaseBVType w)
x' <- forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
wy Expr t (BaseBVType w)
xbv
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
ybv
NatCases w w
NatCaseEQ -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
ybv
NatCaseGT LeqProof (w + 1) w
LeqProof -> do
Expr t (BaseBVType w)
y' <- forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
wx Expr t (BaseBVType w)
ybv
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym Expr t (BaseBVType w)
xbv Expr t (BaseBVType w)
y'
| Just (SBVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, Just Coefficient SemiRingInteger
yi <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
y
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv in
if | Coefficient SemiRingInteger
yi forall a. Ord a => a -> a -> Bool
< forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
| Coefficient SemiRingInteger
yi forall a. Ord a => a -> a -> Bool
> forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
| Bool
otherwise -> forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t (BaseBVType w)
xbv forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient SemiRingInteger
yi))
| Just Coefficient SemiRingInteger
xi <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
x
, Just (SBVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv in
if | Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
< forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
| Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
> forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
| Bool
otherwise -> forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvSle ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient SemiRingInteger
xi) forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t (BaseBVType w)
ybv)
| Just (BVToInteger Expr t (BaseBVType w)
xbv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, Just Coefficient SemiRingInteger
yi <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
y
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
xbv in
if | Coefficient SemiRingInteger
yi forall a. Ord a => a -> a -> Bool
< forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
| Coefficient SemiRingInteger
yi forall a. Ord a => a -> a -> Bool
> forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
| Bool
otherwise -> forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t (BaseBVType w)
xbv forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient SemiRingInteger
yi))
| Just Coefficient SemiRingInteger
xi <- forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> Maybe (Coefficient sr)
asSemiRingLit SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr SymInteger (ExprBuilder t st fs)
x
, Just (BVToInteger Expr t (BaseBVType w)
ybv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
ybv in
if | Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
< forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
| Coefficient SemiRingInteger
xi forall a. Ord a => a -> a -> Bool
> forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w -> forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
| Bool
otherwise -> forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvUle ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient SemiRingInteger
xi) forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Expr t (BaseBVType w)
ybv)
| Bool
otherwise
= forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t 'BaseBoolType)
semiRingLe ExprBuilder t st fs
sym OrderedSemiRingRepr SemiRingInteger
SR.OrderedSemiRingIntegerRepr (forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe ExprBuilder t st fs
sym) SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
intAbs :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intAbs ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x
| Just Integer
i <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
x = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall a. Num a => a -> a
abs Integer
i)
| Just Bool
True <- forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckLe (forall tp. tp -> ValueRange tp
SingleRange Integer
0) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
x) = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymInteger (ExprBuilder t st fs)
x
| Just Bool
True <- forall tp. Ord tp => ValueRange tp -> ValueRange tp -> Maybe Bool
rangeCheckLe (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymInteger (ExprBuilder t st fs)
x) (forall tp. tp -> ValueRange tp
SingleRange Integer
0) = forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> IO (SymInteger sym)
intNeg ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseIntegerType -> App e BaseIntegerType
IntAbs SymInteger (ExprBuilder t st fs)
x)
intDiv :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intDiv ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
| Just Integer
1 <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymInteger (ExprBuilder t st fs)
x
| Just Integer
xi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
x, Just Integer
yi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y, Integer
yi forall a. Eq a => a -> a -> Bool
/= Integer
0 =
if Integer
yi forall a. Ord a => a -> a -> Bool
>= Integer
0 then
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
xi forall a. Integral a => a -> a -> a
`div` Integer
yi)
else
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall a. Num a => a -> a
negate (Integer
xi forall a. Integral a => a -> a -> a
`div` forall a. Num a => a -> a
negate Integer
yi))
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseIntegerType -> e BaseIntegerType -> App e BaseIntegerType
IntDiv SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y)
intMod :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
intMod ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y
| Just Integer
1 <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
0
| Just Integer
xi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
x, Just Integer
yi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y, Integer
yi forall a. Eq a => a -> a -> Bool
/= Integer
0 =
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
xi forall a. Integral a => a -> a -> a
`mod` forall a. Num a => a -> a
abs Integer
yi)
| Just (SemiRingSum WeightedSum (Expr t) sr
xsum) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, SemiRingRepr sr
SR.SemiRingIntegerRepr <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
xsum
, Just Integer
yi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
y
, Integer
yi forall a. Eq a => a -> a -> Bool
/= Integer
0 =
case forall (f :: BaseType -> Type).
Tm f =>
WeightedSum f SemiRingInteger
-> Integer -> WeightedSum f SemiRingInteger
WSum.reduceIntSumMod WeightedSum (Expr t) sr
xsum (forall a. Num a => a -> a
abs Integer
yi) of
WeightedSum (Expr t) SemiRingInteger
xsum' | Just Coefficient SemiRingInteger
xi <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) SemiRingInteger
xsum' ->
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Coefficient SemiRingInteger
xi
| Bool
otherwise ->
do IntegerExpr t
x' <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> WeightedSum (Expr t) SemiRingInteger -> IO (IntegerExpr t)
intSum ExprBuilder t st fs
sym WeightedSum (Expr t) SemiRingInteger
xsum'
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseIntegerType -> e BaseIntegerType -> App e BaseIntegerType
IntMod IntegerExpr t
x' SymInteger (ExprBuilder t st fs)
y)
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseIntegerType -> e BaseIntegerType -> App e BaseIntegerType
IntMod SymInteger (ExprBuilder t st fs)
x SymInteger (ExprBuilder t st fs)
y)
intDivisible :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> Natural
-> IO (Pred (ExprBuilder t st fs))
intDivisible ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x Natural
k
| Natural
k forall a. Eq a => a -> a -> Bool
== Natural
0 = forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
0
| Natural
k forall a. Eq a => a -> a -> Bool
== Natural
1 = forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym)
| Just Integer
xi <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Integer
xi forall a. Integral a => a -> a -> a
`mod` (forall a. Integral a => a -> Integer
toInteger Natural
k) forall a. Eq a => a -> a -> Bool
== Integer
0)
| Just (SemiRingSum WeightedSum (Expr t) sr
xsum) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x
, SemiRingRepr sr
SR.SemiRingIntegerRepr <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
xsum =
case forall (f :: BaseType -> Type).
Tm f =>
WeightedSum f SemiRingInteger
-> Integer -> WeightedSum f SemiRingInteger
WSum.reduceIntSumMod WeightedSum (Expr t) sr
xsum (forall a. Integral a => a -> Integer
toInteger Natural
k) of
WeightedSum (Expr t) SemiRingInteger
xsum' | Just Coefficient SemiRingInteger
xi <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) SemiRingInteger
xsum' ->
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Coefficient SemiRingInteger
xi forall a. Eq a => a -> a -> Bool
== Integer
0)
| Bool
otherwise ->
do IntegerExpr t
x' <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> WeightedSum (Expr t) SemiRingInteger -> IO (IntegerExpr t)
intSum ExprBuilder t st fs
sym WeightedSum (Expr t) SemiRingInteger
xsum'
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseIntegerType -> Natural -> App e 'BaseBoolType
IntDivisible IntegerExpr t
x' Natural
k)
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseIntegerType -> Natural -> App e 'BaseBoolType
IntDivisible SymInteger (ExprBuilder t st fs)
x Natural
k)
bvLit :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w -> BV w -> IO (SymBV (ExprBuilder t st fs) w)
bvLit ExprBuilder t st fs
sym NatRepr w
w BV w
bv =
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> IO (Expr t (SemiRingBase sr))
semiRingLit ExprBuilder t st fs
sym (forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr NatRepr w
w) BV w
bv
bvConcat :: forall (u :: Natural) (v :: Natural).
(1 <= u, 1 <= v) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) u
-> SymBV (ExprBuilder t st fs) v
-> IO (SymBV (ExprBuilder t st fs) (u + v))
bvConcat ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) u
x SymBV (ExprBuilder t st fs) v
y =
case (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) u
x, forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) v
y) of
(Just BV u
xv, Just BV v
yv) -> do
let w' :: NatRepr (u + v)
w' = forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y)
LeqProof 1 (u + v)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (m :: Natural) (n :: Natural) (p :: Natural -> Type)
(q :: Natural -> Type).
(1 <= m, 1 <= n) =>
p m -> q n -> LeqProof 1 (m + n)
leqAddPos (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y))
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr (u + v)
w' (forall (w :: Natural) (w' :: Natural).
NatRepr w -> NatRepr w' -> BV w -> BV w' -> BV (w + w')
BV.concat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y) BV u
xv BV v
yv)
(Just BV u
_xv, Maybe (BV v)
_)
| Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) v
y
, Just BV u
_av <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType u)
a
, Just (u + v) :~: ((u + u) + v)
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)))
(forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a)) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b))
, Just LeqProof 1 (u + u)
LeqProof <- forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a)) -> do
Expr t (BaseBVType (u + u))
xa <- forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) u
x Expr t (BaseBVType u)
a
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym Expr t (BaseBVType (u + u))
xa Expr t (BaseBVType v)
b
(Maybe (BV u), Maybe (BV v))
_ | Just (BVSelect NatRepr idx
idx1 NatRepr n
n1 Expr t (BaseBVType w)
a) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x
, Just (BVSelect NatRepr idx
idx2 NatRepr n
n2 Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) v
y
, Just BaseBVType w :~: BaseBVType w
Refl <- forall t (a :: BaseType) (b :: BaseType).
Expr t a -> Expr t b -> Maybe (a :~: b)
sameTerm Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b
, Just idx :~: (idx + v)
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr idx
idx1 (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx2 NatRepr n
n2)
, Just LeqProof 1 (u + v)
LeqProof <- forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr n
n1 NatRepr n
n2)
, Just LeqProof (idx + (u + v)) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx2 (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr n
n1 NatRepr n
n2)) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
a) ->
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sym NatRepr idx
idx2 (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr n
n1 NatRepr n
n2) Expr t (BaseBVType w)
a
(Maybe (BV u), Maybe (BV v))
_ | Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x
, Just BV v
_bv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType v)
b
, Just (u + (v + v)) :~: (u + v)
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y)))
(forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y))
, Just LeqProof 1 (v + v)
LeqProof <- forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y)) -> do
Expr t (BaseBVType (v + v))
by <- forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym Expr t (BaseBVType v)
b SymBV (ExprBuilder t st fs) v
y
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym Expr t (BaseBVType u)
a Expr t (BaseBVType (v + v))
by
(Maybe (BV u), Maybe (BV v))
_ -> do
let wx :: NatRepr u
wx = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x
let wy :: NatRepr v
wy = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) v
y
Just LeqProof 1 (u + v)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr u
wx NatRepr v
wy))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (u :: Natural) (v :: Natural) (e :: BaseType -> Type).
(1 <= u, 1 <= v, 1 <= (u + v)) =>
NatRepr (u + v)
-> e (BaseBVType u)
-> e (BaseBVType v)
-> App e ('BaseBVType (u + v))
BVConcat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr u
wx NatRepr v
wy) SymBV (ExprBuilder t st fs) u
x SymBV (ExprBuilder t st fs) v
y
bvSelect :: forall (idx :: Natural) (n :: Natural) (w :: Natural).
(1 <= n, (idx + n) <= w) =>
ExprBuilder t st fs
-> NatRepr idx
-> NatRepr n
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr n
n SymBV (ExprBuilder t st fs) w
x
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = do
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr n
n (forall (ix :: Natural) (w' :: Natural) (w :: Natural).
((ix + w') <= w) =>
NatRepr ix -> NatRepr w' -> BV w -> BV w'
BV.select NatRepr idx
idx NatRepr n
n BV w
xv)
| Just (BVSelect NatRepr idx
idx' NatRepr n
_n' Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, let idx2 :: NatRepr (idx + idx)
idx2 = forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr idx
idx'
, Just LeqProof ((idx + idx) + n) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (idx + idx)
idx2 NatRepr n
n) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b) =
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr (idx + idx)
idx2 NatRepr n
n Expr t (BaseBVType w)
b
| Just idx :~: 0
_ <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr idx
idx (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 0)
, Just n :~: w
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr n
n (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) =
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
| Just (BVShl NatRepr w
w Expr t ('BaseBVType w)
a Expr t ('BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just BV w
diff <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
, Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
, Just LeqProof x idx
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr x
diffRepr NatRepr idx
idx = do
Just LeqProof ((idx - x) + n) w
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n) NatRepr w
w
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb (forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n Expr t ('BaseBVType w)
a
| Just (BVShl NatRepr w
_w Expr t ('BaseBVType w)
_a Expr t ('BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just BV w
diff <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
, Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
, Just LeqProof (idx + n) x
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) NatRepr x
diffRepr =
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr n
n (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr n
n)
| Just (BVAshr NatRepr w
w Expr t ('BaseBVType w)
a Expr t ('BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just BV w
diff <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
, Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
, Just LeqProof ((idx + x) + n) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n) NatRepr w
w =
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n Expr t ('BaseBVType w)
a
| Just (BVLshr NatRepr w
w Expr t ('BaseBVType w)
a Expr t ('BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just BV w
diff <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
, Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
, Just LeqProof ((idx + x) + n) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n) NatRepr w
w =
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) NatRepr n
n Expr t ('BaseBVType w)
a
| Just (BVLshr NatRepr w
w Expr t ('BaseBVType w)
_a Expr t ('BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just BV w
diff <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
b
, Some NatRepr x
diffRepr <- Natural -> Some NatRepr
mkNatRepr (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
diff)
, Just LeqProof w (idx + x)
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr w
w (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr x
diffRepr) =
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr n
n (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr n
n)
| Just (BVSext NatRepr r
w Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x = do
Just LeqProof w r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b) NatRepr r
w
let ext :: NatRepr (r - w)
ext = forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr r
w (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b)
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
Just LeqProof 1 (w - w)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (r - w)
ext
Expr t (BaseBVType (w - w))
zeros <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> IO (SymBV sym w)
minUnsignedBV ExprBuilder t st fs
sb NatRepr (r - w)
ext
Expr t (BaseBVType (w - w))
ones <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> IO (SymBV sym w)
maxUnsignedBV ExprBuilder t st fs
sb NatRepr (r - w)
ext
Expr t 'BaseBoolType
c <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNeg ExprBuilder t st fs
sb Expr t (BaseBVType w)
b
Expr t (BaseBVType (w - w))
hi <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sb Expr t 'BaseBoolType
c Expr t (BaseBVType (w - w))
ones Expr t (BaseBVType (w - w))
zeros
Expr t (BaseBVType ((w - w) + w))
x' <- forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sb Expr t (BaseBVType (w - w))
hi Expr t (BaseBVType w)
b
Just LeqProof (idx + n) ((w - w) + w)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (r - w)
ext (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b))
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr n
n Expr t (BaseBVType ((w - w) + w))
x'
| Just (BVZext NatRepr r
w Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x = do
Just LeqProof w r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b) NatRepr r
w
let ext :: NatRepr (r - w)
ext = forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr r
w (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b)
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
Just LeqProof 1 (w - w)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (r - w)
ext
Expr t (BaseBVType (w - w))
hi <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sb NatRepr (r - w)
ext (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr (r - w)
ext)
Expr t (BaseBVType ((w - w) + w))
x' <- forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sb Expr t (BaseBVType (w - w))
hi Expr t (BaseBVType w)
b
Just LeqProof (idx + n) ((w - w) + w)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (r - w)
ext (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
b))
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr n
n Expr t (BaseBVType ((w - w) + w))
x'
| Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
_a Expr t (BaseBVType v)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just LeqProof (idx + n) v
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr n
n) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) = do
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr n
n Expr t (BaseBVType v)
b
| Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just LeqProof v idx
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) NatRepr idx
idx
, Just LeqProof 1 idx
LeqProof <- forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr idx
idx
, let diff :: NatRepr (idx - v)
diff = forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr idx
idx (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)
, Just LeqProof ((idx - v) + n) u
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (idx - v)
diff NatRepr n
n) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a) = do
forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb (forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr idx
idx (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)) NatRepr n
n Expr t (BaseBVType u)
a
| Just (BVConcat NatRepr (u + v)
_w Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x = do
Just LeqProof idx v
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr idx
idx (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)
let n2 :: NatRepr (v - idx)
n2 = forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b) NatRepr idx
idx
Just LeqProof (v - idx) n
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq NatRepr (v - idx)
n2 NatRepr n
n
let n1 :: NatRepr (n - (v - idx))
n1 = forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr n
n NatRepr (v - idx)
n2
let z :: NatRepr 0
z = forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 0
Just LeqProof 1 (n - (v - idx))
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (n - (v - idx))
n1
Just LeqProof (n - (v - idx)) u
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr 0
z NatRepr (n - (v - idx))
n1) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType u)
a)
Expr t (BaseBVType (n - (v - idx)))
a' <- forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr 0
z NatRepr (n - (v - idx))
n1 Expr t (BaseBVType u)
a
Just LeqProof 1 (v - idx)
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr (v - idx)
n2
Just LeqProof (idx + (v - idx)) v
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr idx
idx NatRepr (v - idx)
n2) (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType v)
b)
Expr t (BaseBVType (v - idx))
b' <- forall sym (idx :: Natural) (n :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= n, (idx + n) <= w) =>
sym -> NatRepr idx -> NatRepr n -> SymBV sym w -> IO (SymBV sym n)
bvSelect ExprBuilder t st fs
sb NatRepr idx
idx NatRepr (v - idx)
n2 Expr t (BaseBVType v)
b
Just ((n - (v - idx)) + (v - idx)) :~: n
Refl <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (n - (v - idx))
n1 NatRepr (v - idx)
n2) NatRepr n
n
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sb Expr t (BaseBVType (n - (v - idx)))
a' Expr t (BaseBVType (v - idx))
b'
| Just (SemiRingSum WeightedSum (Expr t) sr
s) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVArithRepr NatRepr w
w <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s
, Just idx :~: 0
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr idx
idx (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 0) =
do let mask :: BV w
mask = case forall (m :: Natural) (n :: Natural).
(m <= n) =>
NatRepr m -> NatRepr n -> Either (LeqProof (m + 1) n) (m :~: n)
testStrictLeq NatRepr n
n NatRepr w
w of
Left LeqProof (n + 1) w
LeqProof -> forall (w :: Natural) (w' :: Natural).
((w + 1) <= w') =>
NatRepr w' -> BV w -> BV w'
BV.zext NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr n
n)
Right n :~: w
Refl -> forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr n
n
let reduce :: BV w -> WriterT Any Identity (BV w)
reduce BV w
i
| BV w
i forall (w :: Natural). BV w -> BV w -> BV w
`BV.and` BV w
mask forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w = forall (m :: Type -> Type) a w. Monad m => (a, w) -> WriterT w m a
writer (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w, Bool -> Any
Any Bool
True)
| Bool
otherwise = forall (m :: Type -> Type) a w. Monad m => (a, w) -> WriterT w m a
writer (BV w
i, Bool -> Any
Any Bool
False)
let (WeightedSum (Expr t) sr
s', Any Bool
changed) = forall w a. Writer w a -> (a, w)
runWriter forall a b. (a -> b) -> a -> b
$ forall (m :: Type -> Type) (f :: BaseType -> Type)
(sr :: SemiRing).
(Applicative m, Tm f) =>
(Coefficient sr -> m (Coefficient sr))
-> WeightedSum f sr -> m (WeightedSum f sr)
WSum.traverseCoeffs BV w -> WriterT Any Identity (BV w)
reduce WeightedSum (Expr t) sr
s
Expr t (BaseBVType w)
x' <- if Bool
changed then forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb (forall (e :: BaseType -> Type) (sr :: SemiRing).
WeightedSum e sr -> App e (SemiRingBase sr)
SemiRingSum WeightedSum (Expr t) sr
s') else forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) (idx :: Natural) (w :: Natural)
(e :: BaseType -> Type).
(1 <= n, (idx + n) <= w) =>
NatRepr idx
-> NatRepr n -> e (BaseBVType w) -> App e ('BaseBVType n)
BVSelect NatRepr idx
idx NatRepr n
n Expr t (BaseBVType w)
x'
| Just (BVUnaryTerm UnaryBV (Expr t 'BaseBoolType) n
u) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just idx :~: 0
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr idx
idx (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @0) =
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sb forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, u <= r) =>
sym
-> UnaryBV (Pred sym) r -> NatRepr u -> IO (UnaryBV (Pred sym) u)
UnaryBV.trunc ExprBuilder t st fs
sb UnaryBV (Expr t 'BaseBoolType) n
u NatRepr n
n
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb forall a b. (a -> b) -> a -> b
$ forall (n :: Natural) (idx :: Natural) (w :: Natural)
(e :: BaseType -> Type).
(1 <= n, (idx + n) <= w) =>
NatRepr idx
-> NatRepr n -> e (BaseBVType w) -> App e ('BaseBVType n)
BVSelect NatRepr idx
idx NatRepr n
n SymBV (ExprBuilder t st fs) w
x
testBitBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Natural
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
testBitBV ExprBuilder t st fs
sym Natural
i SymBV (ExprBuilder t st fs) w
y
| Natural
i forall a. Ord a => a -> a -> Bool
< Natural
0 Bool -> Bool -> Bool
|| Natural
i forall a. Ord a => a -> a -> Bool
>= forall (n :: Natural). NatRepr n -> Natural
natValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
y) =
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Illegal bit index."
| Just BV w
yc <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
, Natural
i forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (w :: Natural). Natural -> BV w -> Bool
BV.testBit' (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
i) BV w
yc)
| Just (BVZext NatRepr r
_w Expr t (BaseBVType w)
y') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
= if Natural
i forall a. Ord a => a -> a -> Bool
>= forall (n :: Natural). NatRepr n -> Natural
natValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y') then
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym
else
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i Expr t (BaseBVType w)
y'
| Just (BVSext NatRepr r
_w Expr t (BaseBVType w)
y') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
= if Natural
i forall a. Ord a => a -> a -> Bool
>= forall (n :: Natural). NatRepr n -> Natural
natValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y') then
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym (forall (n :: Natural). NatRepr n -> Natural
natValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y') forall a. Num a => a -> a -> a
- Natural
1) Expr t (BaseBVType w)
y'
else
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i Expr t (BaseBVType w)
y'
| Just (BVFill NatRepr w
_ Expr t 'BaseBoolType
p) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
= forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t 'BaseBoolType
p
| Just Bool
b <- forall (w :: Natural).
NatRepr w -> BVDomain w -> Natural -> Maybe Bool
BVD.testBit (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
y) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y) Natural
i
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ Expr t 'BaseBoolType
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
, forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b)
= do Expr t 'BaseBoolType
a' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i Expr t (BaseBVType w)
a
Expr t 'BaseBoolType
b' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Natural -> SymBV sym w -> IO (Pred sym)
testBitBV ExprBuilder t st fs
sym Natural
i Expr t (BaseBVType w)
b
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c Expr t 'BaseBoolType
a' Expr t 'BaseBoolType
b'
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
Natural -> e (BaseBVType w) -> App e 'BaseBoolType
BVTestBit Natural
i SymBV (ExprBuilder t st fs) w
y
bvFill :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w
-> Pred (ExprBuilder t st fs)
-> IO (SymBV (ExprBuilder t st fs) w)
bvFill ExprBuilder t st fs
sym NatRepr w
w Pred (ExprBuilder t st fs)
p
| Just Bool
True <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned NatRepr w
w)
| Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e 'BaseBoolType -> App e ('BaseBVType w)
BVFill NatRepr w
w Pred (ExprBuilder t st fs)
p
bvIte :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| Just (BVFill NatRepr w
w Expr t 'BaseBoolType
px) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just (BVFill NatRepr w
_w Expr t 'BaseBoolType
py) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y =
do Expr t 'BaseBoolType
z <- forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c Expr t 'BaseBoolType
px Expr t 'BaseBoolType
py
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> Pred sym -> IO (SymBV sym w)
bvFill ExprBuilder t st fs
sym NatRepr w
w Expr t 'BaseBoolType
z
| Just (BVZext NatRepr r
w Expr t (BaseBVType w)
x') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just (BVZext NatRepr r
w' Expr t (BaseBVType w)
y') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
, Just w :~: w
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
x') (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y')
, Just r :~: r
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr r
w NatRepr r
w' =
do Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
y'
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr r
w Expr t (BaseBVType w)
z
| Just (BVSext NatRepr r
w Expr t (BaseBVType w)
x') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just (BVSext NatRepr r
w' Expr t (BaseBVType w)
y') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
, Just w :~: w
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
x') (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y')
, Just r :~: r
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr r
w NatRepr r
w' =
do Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> Pred sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c Expr t (BaseBVType w)
x' Expr t (BaseBVType w)
y'
forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr r
w Expr t (BaseBVType w)
z
| Just (FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp1 Expr t (BaseFloatType (FloatingPointPrecision eb sb))
x') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just (FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp2 Expr t (BaseFloatType (FloatingPointPrecision eb sb))
y') <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
, Just FloatingPointPrecision eb sb :~: FloatingPointPrecision eb sb
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp1 FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp2 =
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c Expr t (BaseFloatType (FloatingPointPrecision eb sb))
x' Expr t (BaseFloatType (FloatingPointPrecision eb sb))
y'
| Bool
otherwise =
do Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w, ?unaryThreshold::Int) =>
ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (BVExpr t w)
-> IO (BVExpr t w)
sbTryUnaryTerm ExprBuilder t st fs
sym
(do UnaryBV (Expr t 'BaseBoolType) w
ux <- forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
UnaryBV (Expr t 'BaseBoolType) w
uy <- forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y
forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym (n :: Natural).
(1 <= n, IsExprBuilder sym) =>
sym
-> Pred sym
-> UnaryBV (Pred sym) n
-> UnaryBV (Pred sym) n
-> IO (UnaryBV (Pred sym) n)
UnaryBV.mux ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c UnaryBV (Expr t 'BaseBoolType) w
ux UnaryBV (Expr t 'BaseBoolType) w
uy))
(case forall t (w :: Natural).
Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (Some BVFlavorRepr)
inSameBVSemiRing SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y of
Just (Some BVFlavorRepr x
flv) ->
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t 'BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym (forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr x
flv (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)) Pred (ExprBuilder t st fs)
c SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
Maybe (Some BVFlavorRepr)
Nothing ->
forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t 'BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y)
bvEq :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| SymBV (ExprBuilder t st fs) w
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
| Just (BVFill NatRepr w
_ Expr t 'BaseBoolType
px) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just (BVFill NatRepr w
_ Expr t 'BaseBoolType
py) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y =
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
eqPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
px Expr t 'BaseBoolType
py
| Just Bool
b <- forall (w :: Natural). BVDomain w -> BVDomain w -> Maybe Bool
BVD.eq (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y) = do
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- SymBV (ExprBuilder t st fs) w
x
, Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ Expr t 'BaseBoolType
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
, forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b)
= forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x Expr t (BaseBVType w)
a forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x Expr t (BaseBVType w)
b)
| Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ Expr t 'BaseBoolType
c Expr t (BaseBVType w)
a Expr t (BaseBVType w)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, SemiRingLiteral SemiRingRepr sr
_ Coefficient sr
_ ProgramLoc
_ <- SymBV (ExprBuilder t st fs) w
y
, forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
a) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
b)
= forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
c forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
a SymBV (ExprBuilder t st fs) w
y forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym Expr t (BaseBVType w)
b SymBV (ExprBuilder t st fs) w
y)
| Just (Some BVFlavorRepr x
flv) <- forall t (w :: Natural).
Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (Some BVFlavorRepr)
inSameBVSemiRing SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
, let sr :: SemiRingRepr ('SemiRingBV x w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr x
flv (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
, (WeightedSum (Expr t) ('SemiRingBV x w)
z, WeightedSum (Expr t) ('SemiRingBV x w)
x',WeightedSum (Expr t) ('SemiRingBV x w)
y') <- forall (f :: BaseType -> Type) (sr :: SemiRing).
Tm f =>
WeightedSum f sr
-> WeightedSum f sr
-> (WeightedSum f sr, WeightedSum f sr, WeightedSum f sr)
WSum.extractCommon (forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr ('SemiRingBV x w)
sr SymBV (ExprBuilder t st fs) w
x) (forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr ('SemiRingBV x w)
sr SymBV (ExprBuilder t st fs) w
y)
, Bool -> Bool
not (forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr -> WeightedSum f sr -> Bool
WSum.isZero SemiRingRepr ('SemiRingBV x w)
sr WeightedSum (Expr t) ('SemiRingBV x w)
z) =
case (forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) ('SemiRingBV x w)
x', forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> Maybe (Coefficient sr)
WSum.asConstant WeightedSum (Expr t) ('SemiRingBV x w)
y') of
(Just BV w
a, Just BV w
b) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (sr :: SemiRing).
SemiRingRepr sr -> Coefficient sr -> Coefficient sr -> Bool
SR.eq SemiRingRepr ('SemiRingBV x w)
sr BV w
a BV w
b)
(Maybe (BV w), Maybe (BV w))
_ -> do Expr t (BaseBVType w)
xr <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) ('SemiRingBV x w)
x'
Expr t (BaseBVType w)
yr <- forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym WeightedSum (Expr t) ('SemiRingBV x w)
y'
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (sr :: SemiRing).
SemiRingRepr sr -> BaseTypeRepr (SemiRingBase sr)
SR.semiRingBase SemiRingRepr ('SemiRingBV x w)
sr) (forall a. Ord a => a -> a -> a
min Expr t (BaseBVType w)
xr Expr t (BaseBVType w)
yr) (forall a. Ord a => a -> a -> a
max Expr t (BaseBVType w)
xr Expr t (BaseBVType w)
yr)
| Bool
otherwise = do
Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
if | Just UnaryBV (Expr t 'BaseBoolType) w
ux <- forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
, Just UnaryBV (Expr t 'BaseBoolType) w
uy <- forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y
-> forall (n :: Natural) sym.
(1 <= n, IsExprBuilder sym) =>
sym
-> UnaryBV (Pred sym) n -> UnaryBV (Pred sym) n -> IO (Pred sym)
UnaryBV.eq ExprBuilder t st fs
sym UnaryBV (Expr t 'BaseBoolType) w
ux UnaryBV (Expr t 'BaseBoolType) w
uy
| Bool
otherwise
-> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)) (forall a. Ord a => a -> a -> a
min SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y) (forall a. Ord a => a -> a -> a
max SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y)
bvSlt :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
bvSlt ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| Just BV w
xc <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x
, Just BV w
yc <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y =
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> BV w -> Bool
BV.slt (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xc BV w
yc)
| Just Bool
b <- forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BVDomain w -> BVDomain w -> Maybe Bool
BVD.slt (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y) =
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| SymBV (ExprBuilder t st fs) w
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
| Bool
otherwise = do
Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
if | Just UnaryBV (Expr t 'BaseBoolType) w
ux <- forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
, Just UnaryBV (Expr t 'BaseBoolType) w
uy <- forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y
-> forall (n :: Natural) sym.
(1 <= n, IsExprBuilder sym) =>
sym
-> UnaryBV (Pred sym) n -> UnaryBV (Pred sym) n -> IO (Pred sym)
UnaryBV.slt ExprBuilder t st fs
sym UnaryBV (Expr t 'BaseBoolType) w
ux UnaryBV (Expr t 'BaseBoolType) w
uy
| Bool
otherwise
-> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> e (BaseBVType w) -> App e 'BaseBoolType
BVSlt SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvUlt :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
bvUlt ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| Just BV w
xc <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x
, Just BV w
yc <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y = do
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (w :: Natural). BV w -> BV w -> Bool
BV.ult BV w
xc BV w
yc)
| Just Bool
b <- forall (w :: Natural).
(1 <= w) =>
BVDomain w -> BVDomain w -> Maybe Bool
BVD.ult (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y) =
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| SymBV (ExprBuilder t st fs) w
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y =
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym
| Bool
otherwise = do
Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
if | Just UnaryBV (Expr t 'BaseBoolType) w
ux <- forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
, Just UnaryBV (Expr t 'BaseBoolType) w
uy <- forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y
-> forall (n :: Natural) sym.
(1 <= n, IsExprBuilder sym) =>
sym
-> UnaryBV (Pred sym) n -> UnaryBV (Pred sym) n -> IO (Pred sym)
UnaryBV.ult ExprBuilder t st fs
sym UnaryBV (Expr t 'BaseBoolType) w
ux UnaryBV (Expr t 'BaseBoolType) w
uy
| Bool
otherwise
-> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> e (BaseBVType w) -> App e 'BaseBoolType
BVUlt SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvShl :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvShl ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| Just (BV.BV Integer
0) <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
= forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymBV (ExprBuilder t st fs) w
x
| let (Integer
lo, Integer
_hi) = forall (w :: Natural). BVDomain w -> (Integer, Integer)
BVD.ubounds (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y)
, Integer
lo forall a. Ord a => a -> a -> Bool
>= forall (w :: Natural). NatRepr w -> Integer
intValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x))
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x, Just BV w
n <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (forall (w :: Natural). NatRepr w -> BV w -> Natural -> BV w
BV.shl (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n))
| Bool
otherwise
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVShl (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvLshr :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvLshr ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| Just (BV.BV Integer
0) <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
= forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymBV (ExprBuilder t st fs) w
x
| let (Integer
lo, Integer
_hi) = forall (w :: Natural). BVDomain w -> (Integer, Integer)
BVD.ubounds (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y)
, Integer
lo forall a. Ord a => a -> a -> Bool
>= forall (w :: Natural). NatRepr w -> Integer
intValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x))
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x, Just BV w
n <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall a b. (a -> b) -> a -> b
$ forall (w :: Natural). NatRepr w -> BV w -> Natural -> BV w
BV.lshr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n)
| Bool
otherwise
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVLshr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvAshr :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvAshr ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| Just (BV.BV Integer
0) <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
= forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymBV (ExprBuilder t st fs) w
x
| let (Integer
lo, Integer
_hi) = forall (w :: Natural). BVDomain w -> (Integer, Integer)
BVD.ubounds (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y)
, Integer
lo forall a. Ord a => a -> a -> Bool
>= forall (w :: Natural). NatRepr w -> Integer
intValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> Pred sym -> IO (SymBV sym w)
bvFill ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNeg ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x, Just BV w
n <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall a b. (a -> b) -> a -> b
$ forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> Natural -> BV w
BV.ashr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n)
| Bool
otherwise
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVAshr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvRol :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvRol ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x, Just BV w
n <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall a b. (a -> b) -> a -> b
$ forall (w :: Natural). NatRepr w -> BV w -> Natural -> BV w
BV.rotateL (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n)
| Just BV w
n <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
, BV w
n forall (w :: Natural). BV w -> BV w -> BV w
`BV.urem` forall (w :: Natural). NatRepr w -> BV w
BV.width (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
y) forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
y)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
| Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, forall a. (Bits a, Num a) => a -> Bool
isPow2 (forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
= do Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
y
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRol ExprBuilder t st fs
sym Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z
| Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
= do Expr t (BaseBVType w)
wbv <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
Expr t (BaseBVType w)
n' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym Expr t ('BaseBVType w)
n Expr t (BaseBVType w)
wbv
Expr t (BaseBVType w)
y' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y Expr t (BaseBVType w)
wbv
Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t (BaseBVType w)
n' Expr t (BaseBVType w)
y'
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRol ExprBuilder t st fs
sym Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z
| Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, forall a. (Bits a, Num a) => a -> Bool
isPow2 (forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
= do Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
y
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRor ExprBuilder t st fs
sym Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z
| Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
= do Expr t (BaseBVType w)
wbv <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
Expr t (BaseBVType w)
y' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y Expr t (BaseBVType w)
wbv
Expr t (BaseBVType w)
n' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym Expr t ('BaseBVType w)
n Expr t (BaseBVType w)
wbv
Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t (BaseBVType w)
n' forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym Expr t (BaseBVType w)
wbv Expr t (BaseBVType w)
y'
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRor ExprBuilder t st fs
sym Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z
| Bool
otherwise
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x in
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVRol NatRepr w
w SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvRor :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvRor ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x, Just BV w
n <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall a b. (a -> b) -> a -> b
$ forall (w :: Natural). NatRepr w -> BV w -> Natural -> BV w
BV.rotateR (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv (forall (w :: Natural). BV w -> Natural
BV.asNatural BV w
n)
| Just BV w
n <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y
, BV w
n forall (w :: Natural). BV w -> BV w -> BV w
`BV.urem` forall (w :: Natural). NatRepr w -> BV w
BV.width (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
y) forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
y)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
| Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, forall a. (Bits a, Num a) => a -> Bool
isPow2 (forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
= do Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
y
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRor ExprBuilder t st fs
sym Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z
| Just (BVRor NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
= do Expr t (BaseBVType w)
wbv <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
Expr t (BaseBVType w)
n' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym Expr t ('BaseBVType w)
n Expr t (BaseBVType w)
wbv
Expr t (BaseBVType w)
y' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y Expr t (BaseBVType w)
wbv
Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t (BaseBVType w)
n' Expr t (BaseBVType w)
y'
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRor ExprBuilder t st fs
sym Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z
| Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, forall a. (Bits a, Num a) => a -> Bool
isPow2 (forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
= do Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym Expr t ('BaseBVType w)
n SymBV (ExprBuilder t st fs) w
y
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRol ExprBuilder t st fs
sym Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z
| Just (BVRol NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
= do Expr t (BaseBVType w)
wbv <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.width NatRepr w
w)
Expr t (BaseBVType w)
n' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym Expr t ('BaseBVType w)
n Expr t (BaseBVType w)
wbv
Expr t (BaseBVType w)
y' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y Expr t (BaseBVType w)
wbv
Expr t (BaseBVType w)
z <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym Expr t (BaseBVType w)
n' forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvSub ExprBuilder t st fs
sym Expr t (BaseBVType w)
wbv Expr t (BaseBVType w)
y'
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvRol ExprBuilder t st fs
sym Expr t ('BaseBVType w)
x' Expr t (BaseBVType w)
z
| Bool
otherwise
= let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x in
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVRor NatRepr w
w SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvZext :: forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
bvZext ExprBuilder t st fs
sym NatRepr r
w SymBV (ExprBuilder t st fs) u
x
| Just BV u
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) u
x = do
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr r
w (forall (w :: Natural) (w' :: Natural).
((w + 1) <= w') =>
NatRepr w' -> BV w -> BV w'
BV.zext NatRepr r
w BV u
xv)
| Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x = do
Just LeqProof (w + 1) r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y)) NatRepr r
w
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
w
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (r :: Natural) (e :: BaseType -> Type).
(1 <= w, (w + 1) <= r, 1 <= r) =>
NatRepr r -> e (BaseBVType w) -> App e ('BaseBVType r)
BVZext NatRepr r
w Expr t (BaseBVType w)
y
| Just (BVUnaryTerm UnaryBV (Expr t 'BaseBoolType) n
u) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x = do
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (u :: Natural) (r :: Natural) p.
(1 <= u, (u + 1) <= r) =>
UnaryBV p u -> NatRepr r -> UnaryBV p r
UnaryBV.uext UnaryBV (Expr t 'BaseBoolType) n
u NatRepr r
w
| Bool
otherwise = do
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
w
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (r :: Natural) (e :: BaseType -> Type).
(1 <= w, (w + 1) <= r, 1 <= r) =>
NatRepr r -> e (BaseBVType w) -> App e ('BaseBVType r)
BVZext NatRepr r
w SymBV (ExprBuilder t st fs) u
x
bvSext :: forall (u :: Natural) (r :: Natural).
(1 <= u, (u + 1) <= r) =>
ExprBuilder t st fs
-> NatRepr r
-> SymBV (ExprBuilder t st fs) u
-> IO (SymBV (ExprBuilder t st fs) r)
bvSext ExprBuilder t st fs
sym NatRepr r
w SymBV (ExprBuilder t st fs) u
x
| Just BV u
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) u
x = do
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr r
w (forall (w :: Natural) (w' :: Natural).
(1 <= w, (w + 1) <= w') =>
NatRepr w -> NatRepr w' -> BV w -> BV w'
BV.sext (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) u
x) NatRepr r
w BV u
xv)
| Just (BVSext NatRepr r
_ Expr t (BaseBVType w)
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x = do
Just LeqProof (w + 1) r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). NatRepr n -> NatRepr (n + 1)
incNat (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
y)) NatRepr r
w
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
w
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (r :: Natural) (e :: BaseType -> Type).
(1 <= w, (w + 1) <= r, 1 <= r) =>
NatRepr r -> e (BaseBVType w) -> App e ('BaseBVType r)
BVSext NatRepr r
w Expr t (BaseBVType w)
y)
| Just (BVUnaryTerm UnaryBV (Expr t 'BaseBoolType) n
u) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) u
x = do
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat NatRepr r
w
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
ExprBuilder t st fs -> UnaryBV (BoolExpr t) w -> IO (BVExpr t w)
bvUnary ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (u :: Natural) (r :: Natural) p.
(1 <= u, (u + 1) <= r) =>
UnaryBV p u -> NatRepr r -> UnaryBV p r
UnaryBV.sext UnaryBV (Expr t 'BaseBoolType) n
u NatRepr r
w
| Bool
otherwise = do
Just LeqProof 1 r
LeqProof <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat :: NatRepr 1) NatRepr r
w
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (r :: Natural) (e :: BaseType -> Type).
(1 <= w, (w + 1) <= r, 1 <= r) =>
NatRepr r -> e (BaseBVType w) -> App e ('BaseBVType r)
BVSext NatRepr r
w SymBV (ExprBuilder t st fs) u
x)
bvXorBits :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvXorBits ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| SymBV (ExprBuilder t st fs) w
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x))
| Bool
otherwise
= let sr :: SemiRingRepr ('SemiRingBV 'BVBits w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
in forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVBits w)
sr SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvAndBits :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvAndBits ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| SymBV (ExprBuilder t st fs) w
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
| Just (BVOrBits NatRepr w
_ BVOrSet (Expr t) w
bs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, forall (e :: BaseType -> Type) (w :: Natural).
OrdF e =>
e (BaseBVType w) -> BVOrSet e w -> Bool
bvOrContains SymBV (ExprBuilder t st fs) w
y BVOrSet (Expr t) w
bs
= forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
y
| Just (BVOrBits NatRepr w
_ BVOrSet (Expr t) w
bs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
, forall (e :: BaseType -> Type) (w :: Natural).
OrdF e =>
e (BaseBVType w) -> BVOrSet e w -> Bool
bvOrContains SymBV (ExprBuilder t st fs) w
x BVOrSet (Expr t) w
bs
= forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
| Bool
otherwise
= let sr :: SemiRingRepr ('SemiRingBV 'BVBits w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
in forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVBits w)
sr SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvNotBits :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvNotBits ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall a b. (a -> b) -> a -> b
$ BV w
xv forall (w :: Natural). BV w -> BV w -> BV w
`BV.xor` (forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x))
| Bool
otherwise
= let sr :: SemiRingRepr ('SemiRingBV 'BVBits w)
sr = (forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVBits
SR.BVBitsRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x))
in forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> WeightedSum (Expr t) sr -> IO (Expr t (SemiRingBase sr))
semiRingSum ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) (f :: BaseType -> Type).
SemiRingRepr sr
-> WeightedSum f sr -> Coefficient sr -> WeightedSum f sr
WSum.addConstant SemiRingRepr ('SemiRingBV 'BVBits w)
sr (forall t (sr :: SemiRing).
HashableF (Expr t) =>
SemiRingRepr sr
-> Expr t (SemiRingBase sr) -> WeightedSum (Expr t) sr
asWeightedSum SemiRingRepr ('SemiRingBV 'BVBits w)
sr SymBV (ExprBuilder t st fs) w
x) (forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x))
bvOrBits :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvOrBits ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y =
case (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x, forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
y) of
(Just BV w
xv, Just BV w
yv) -> forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (BV w
xv forall (w :: Natural). BV w -> BV w -> BV w
`BV.or` BV w
yv)
(Just BV w
xv , Maybe (BV w)
_)
| BV w
xv forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
y
| BV w
xv forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
(Maybe (BV w)
_, Just BV w
yv)
| BV w
yv forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.zero (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
y) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
| BV w
yv forall a. Eq a => a -> a -> Bool
== forall (w :: Natural). NatRepr w -> BV w
BV.maxUnsigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
y
(Maybe (BV w), Maybe (BV w))
_
| SymBV (ExprBuilder t st fs) w
x forall a. Eq a => a -> a -> Bool
== SymBV (ExprBuilder t st fs) w
y
-> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
| Just (SemiRingProd SemiRingProduct (Expr t) sr
xs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVBitsRepr NatRepr w
_w <- forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
xs
, forall (f :: BaseType -> Type) (sr :: SemiRing).
OrdF f =>
SemiRingProduct f sr -> f (SemiRingBase sr) -> Bool
WSum.prodContains SemiRingProduct (Expr t) sr
xs SymBV (ExprBuilder t st fs) w
y
-> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
y
| Just (SemiRingProd SemiRingProduct (Expr t) sr
ys) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
, SR.SemiRingBVRepr BVFlavorRepr fv
SR.BVBitsRepr NatRepr w
_w <- forall (f :: BaseType -> Type) (sr :: SemiRing).
SemiRingProduct f sr -> SemiRingRepr sr
WSum.prodRepr SemiRingProduct (Expr t) sr
ys
, forall (f :: BaseType -> Type) (sr :: SemiRing).
OrdF f =>
SemiRingProduct f sr -> f (SemiRingBase sr) -> Bool
WSum.prodContains SemiRingProduct (Expr t) sr
ys SymBV (ExprBuilder t st fs) w
x
-> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
| Just (BVOrBits NatRepr w
w BVOrSet (Expr t) w
xs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just (BVOrBits NatRepr w
_ BVOrSet (Expr t) w
ys) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
-> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits NatRepr w
w forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (w :: Natural).
OrdF e =>
BVOrSet e w -> BVOrSet e w -> BVOrSet e w
bvOrUnion BVOrSet (Expr t) w
xs BVOrSet (Expr t) w
ys
| Just (BVOrBits NatRepr w
w BVOrSet (Expr t) w
xs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
-> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits NatRepr w
w forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert SymBV (ExprBuilder t st fs) w
y BVOrSet (Expr t) w
xs
| Just (BVOrBits NatRepr w
w BVOrSet (Expr t) w
ys) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
-> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits NatRepr w
w forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert SymBV (ExprBuilder t st fs) w
x BVOrSet (Expr t) w
ys
| Just (BVShl NatRepr w
w Expr t ('BaseBVType w)
x' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
lo) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
, Just Integer
ni <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
n
, forall (w :: Natural). NatRepr w -> Integer
intValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) forall a. Eq a => a -> a -> Bool
== Integer
ni
, Just LeqProof w w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) NatRepr w
w
, NatRepr (w - w)
w' <- forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr w
w (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo)
, Just LeqProof 1 (w - w)
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) NatRepr (w - w)
w'
, Just LeqProof ((w - w) + 1) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
w' (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1)) NatRepr w
w
, Just w :~: ((w - w) + w)
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
w' (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo))
-> do
Expr t (BaseBVType (w - w))
hi <- forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc ExprBuilder t st fs
sym NatRepr (w - w)
w' Expr t ('BaseBVType w)
x'
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym Expr t (BaseBVType (w - w))
hi Expr t (BaseBVType w)
lo
| Just (BVShl NatRepr w
w Expr t ('BaseBVType w)
y' Expr t ('BaseBVType w)
n) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
y
, Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
lo) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, Just Integer
ni <- forall (w :: Natural). BV w -> Integer
BV.asUnsigned forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t ('BaseBVType w)
n
, forall (w :: Natural). NatRepr w -> Integer
intValue (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) forall a. Eq a => a -> a -> Bool
== Integer
ni
, Just LeqProof w w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo) NatRepr w
w
, NatRepr (w - w)
w' <- forall (n :: Natural) (m :: Natural).
(n <= m) =>
NatRepr m -> NatRepr n -> NatRepr (m - n)
subNat NatRepr w
w (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo)
, Just LeqProof 1 (w - w)
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) NatRepr (w - w)
w'
, Just LeqProof ((w - w) + 1) w
LeqProof <- forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> Maybe (LeqProof m n)
testLeq (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
w' (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1)) NatRepr w
w
, Just w :~: ((w - w) + w)
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality NatRepr w
w (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr (w - w)
w' (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
lo))
-> do
Expr t (BaseBVType (w - w))
hi <- forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc ExprBuilder t st fs
sym NatRepr (w - w)
w' Expr t ('BaseBVType w)
y'
forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st fs
sym Expr t (BaseBVType (w - w))
hi Expr t (BaseBVType w)
lo
| Bool
otherwise
-> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> BVOrSet e w -> App e ('BaseBVType w)
BVOrBits (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w -> BVOrSet e w
bvOrInsert SymBV (ExprBuilder t st fs) w
x forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (w :: Natural).
(OrdF e, HashableF e, HasAbsValue e) =>
e (BaseBVType w) -> BVOrSet e w
bvOrSingleton SymBV (ExprBuilder t st fs) w
y
bvAdd :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVArith w)
sr SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
where sr :: SemiRingRepr ('SemiRingBV 'BVArith w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
bvMul :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvMul ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVArith w)
sr SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
where sr :: SemiRingRepr ('SemiRingBV 'BVArith w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
bvNeg :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvNeg ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.negate (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv)
| Bool
otherwise =
do Integer
ut <- forall (tp :: BaseType) a. Opt tp a => OptionSetting tp -> IO a
CFG.getOpt (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> OptionSetting BaseIntegerType
sbUnaryThreshold ExprBuilder t st fs
sym)
let ?unaryThreshold = forall a. Num a => Integer -> a
fromInteger Integer
ut
forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w, ?unaryThreshold::Int) =>
ExprBuilder t st fs
-> Maybe (IO (UnaryBV (BoolExpr t) w))
-> IO (BVExpr t w)
-> IO (BVExpr t w)
sbTryUnaryTerm ExprBuilder t st fs
sym
(do UnaryBV (Expr t 'BaseBoolType) w
ux <- forall t (st :: Type -> Type) fs (n :: Natural).
(?unaryThreshold::Int) =>
ExprBuilder t st fs -> BVExpr t n -> Maybe (UnaryBV (BoolExpr t) n)
asUnaryBV ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
forall a. a -> Maybe a
Just (forall sym (n :: Natural).
(1 <= n, IsExprBuilder sym) =>
sym -> UnaryBV (Pred sym) n -> IO (UnaryBV (Pred sym) n)
UnaryBV.neg ExprBuilder t st fs
sym UnaryBV (Expr t 'BaseBoolType) w
ux))
(do let sr :: SemiRingRepr ('SemiRingBV 'BVArith w)
sr = forall (w :: Natural) (fv :: BVFlavor).
(1 <= w) =>
BVFlavorRepr fv -> NatRepr w -> SemiRingRepr ('SemiRingBV fv w)
SR.SemiRingBVRepr BVFlavorRepr 'BVArith
SR.BVArithRepr (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x)
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr ('SemiRingBV 'BVArith w)
sr (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) (-Integer
1)) SymBV (ExprBuilder t st fs) w
x)
bvIsNonzero :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w -> IO (Pred (ExprBuilder t st fs))
bvIsNonzero ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
| Just (BaseIte BaseTypeRepr (BaseBVType w)
_ Integer
_ Expr t 'BaseBoolType
p Expr t (BaseBVType w)
t Expr t (BaseBVType w)
f) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
t) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType w)
f)
= do Expr t 'BaseBoolType
t' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType w)
t
Expr t 'BaseBoolType
f' <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType w)
f
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym Expr t 'BaseBoolType
p Expr t 'BaseBoolType
t' Expr t 'BaseBoolType
f'
| Just (BVConcat NatRepr (u + v)
_ Expr t (BaseBVType u)
a Expr t (BaseBVType v)
b) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x
, forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType u)
a) Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV Expr t (BaseBVType v)
b)
= do Expr t 'BaseBoolType
pa <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType u)
a
Expr t 'BaseBoolType
pb <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType v)
b
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
orPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
pa Expr t 'BaseBoolType
pb
| Just (BVZext NatRepr r
_ Expr t (BaseBVType w)
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType w)
y
| Just (BVSext NatRepr r
_ Expr t (BaseBVType w)
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (Pred sym)
bvIsNonzero ExprBuilder t st fs
sym Expr t (BaseBVType w)
y
| Just (BVFill NatRepr w
_ Expr t 'BaseBoolType
p) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t 'BaseBoolType
p
| Just (BVUnaryTerm UnaryBV (Expr t 'BaseBoolType) n
ubv) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
forall (m :: Type -> Type) r p (n :: Natural).
(Applicative m, Monad m) =>
(Integer -> m r) -> (p -> r -> r -> m r) -> UnaryBV p n -> m r
UnaryBV.sym_evaluate
(\Integer
i -> forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (Integer
iforall a. Eq a => a -> a -> Bool
/=Integer
0))
(forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> Pred sym -> IO (Pred sym)
itePred ExprBuilder t st fs
sym)
UnaryBV (Expr t 'BaseBoolType) n
ubv
| Bool
otherwise = do
let w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x
Expr t (BaseBVType w)
zro <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w)
forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (Pred sym)
bvEq ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x Expr t (BaseBVType w)
zro
bvUdiv :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvUdiv = forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp (forall a b. a -> b -> a
const forall (w :: Natural). BV w -> BV w -> BV w
BV.uquot) forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVUdiv
bvUrem :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
| Just Bool
True <- forall (w :: Natural).
(1 <= w) =>
BVDomain w -> BVDomain w -> Maybe Bool
BVD.ult (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymBV (ExprBuilder t st fs) w
y) = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymBV (ExprBuilder t st fs) w
x
| Bool
otherwise = forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp (forall a b. a -> b -> a
const forall (w :: Natural). BV w -> BV w -> BV w
BV.urem) forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVUrem ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x SymBV (ExprBuilder t st fs) w
y
bvSdiv :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvSdiv = forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> BV w -> BV w
BV.squot forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVSdiv
bvSrem :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvSrem = forall (w :: Natural) t (st :: Type -> Type) fs.
(1 <= w) =>
(NatRepr w -> BV w -> BV w -> BV w)
-> (NatRepr w
-> BVExpr t w -> BVExpr t w -> App (Expr t) (BaseBVType w))
-> ExprBuilder t st fs
-> BVExpr t w
-> BVExpr t w
-> IO (BVExpr t w)
bvBinDivOp forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BV w -> BV w -> BV w
BV.srem forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> e (BaseBVType w) -> e (BaseBVType w) -> App e (BaseBVType w)
BVSrem
bvPopcount :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvPopcount ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). BV w -> BV w
BV.popCount BV w
xv)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e (BaseBVType w) -> App e (BaseBVType w)
BVPopcount NatRepr w
w SymBV (ExprBuilder t st fs) w
x
where w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x
bvCountTrailingZeros :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvCountTrailingZeros ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.ctz NatRepr w
w BV w
xv)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e (BaseBVType w) -> App e (BaseBVType w)
BVCountTrailingZeros NatRepr w
w SymBV (ExprBuilder t st fs) w
x
where w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x
bvCountLeadingZeros :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymBV (ExprBuilder t st fs) w)
bvCountLeadingZeros ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w -> BV w
BV.clz NatRepr w
w BV w
xv)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e (BaseBVType w) -> App e (BaseBVType w)
BVCountLeadingZeros NatRepr w
w SymBV (ExprBuilder t st fs) w
x
where w :: NatRepr w
w = forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x
mkStruct :: forall (flds :: Ctx BaseType).
ExprBuilder t st fs
-> Assignment (SymExpr (ExprBuilder t st fs)) flds
-> IO (SymStruct (ExprBuilder t st fs) flds)
mkStruct ExprBuilder t st fs
sym Assignment (SymExpr (ExprBuilder t st fs)) flds
args = do
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (flds :: Ctx BaseType) (e :: BaseType -> Type).
Assignment BaseTypeRepr flds
-> Assignment e flds -> App e ('BaseStructType flds)
StructCtor (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr (ExprBuilder t st fs)) flds
args) Assignment (SymExpr (ExprBuilder t st fs)) flds
args
structField :: forall (flds :: Ctx BaseType) (tp :: BaseType).
ExprBuilder t st fs
-> SymStruct (ExprBuilder t st fs) flds
-> Index flds tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
structField ExprBuilder t st fs
sym SymStruct (ExprBuilder t st fs) flds
s Index flds tp
i
| Just (StructCtor Assignment BaseTypeRepr flds
_ Assignment (Expr t) flds
args) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymStruct (ExprBuilder t st fs) flds
s = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Assignment (Expr t) flds
args forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index flds tp
i
| Bool
otherwise = do
case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymStruct (ExprBuilder t st fs) flds
s of
BaseStructRepr Assignment BaseTypeRepr ctx
flds ->
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (flds :: Ctx BaseType)
(tp :: BaseType).
e (BaseStructType flds)
-> Index flds tp -> BaseTypeRepr tp -> App e tp
StructField SymStruct (ExprBuilder t st fs) flds
s Index flds tp
i (Assignment BaseTypeRepr ctx
flds forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f ctx -> Index ctx tp -> f tp
Ctx.! Index flds tp
i)
structIte :: forall (flds :: Ctx BaseType).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymStruct (ExprBuilder t st fs) flds
-> SymStruct (ExprBuilder t st fs) flds
-> IO (SymStruct (ExprBuilder t st fs) flds)
structIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p SymStruct (ExprBuilder t st fs) flds
x SymStruct (ExprBuilder t st fs) flds
y
| Just Bool
True <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymStruct (ExprBuilder t st fs) flds
x
| Just Bool
False <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymStruct (ExprBuilder t st fs) flds
y
| SymStruct (ExprBuilder t st fs) flds
x forall a. Eq a => a -> a -> Bool
== SymStruct (ExprBuilder t st fs) flds
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return SymStruct (ExprBuilder t st fs) flds
x
| Bool
otherwise = forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t 'BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p SymStruct (ExprBuilder t st fs) flds
x SymStruct (ExprBuilder t st fs) flds
y
stringEmpty :: forall (si :: StringInfo).
ExprBuilder t st fs
-> StringInfoRepr si -> IO (SymString (ExprBuilder t st fs) si)
stringEmpty ExprBuilder t st fs
sym StringInfoRepr si
si = forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> StringLiteral si -> IO (SymString sym si)
stringLit ExprBuilder t st fs
sym (forall (si :: StringInfo). StringInfoRepr si -> StringLiteral si
stringLitEmpty StringInfoRepr si
si)
stringLit :: forall (si :: StringInfo).
ExprBuilder t st fs
-> StringLiteral si -> IO (SymString (ExprBuilder t st fs) si)
stringLit ExprBuilder t st fs
sym StringLiteral si
s =
do ProgramLoc
l <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (si :: StringInfo) t.
StringLiteral si -> ProgramLoc -> Expr t ('BaseStringType si)
StringExpr StringLiteral si
s ProgramLoc
l
stringEq :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (Pred (ExprBuilder t st fs))
stringEq ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
, Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality StringLiteral si
x' StringLiteral si
y'))
stringEq ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (si :: StringInfo).
StringInfoRepr si -> BaseTypeRepr ('BaseStringType si)
BaseStringRepr (forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> StringInfoRepr si
stringInfo SymString (ExprBuilder t st fs) si
x)) SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
stringIte :: forall (si :: StringInfo).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (SymString (ExprBuilder t st fs) si)
stringIte ExprBuilder t st fs
_sym Pred (ExprBuilder t st fs)
c SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
| Just Bool
c' <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
c
= if Bool
c' then forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
x else forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
y
stringIte ExprBuilder t st fs
_sym Pred (ExprBuilder t st fs)
_c SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
, Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
, forall a. Maybe a -> Bool
isJust (forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality StringLiteral si
x' StringLiteral si
y')
= forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
x
stringIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
= forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t 'BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
stringIndexOf :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> SymInteger (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
stringIndexOf ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y SymInteger (ExprBuilder t st fs)
k
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
, Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
, Just Integer
k' <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
k
= forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Integer -> Integer
stringLitIndexOf StringLiteral si
x' StringLiteral si
y' Integer
k'
stringIndexOf ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y SymInteger (ExprBuilder t st fs)
k
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si)
-> e BaseIntegerType
-> App e BaseIntegerType
StringIndexOf SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y SymInteger (ExprBuilder t st fs)
k
stringContains :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (Pred (ExprBuilder t st fs))
stringContains ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
, Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Bool
stringLitContains StringLiteral si
x' StringLiteral si
y')
| Just Bool
b <- StringAbstractValue -> StringAbstractValue -> Maybe Bool
stringAbsContains (forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
x) (forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
y)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| Bool
otherwise
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si) -> App e 'BaseBoolType
StringContains SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
stringIsPrefixOf :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (Pred (ExprBuilder t st fs))
stringIsPrefixOf ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
, Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Bool
stringLitIsPrefixOf StringLiteral si
x' StringLiteral si
y')
| Just Bool
b <- StringAbstractValue -> StringAbstractValue -> Maybe Bool
stringAbsIsPrefixOf (forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
x) (forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
y)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| Bool
otherwise
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si) -> App e 'BaseBoolType
StringIsPrefixOf SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
stringIsSuffixOf :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (Pred (ExprBuilder t st fs))
stringIsSuffixOf ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
, Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym (forall (si :: StringInfo).
StringLiteral si -> StringLiteral si -> Bool
stringLitIsSuffixOf StringLiteral si
x' StringLiteral si
y')
| Just Bool
b <- StringAbstractValue -> StringAbstractValue -> Maybe Bool
stringAbsIsSuffixOf (forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
x) (forall (f :: BaseType -> Type) (tp :: BaseType).
HasAbsValue f =>
f tp -> AbstractValue tp
getAbsValue SymString (ExprBuilder t st fs) si
y)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| Bool
otherwise
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si)
-> e (BaseStringType si) -> App e 'BaseBoolType
StringIsSuffixOf SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
stringSubstring :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymInteger (ExprBuilder t st fs)
-> SymInteger (ExprBuilder t st fs)
-> IO (SymString (ExprBuilder t st fs) si)
stringSubstring ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymInteger (ExprBuilder t st fs)
off SymInteger (ExprBuilder t st fs)
len
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
, Just Integer
off' <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
off
, Just Integer
len' <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseIntegerType -> Maybe Integer
asInteger SymInteger (ExprBuilder t st fs)
len
= forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> StringLiteral si -> IO (SymString sym si)
stringLit ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! forall (si :: StringInfo).
StringLiteral si -> Integer -> Integer -> StringLiteral si
stringLitSubstring StringLiteral si
x' Integer
off' Integer
len'
| Bool
otherwise
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si
-> e (BaseStringType si)
-> e BaseIntegerType
-> e BaseIntegerType
-> App e (BaseStringType si)
StringSubstring (forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> StringInfoRepr si
stringInfo SymString (ExprBuilder t st fs) si
x) SymString (ExprBuilder t st fs) si
x SymInteger (ExprBuilder t st fs)
off SymInteger (ExprBuilder t st fs)
len
stringConcat :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> SymString (ExprBuilder t st fs) si
-> IO (SymString (ExprBuilder t st fs) si)
stringConcat ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x SymString (ExprBuilder t st fs) si
y
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x, forall (si :: StringInfo). StringLiteral si -> Bool
stringLitNull StringLiteral si
x'
= forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
y
| Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y, forall (si :: StringInfo). StringLiteral si -> Bool
stringLitNull StringLiteral si
y'
= forall (m :: Type -> Type) a. Monad m => a -> m a
return SymString (ExprBuilder t st fs) si
x
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
, Just StringLiteral si
y' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
y
= forall sym (si :: StringInfo).
IsExprBuilder sym =>
sym -> StringLiteral si -> IO (SymString sym si)
stringLit ExprBuilder t st fs
sym (StringLiteral si
x' forall a. Semigroup a => a -> a -> a
<> StringLiteral si
y')
| Just (StringAppend StringInfoRepr si
si StringSeq (Expr t) si
xs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
x
, Just (StringAppend StringInfoRepr si
_ StringSeq (Expr t) si
ys) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
y
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
si (forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringSeq e si -> StringSeq e si
SSeq.append StringSeq (Expr t) si
xs StringSeq (Expr t) si
ys)
| Just (StringAppend StringInfoRepr si
si StringSeq (Expr t) si
xs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
x
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
si (forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringSeq e si -> StringSeq e si
SSeq.append StringSeq (Expr t) si
xs (forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e, IsExpr e) =>
StringInfoRepr si -> e (BaseStringType si) -> StringSeq e si
SSeq.singleton StringInfoRepr si
si SymString (ExprBuilder t st fs) si
y))
| Just (StringAppend StringInfoRepr si
si StringSeq (Expr t) si
ys) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
y
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
si (forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringSeq e si -> StringSeq e si
SSeq.append (forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e, IsExpr e) =>
StringInfoRepr si -> e (BaseStringType si) -> StringSeq e si
SSeq.singleton StringInfoRepr si
si SymString (ExprBuilder t st fs) si
x) StringSeq (Expr t) si
ys)
| Bool
otherwise
= let si :: StringInfoRepr si
si = forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> StringInfoRepr si
stringInfo SymString (ExprBuilder t st fs) si
x in
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (si :: StringInfo) (e :: BaseType -> Type).
StringInfoRepr si -> StringSeq e si -> App e ('BaseStringType si)
StringAppend StringInfoRepr si
si (forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e) =>
StringSeq e si -> StringSeq e si -> StringSeq e si
SSeq.append (forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e, IsExpr e) =>
StringInfoRepr si -> e (BaseStringType si) -> StringSeq e si
SSeq.singleton StringInfoRepr si
si SymString (ExprBuilder t st fs) si
x) (forall (e :: BaseType -> Type) (si :: StringInfo).
(HasAbsValue e, HashableF e, IsExpr e) =>
StringInfoRepr si -> e (BaseStringType si) -> StringSeq e si
SSeq.singleton StringInfoRepr si
si SymString (ExprBuilder t st fs) si
y))
stringLength :: forall (si :: StringInfo).
ExprBuilder t st fs
-> SymString (ExprBuilder t st fs) si
-> IO (SymInteger (ExprBuilder t st fs))
stringLength ExprBuilder t st fs
sym SymString (ExprBuilder t st fs) si
x
| Just StringLiteral si
x' <- forall (e :: BaseType -> Type) (si :: StringInfo).
IsExpr e =>
e (BaseStringType si) -> Maybe (StringLiteral si)
asString SymString (ExprBuilder t st fs) si
x
= forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall (si :: StringInfo). StringLiteral si -> Integer
stringLitLength StringLiteral si
x')
| Just (StringAppend StringInfoRepr si
_si StringSeq (Expr t) si
xs) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymString (ExprBuilder t st fs) si
x
= do let f :: IntegerExpr t -> StringSeqEntry (Expr t) si -> IO (IntegerExpr t)
f IntegerExpr t
sm (SSeq.StringSeqLiteral StringLiteral si
l) = forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intAdd ExprBuilder t st fs
sym IntegerExpr t
sm forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall (si :: StringInfo). StringLiteral si -> Integer
stringLitLength StringLiteral si
l)
f IntegerExpr t
sm (SSeq.StringSeqTerm Expr t ('BaseStringType si)
t) = forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intAdd ExprBuilder t st fs
sym IntegerExpr t
sm forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si) -> App e BaseIntegerType
StringLength Expr t ('BaseStringType si)
t)
IntegerExpr t
z <- forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym Integer
0
forall (t :: Type -> Type) (m :: Type -> Type) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM IntegerExpr t -> StringSeqEntry (Expr t) si -> IO (IntegerExpr t)
f IntegerExpr t
z (forall (e :: BaseType -> Type) (si :: StringInfo).
StringSeq e si -> [StringSeqEntry e si]
SSeq.toList StringSeq (Expr t) si
xs)
| Bool
otherwise
= forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (si :: StringInfo).
e (BaseStringType si) -> App e BaseIntegerType
StringLength SymString (ExprBuilder t st fs) si
x
constantArray :: forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> Assignment BaseTypeRepr (idx ::> tp)
-> SymExpr (ExprBuilder t st fs) b
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) b)
constantArray ExprBuilder t st fs
sym Assignment BaseTypeRepr (idx ::> tp)
idxRepr SymExpr (ExprBuilder t st fs) b
v =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (i :: Ctx BaseType) (tp1 :: BaseType) (b :: BaseType)
(e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> tp1)
-> BaseTypeRepr b -> e b -> App e ('BaseArrayType (i ::> tp1) b)
ConstantArray Assignment BaseTypeRepr (idx ::> tp)
idxRepr (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) b
v) SymExpr (ExprBuilder t st fs) b
v
arrayFromFn :: forall (idx :: Ctx BaseType) (itp :: BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) ret
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) ret)
arrayFromFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (idx ::> itp) ret
fn = do
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall t (idx :: Ctx BaseType) (itp :: BaseType) (ret :: BaseType)
(e :: BaseType -> Type).
ExprSymFn t (idx ::> itp) ret
-> NonceApp t e ('BaseArrayType (idx ::> itp) ret)
ArrayFromFn SymFn (ExprBuilder t st fs) (idx ::> itp) ret
fn
arrayMap :: forall (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
(idx :: Ctx BaseType) (itp :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (ctx ::> d) r
-> Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) r)
arrayMap ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
f Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arrays
| Just MatlabSolverFn (Expr t) (ctx ::> d) r
IntegerToRealFn <- forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn SymFn (ExprBuilder t st fs) (ctx ::> d) r
f
, Just (MapOverArrays ExprSymFn t (ctx ::> d) r
g Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arraysforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1))
, Just MatlabSolverFn (Expr t) (ctx ::> d) r
RealToIntegerFn <- forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn ExprSymFn t (ctx ::> d) r
g =
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
argsforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1)
| Just MatlabSolverFn (Expr t) (ctx ::> d) r
RealToIntegerFn <- forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn SymFn (ExprBuilder t st fs) (ctx ::> d) r
f
, Just (MapOverArrays ExprSymFn t (ctx ::> d) r
g Assignment BaseTypeRepr (idx ::> itp)
_ Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
args) <- forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arraysforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1))
, Just MatlabSolverFn (Expr t) (ctx ::> d) r
IntegerToRealFn <- forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn ExprSymFn t (ctx ::> d) r
g =
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (Assignment (ArrayResultWrapper (Expr t) (idx ::> itp)) (ctx ::> d)
argsforall s a. s -> Getting a s a -> a
^.forall s t a b. Field1 s t a b => Lens s t a b
_1)
| Set (Assignment IndexLit (idx ::> itp))
s <- forall t (i :: Ctx BaseType) (ctx :: Ctx BaseType).
Assignment (ArrayResultWrapper (Expr t) i) ctx
-> Set (Assignment IndexLit i)
concreteArrayEntries Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arrays
, Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set (Assignment IndexLit (idx ::> itp))
s) = do
Expr t (BaseArrayType (idx ::> itp) r)
base <- forall sym (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
(idx :: Ctx BaseType) (itp :: BaseType).
IsExprBuilder sym =>
sym
-> SymFn sym (ctx ::> d) r
-> Assignment
(ArrayResultWrapper (SymExpr sym) (idx ::> itp)) (ctx ::> d)
-> IO (SymArray sym (idx ::> itp) r)
arrayMap ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
f (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC forall t (i :: Ctx BaseType) (tp :: BaseType).
ArrayResultWrapper (Expr t) i tp
-> ArrayResultWrapper (Expr t) i tp
underlyingArrayMapExpr Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arrays)
BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
ret <- forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t (BaseArrayType (idx ::> itp) r)
base)
let evalArgs :: Ctx.Assignment IndexLit (idx ::> itp)
-> Ctx.Assignment (Expr t) (idx ::> itp)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
-> IO (Expr t d)
evalArgs :: forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
Assignment IndexLit (idx ::> itp)
-> Assignment (Expr t) (idx ::> itp)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
-> IO (Expr t d)
evalArgs Assignment IndexLit (idx ::> itp)
const_idx Assignment (Expr t) (idx ::> itp)
sym_idx ArrayResultWrapper (Expr t) (idx ::> itp) d
a = do
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) (idx ::> itp) d
a) (forall a. a -> Maybe a
Just Assignment IndexLit (idx ::> itp)
const_idx) Assignment (Expr t) (idx ::> itp)
sym_idx
let evalIndex :: ExprSymFn t ctx ret
-> Ctx.Assignment (ArrayResultWrapper (Expr t) (i::>itp)) ctx
-> Ctx.Assignment IndexLit (i::>itp)
-> IO (Expr t ret)
evalIndex :: forall (ctx :: Ctx BaseType) (ret :: BaseType) (i :: Ctx BaseType)
(itp :: BaseType).
ExprSymFn t ctx ret
-> Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
-> Assignment IndexLit (i ::> itp)
-> IO (Expr t ret)
evalIndex ExprSymFn t ctx ret
g Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
arrays0 Assignment IndexLit (i ::> itp)
const_idx = do
Assignment (Expr t) (i ::> itp)
sym_idx <- forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC (forall sym (idx :: BaseType).
IsExprBuilder sym =>
sym -> IndexLit idx -> IO (SymExpr sym idx)
indexLit ExprBuilder t st fs
sym) Assignment IndexLit (i ::> itp)
const_idx
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t st fs
sym ExprSymFn t ctx ret
g forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC (forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
Assignment IndexLit (idx ::> itp)
-> Assignment (Expr t) (idx ::> itp)
-> ArrayResultWrapper (Expr t) (idx ::> itp) d
-> IO (Expr t d)
evalArgs Assignment IndexLit (i ::> itp)
const_idx Assignment (Expr t) (i ::> itp)
sym_idx) Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
arrays0
ArrayUpdateMap (Expr t) (idx ::> itp) xs
m <- forall (e :: BaseType -> Type) (tp :: BaseType)
(ctx :: Ctx BaseType).
(HasAbsValue e, HashableF e) =>
BaseTypeRepr tp
-> [(Assignment IndexLit ctx, e tp)] -> ArrayUpdateMap e ctx tp
AUM.fromAscList BaseTypeRepr xs
ret forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Assignment IndexLit (idx ::> itp)
k -> (Assignment IndexLit (idx ::> itp)
k,) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (ctx :: Ctx BaseType) (ret :: BaseType) (i :: Ctx BaseType)
(itp :: BaseType).
ExprSymFn t ctx ret
-> Assignment (ArrayResultWrapper (Expr t) (i ::> itp)) ctx
-> Assignment IndexLit (i ::> itp)
-> IO (Expr t ret)
evalIndex SymFn (ExprBuilder t st fs) (ctx ::> d) r
f Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arrays Assignment IndexLit (idx ::> itp)
k) (forall a. Set a -> [a]
Set.toAscList Set (Assignment IndexLit (idx ::> itp))
s)
forall sym (idx :: Ctx BaseType) (itp :: BaseType)
(tp :: BaseType).
IsExprBuilder sym =>
sym
-> ArrayUpdateMap (SymExpr sym) (idx ::> itp) tp
-> SymArray sym (idx ::> itp) tp
-> IO (SymArray sym (idx ::> itp) tp)
arrayUpdateAtIdxLits ExprBuilder t st fs
sym ArrayUpdateMap (Expr t) (idx ::> itp) xs
m Expr t (BaseArrayType (idx ::> itp) r)
base
| Just Assignment (Expr t) (ctx ::> d)
cns <- forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC (\ArrayResultWrapper (Expr t) (idx ::> itp) x
a -> forall (e :: BaseType -> Type) (idx :: Ctx BaseType)
(bt :: BaseType).
IsExpr e =>
e (BaseArrayType idx bt) -> Maybe (e bt)
asConstantArray (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult ArrayResultWrapper (Expr t) (idx ::> itp) x
a)) Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arrays = do
Expr t r
r <- forall t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
ExprBuilder t st fs
-> ExprSymFn t args ret
-> Assignment (Expr t) args
-> IO (Expr t ret)
betaReduce ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (ctx ::> d) r
f Assignment (Expr t) (ctx ::> d)
cns
case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arrays)) of
BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idxRepr BaseTypeRepr xs
_ -> do
forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> Assignment BaseTypeRepr (idx ::> tp)
-> SymExpr sym b
-> IO (SymArray sym (idx ::> tp) b)
constantArray ExprBuilder t st fs
sym Assignment BaseTypeRepr (idx ::> tp)
idxRepr Expr t r
r
| Bool
otherwise = do
let idx :: Assignment BaseTypeRepr (idx ::> itp)
idx = forall (idx :: Ctx BaseType) (itp :: BaseType) (d :: BaseType).
BaseTypeRepr (BaseArrayType (idx ::> itp) d)
-> Assignment BaseTypeRepr (idx ::> itp)
arrayResultIdxType (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType (forall (f :: BaseType -> Type) (idx :: Ctx BaseType)
(tp :: BaseType).
ArrayResultWrapper f idx tp -> f (BaseArrayType idx tp)
unwrapArrayResult (forall {k} (f :: k -> Type) (ctx :: Ctx k) (tp :: k).
Assignment f (ctx '::> tp) -> f tp
Ctx.last Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arrays)))
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall t (ctx :: Ctx BaseType) (d :: BaseType) (r :: BaseType)
(idx :: Ctx BaseType) (itp :: BaseType) (e :: BaseType -> Type).
ExprSymFn t (ctx ::> d) r
-> Assignment BaseTypeRepr (idx ::> itp)
-> Assignment (ArrayResultWrapper e (idx ::> itp)) (ctx ::> d)
-> NonceApp t e ('BaseArrayType (idx ::> itp) r)
MapOverArrays SymFn (ExprBuilder t st fs) (ctx ::> d) r
f Assignment BaseTypeRepr (idx ::> itp)
idx Assignment
(ArrayResultWrapper (SymExpr (ExprBuilder t st fs)) (idx ::> itp))
(ctx ::> d)
arrays
arrayUpdate :: forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
-> SymExpr (ExprBuilder t st fs) b
-> IO (SymArray (ExprBuilder t st fs) (idx ::> tp) b)
arrayUpdate ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (idx ::> tp) b
arr Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
i SymExpr (ExprBuilder t st fs) b
v
| Just Assignment IndexLit (idx ::> tp)
ci <- forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
IsExpr e =>
Assignment e ctx -> Maybe (Assignment IndexLit ctx)
asConcreteIndices Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
i =
case forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymArray (ExprBuilder t st fs) (idx ::> tp) b
arr of
Just (ArrayMap Assignment BaseTypeRepr (i ::> itp)
idx BaseTypeRepr tp1
tp ArrayUpdateMap (Expr t) (i ::> itp) tp1
m Expr t ('BaseArrayType (i ::> itp) tp1)
def) -> do
let new_map :: ArrayUpdateMap (Expr t) (idx ::> tp) tp1
new_map =
case forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t ('BaseArrayType (i ::> itp) tp1)
def of
Just (ConstantArray Assignment BaseTypeRepr (i ::> tp1)
_ BaseTypeRepr b
_ Expr t b
cns) | SymExpr (ExprBuilder t st fs) b
v forall a. Eq a => a -> a -> Bool
== Expr t b
cns -> forall (ctx :: Ctx BaseType) (e :: BaseType -> Type)
(tp :: BaseType).
Assignment IndexLit ctx
-> ArrayUpdateMap e ctx tp -> ArrayUpdateMap e ctx tp
AUM.delete Assignment IndexLit (idx ::> tp)
ci ArrayUpdateMap (Expr t) (i ::> itp) tp1
m
Maybe (App (Expr t) ('BaseArrayType (i ::> itp) tp1))
_ -> forall (e :: BaseType -> Type) (tp :: BaseType)
(ctx :: Ctx BaseType).
(HashableF e, HasAbsValue e) =>
BaseTypeRepr tp
-> Assignment IndexLit ctx
-> e tp
-> ArrayUpdateMap e ctx tp
-> ArrayUpdateMap e ctx tp
AUM.insert BaseTypeRepr tp1
tp Assignment IndexLit (idx ::> tp)
ci SymExpr (ExprBuilder t st fs) b
v ArrayUpdateMap (Expr t) (i ::> itp) tp1
m
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (i :: Ctx BaseType) (itp :: BaseType) (tp1 :: BaseType)
(e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> itp)
-> BaseTypeRepr tp1
-> ArrayUpdateMap e (i ::> itp) tp1
-> e (BaseArrayType (i ::> itp) tp1)
-> App e (BaseArrayType (i ::> itp) tp1)
ArrayMap Assignment BaseTypeRepr (i ::> itp)
idx BaseTypeRepr tp1
tp ArrayUpdateMap (Expr t) (idx ::> tp) tp1
new_map Expr t ('BaseArrayType (i ::> itp) tp1)
def
Maybe (App (Expr t) (BaseArrayType (idx ::> tp) b))
_ -> do
let idx :: Assignment BaseTypeRepr (idx ::> tp)
idx = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
i
let bRepr :: BaseTypeRepr b
bRepr = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) b
v
let new_map :: ArrayUpdateMap (Expr t) (idx ::> tp) b
new_map = forall (e :: BaseType -> Type) (tp :: BaseType)
(ctx :: Ctx BaseType).
(HashableF e, HasAbsValue e) =>
BaseTypeRepr tp
-> Assignment IndexLit ctx -> e tp -> ArrayUpdateMap e ctx tp
AUM.singleton BaseTypeRepr b
bRepr Assignment IndexLit (idx ::> tp)
ci SymExpr (ExprBuilder t st fs) b
v
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (i :: Ctx BaseType) (itp :: BaseType) (tp1 :: BaseType)
(e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> itp)
-> BaseTypeRepr tp1
-> ArrayUpdateMap e (i ::> itp) tp1
-> e (BaseArrayType (i ::> itp) tp1)
-> App e (BaseArrayType (i ::> itp) tp1)
ArrayMap Assignment BaseTypeRepr (idx ::> tp)
idx BaseTypeRepr b
bRepr ArrayUpdateMap (Expr t) (idx ::> tp) b
new_map SymArray (ExprBuilder t st fs) (idx ::> tp) b
arr
| Bool
otherwise = do
let bRepr :: BaseTypeRepr b
bRepr = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) b
v
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (b :: BaseType) (i :: Ctx BaseType) (tp1 :: BaseType)
(e :: BaseType -> Type).
BaseTypeRepr b
-> Assignment BaseTypeRepr (i ::> tp1)
-> e (BaseArrayType (i ::> tp1) b)
-> Assignment e (i ::> tp1)
-> e b
-> App e (BaseArrayType (i ::> tp1) b)
UpdateArray BaseTypeRepr b
bRepr (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
i) SymArray (ExprBuilder t st fs) (idx ::> tp) b
arr Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
i SymExpr (ExprBuilder t st fs) b
v)
arrayLookup :: forall (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (idx ::> tp) b
-> Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
-> IO (SymExpr (ExprBuilder t st fs) b)
arrayLookup ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (idx ::> tp) b
arr Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
idx =
forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (idx ::> tp) b
arr (forall (e :: BaseType -> Type) (ctx :: Ctx BaseType).
IsExpr e =>
Assignment e ctx -> Maybe (Assignment IndexLit ctx)
asConcreteIndices Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
idx) Assignment (SymExpr (ExprBuilder t st fs)) (idx ::> tp)
idx
arrayCopy :: forall (w :: Natural) (a :: BaseType).
(1 <= w) =>
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a)
arrayCopy ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
dest_arr SymBV (ExprBuilder t st fs) w
dest_idx SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
src_arr SymBV (ExprBuilder t st fs) w
src_idx SymBV (ExprBuilder t st fs) w
len = case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
dest_arr of
(BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
a_repr) -> do
Expr t (BaseBVType w)
dest_end_idx <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
dest_idx SymBV (ExprBuilder t st fs) w
len
Expr t (BaseBVType w)
src_end_idx <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
src_idx SymBV (ExprBuilder t st fs) w
len
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (a :: BaseType) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> BaseTypeRepr a
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> App e (BaseArrayType (SingleCtx (BaseBVType w)) a)
CopyArray (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
dest_idx) BaseTypeRepr xs
a_repr SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
dest_arr SymBV (ExprBuilder t st fs) w
dest_idx SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
src_arr SymBV (ExprBuilder t st fs) w
src_idx SymBV (ExprBuilder t st fs) w
len Expr t (BaseBVType w)
dest_end_idx Expr t (BaseBVType w)
src_end_idx)
arraySet :: forall (w :: Natural) (a :: BaseType).
(1 <= w) =>
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymExpr (ExprBuilder t st fs) a
-> SymBV (ExprBuilder t st fs) w
-> IO (SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a)
arraySet ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
arr SymBV (ExprBuilder t st fs) w
idx SymExpr (ExprBuilder t st fs) a
val SymBV (ExprBuilder t st fs) w
len = do
Expr t (BaseBVType w)
end_idx <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
idx SymBV (ExprBuilder t st fs) w
len
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (a :: BaseType) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> BaseTypeRepr a
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e a
-> e (BaseBVType w)
-> e (BaseBVType w)
-> App e (BaseArrayType (SingleCtx (BaseBVType w)) a)
SetArray (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
idx) (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymExpr (ExprBuilder t st fs) a
val) SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
arr SymBV (ExprBuilder t st fs) w
idx SymExpr (ExprBuilder t st fs) a
val SymBV (ExprBuilder t st fs) w
len Expr t (BaseBVType w)
end_idx)
arrayRangeEq :: forall (w :: Natural) (a :: BaseType).
(1 <= w) =>
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
-> SymBV (ExprBuilder t st fs) w
-> SymBV (ExprBuilder t st fs) w
-> IO (Pred (ExprBuilder t st fs))
arrayRangeEq ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
x_arr SymBV (ExprBuilder t st fs) w
x_idx SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
y_arr SymBV (ExprBuilder t st fs) w
y_idx SymBV (ExprBuilder t st fs) w
len = case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
x_arr of
(BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
_ BaseTypeRepr xs
a_repr) -> do
Expr t (BaseBVType w)
x_end_idx <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x_idx SymBV (ExprBuilder t st fs) w
len
Expr t (BaseBVType w)
y_end_idx <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> SymBV sym w -> IO (SymBV sym w)
bvAdd ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
y_idx SymBV (ExprBuilder t st fs) w
len
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (a :: BaseType) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w
-> BaseTypeRepr a
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e (BaseArrayType (SingleCtx (BaseBVType w)) a)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> e (BaseBVType w)
-> App e 'BaseBoolType
EqualArrayRange (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x_idx) BaseTypeRepr xs
a_repr SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
x_arr SymBV (ExprBuilder t st fs) w
x_idx SymArray (ExprBuilder t st fs) (SingleCtx (BaseBVType w)) a
y_arr SymBV (ExprBuilder t st fs) w
y_idx SymBV (ExprBuilder t st fs) w
len Expr t (BaseBVType w)
x_end_idx Expr t (BaseBVType w)
y_end_idx)
arrayUpdateAtIdxLits :: forall (idx :: Ctx BaseType) (itp :: BaseType) (tp :: BaseType).
ExprBuilder t st fs
-> ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
-> SymArray (ExprBuilder t st fs) (idx ::> itp) tp
-> IO (SymArray (ExprBuilder t st fs) (idx ::> itp) tp)
arrayUpdateAtIdxLits ExprBuilder t st fs
sym ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
m SymArray (ExprBuilder t st fs) (idx ::> itp) tp
def_map = do
BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idx_tps BaseTypeRepr xs
baseRepr <- forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) (idx ::> itp) tp
def_map
let new_map :: ArrayUpdateMap (Expr t) (idx ::> tp) xs
new_map
| Just (ConstantArray Assignment BaseTypeRepr (i ::> tp1)
_ BaseTypeRepr b
_ Expr t b
default_value) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymArray (ExprBuilder t st fs) (idx ::> itp) tp
def_map =
forall (e :: BaseType -> Type) (tp :: BaseType)
(ctx :: Ctx BaseType).
(e tp -> Bool)
-> ArrayUpdateMap e ctx tp -> ArrayUpdateMap e ctx tp
AUM.filter (forall a. Eq a => a -> a -> Bool
/= Expr t b
default_value) ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
m
| Bool
otherwise = ArrayUpdateMap (SymExpr (ExprBuilder t st fs)) (idx ::> itp) tp
m
if forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
(tp :: BaseType).
ArrayUpdateMap e ctx tp -> Bool
AUM.null ArrayUpdateMap (Expr t) (idx ::> tp) xs
new_map then
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymArray (ExprBuilder t st fs) (idx ::> itp) tp
def_map
else
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (i :: Ctx BaseType) (itp :: BaseType) (tp1 :: BaseType)
(e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> itp)
-> BaseTypeRepr tp1
-> ArrayUpdateMap e (i ::> itp) tp1
-> e (BaseArrayType (i ::> itp) tp1)
-> App e (BaseArrayType (i ::> itp) tp1)
ArrayMap Assignment BaseTypeRepr (idx ::> tp)
idx_tps BaseTypeRepr xs
baseRepr ArrayUpdateMap (Expr t) (idx ::> tp) xs
new_map SymArray (ExprBuilder t st fs) (idx ::> itp) tp
def_map
arrayIte :: forall (idx :: Ctx BaseType) (b :: BaseType).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymArray (ExprBuilder t st fs) idx b
-> SymArray (ExprBuilder t st fs) idx b
-> IO (SymArray (ExprBuilder t st fs) idx b)
arrayIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p SymArray (ExprBuilder t st fs) idx b
x SymArray (ExprBuilder t st fs) idx b
y
| ArrayMapView ArrayUpdateMap (Expr t) idx b
mx Expr t (BaseArrayType idx b)
x' <- forall t (i :: Ctx BaseType) (tp :: BaseType).
Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
viewArrayMap SymArray (ExprBuilder t st fs) idx b
x
, ArrayMapView ArrayUpdateMap (Expr t) idx b
my Expr t (BaseArrayType idx b)
y' <- forall t (i :: Ctx BaseType) (tp :: BaseType).
Expr t (BaseArrayType i tp) -> ArrayMapView i (Expr t) tp
viewArrayMap SymArray (ExprBuilder t st fs) idx b
y
, Bool -> Bool
not (forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
(tp :: BaseType).
ArrayUpdateMap e ctx tp -> Bool
AUM.null ArrayUpdateMap (Expr t) idx b
mx) Bool -> Bool -> Bool
|| Bool -> Bool
not (forall (e :: BaseType -> Type) (ctx :: Ctx BaseType)
(tp :: BaseType).
ArrayUpdateMap e ctx tp -> Bool
AUM.null ArrayUpdateMap (Expr t) idx b
my) = do
case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) idx b
x of
BaseArrayRepr Assignment BaseTypeRepr (idx ::> tp)
idxRepr BaseTypeRepr xs
bRepr -> do
let both_fn :: Assignment IndexLit (idx ::> tp)
-> Expr t b -> Expr t b -> IO (SymExpr (ExprBuilder t st fs) b)
both_fn Assignment IndexLit (idx ::> tp)
_ Expr t b
u Expr t b
v = forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p Expr t b
u Expr t b
v
left_fn :: Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
left_fn Assignment IndexLit (idx ::> tp)
idx Expr t b
u = do
Expr t b
v <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType idx b)
y' (forall a. a -> Maybe a
Just Assignment IndexLit (idx ::> tp)
idx) forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (ctx :: Ctx BaseType).
IsExprBuilder sym =>
sym -> Assignment IndexLit ctx -> IO (Assignment (SymExpr sym) ctx)
symbolicIndices ExprBuilder t st fs
sym Assignment IndexLit (idx ::> tp)
idx
Assignment IndexLit (idx ::> tp)
-> Expr t b -> Expr t b -> IO (SymExpr (ExprBuilder t st fs) b)
both_fn Assignment IndexLit (idx ::> tp)
idx Expr t b
u Expr t b
v
right_fn :: Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
right_fn Assignment IndexLit (idx ::> tp)
idx Expr t b
v = do
Expr t b
u <- forall t (st :: Type -> Type) fs (d :: Ctx BaseType)
(tp :: BaseType) (range :: BaseType).
ExprBuilder t st fs
-> Expr t (BaseArrayType (d ::> tp) range)
-> Maybe (Assignment IndexLit (d ::> tp))
-> Assignment (Expr t) (d ::> tp)
-> IO (Expr t range)
sbConcreteLookup ExprBuilder t st fs
sym Expr t (BaseArrayType idx b)
x' (forall a. a -> Maybe a
Just Assignment IndexLit (idx ::> tp)
idx) forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (ctx :: Ctx BaseType).
IsExprBuilder sym =>
sym -> Assignment IndexLit ctx -> IO (Assignment (SymExpr sym) ctx)
symbolicIndices ExprBuilder t st fs
sym Assignment IndexLit (idx ::> tp)
idx
Assignment IndexLit (idx ::> tp)
-> Expr t b -> Expr t b -> IO (SymExpr (ExprBuilder t st fs) b)
both_fn Assignment IndexLit (idx ::> tp)
idx Expr t b
u Expr t b
v
ArrayUpdateMap (Expr t) (idx ::> tp) xs
mz <- forall (m :: Type -> Type) (g :: BaseType -> Type) (tp :: BaseType)
(ctx :: Ctx BaseType) (e :: BaseType -> Type)
(f :: BaseType -> Type).
(Applicative m, HashableF g, HasAbsValue g) =>
BaseTypeRepr tp
-> (Assignment IndexLit ctx -> e tp -> f tp -> m (g tp))
-> (Assignment IndexLit ctx -> e tp -> m (g tp))
-> (Assignment IndexLit ctx -> f tp -> m (g tp))
-> ArrayUpdateMap e ctx tp
-> ArrayUpdateMap f ctx tp
-> m (ArrayUpdateMap g ctx tp)
AUM.mergeM BaseTypeRepr xs
bRepr Assignment IndexLit (idx ::> tp)
-> Expr t b -> Expr t b -> IO (SymExpr (ExprBuilder t st fs) b)
both_fn Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
left_fn Assignment IndexLit (idx ::> tp) -> Expr t b -> IO (Expr t xs)
right_fn ArrayUpdateMap (Expr t) idx b
mx ArrayUpdateMap (Expr t) idx b
my
Expr t ('BaseArrayType (idx ::> tp) xs)
z' <- forall sym (idx :: Ctx BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymArray sym idx b
-> SymArray sym idx b
-> IO (SymArray sym idx b)
arrayIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p Expr t (BaseArrayType idx b)
x' Expr t (BaseArrayType idx b)
y'
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (i :: Ctx BaseType) (itp :: BaseType) (tp1 :: BaseType)
(e :: BaseType -> Type).
Assignment BaseTypeRepr (i ::> itp)
-> BaseTypeRepr tp1
-> ArrayUpdateMap e (i ::> itp) tp1
-> e (BaseArrayType (i ::> itp) tp1)
-> App e (BaseArrayType (i ::> itp) tp1)
ArrayMap Assignment BaseTypeRepr (idx ::> tp)
idxRepr BaseTypeRepr xs
bRepr ArrayUpdateMap (Expr t) (idx ::> tp) xs
mz Expr t ('BaseArrayType (idx ::> tp) xs)
z'
| Bool
otherwise = forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t 'BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p SymArray (ExprBuilder t st fs) idx b
x SymArray (ExprBuilder t st fs) idx b
y
arrayEq :: forall (idx :: Ctx BaseType) (b :: BaseType).
ExprBuilder t st fs
-> SymArray (ExprBuilder t st fs) idx b
-> SymArray (ExprBuilder t st fs) idx b
-> IO (Pred (ExprBuilder t st fs))
arrayEq ExprBuilder t st fs
sym SymArray (ExprBuilder t st fs) idx b
x SymArray (ExprBuilder t st fs) idx b
y
| SymArray (ExprBuilder t st fs) idx b
x forall a. Eq a => a -> a -> Bool
== SymArray (ExprBuilder t st fs) idx b
y =
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymArray (ExprBuilder t st fs) idx b
x) SymArray (ExprBuilder t st fs) idx b
x SymArray (ExprBuilder t st fs) idx b
y
arrayTrueOnEntries :: forall (idx :: Ctx BaseType) (itp :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
-> SymArray (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
-> IO (Pred (ExprBuilder t st fs))
arrayTrueOnEntries ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
f SymArray (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
a
| Just Bool
True <- forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymArray (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
a =
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
| Just (IndicesInRange Assignment OnlyIntRepr (idx '::> itp)
_ Assignment (Expr t) (idx '::> itp)
bnds) <- forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Maybe (MatlabSolverFn (Expr t) args ret)
asMatlabSolverFn SymFn (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
f
, Just Assignment IntLit (idx '::> itp)
v <- forall t (idx :: Ctx BaseType).
Assignment (Expr t) idx -> Maybe (Assignment IntLit idx)
asIntBounds Assignment (Expr t) (idx '::> itp)
bnds = do
let h :: Expr t (BaseArrayType (i::>it) BaseBoolType)
-> BoolExpr t
-> Ctx.Assignment (Expr t) (i::>it)
-> IO (BoolExpr t)
h :: forall (i :: Ctx BaseType) (it :: BaseType).
Expr t (BaseArrayType (i ::> it) 'BaseBoolType)
-> Expr t 'BaseBoolType
-> Assignment (Expr t) (i ::> it)
-> IO (Expr t 'BaseBoolType)
h Expr t (BaseArrayType (i ::> it) 'BaseBoolType)
a0 Expr t 'BaseBoolType
p Assignment (Expr t) (i ::> it)
i = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> Pred sym -> IO (Pred sym)
andPred ExprBuilder t st fs
sym Expr t 'BaseBoolType
p forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (idx :: Ctx BaseType) (tp :: BaseType) (b :: BaseType).
IsExprBuilder sym =>
sym
-> SymArray sym (idx ::> tp) b
-> Assignment (SymExpr sym) (idx ::> tp)
-> IO (SymExpr sym b)
arrayLookup ExprBuilder t st fs
sym Expr t (BaseArrayType (i ::> it) 'BaseBoolType)
a0 Assignment (Expr t) (i ::> it)
i
forall sym (idx :: Ctx BaseType) r.
IsExprBuilder sym =>
sym
-> (r -> Assignment (SymExpr sym) idx -> IO r)
-> r
-> Assignment IntLit idx
-> IO r
foldIndicesInRangeBounds ExprBuilder t st fs
sym (forall (i :: Ctx BaseType) (it :: BaseType).
Expr t (BaseArrayType (i ::> it) 'BaseBoolType)
-> Expr t 'BaseBoolType
-> Assignment (Expr t) (i ::> it)
-> IO (Expr t 'BaseBoolType)
h SymArray (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
a) (forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym) Assignment IntLit (idx '::> itp)
v
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! forall t (idx :: Ctx BaseType) (itp :: BaseType)
(e :: BaseType -> Type).
ExprSymFn t (idx ::> itp) 'BaseBoolType
-> e (BaseArrayType (idx ::> itp) 'BaseBoolType)
-> NonceApp t e 'BaseBoolType
ArrayTrueOnEntries SymFn (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
f SymArray (ExprBuilder t st fs) (idx ::> itp) 'BaseBoolType
a
integerToReal :: ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
integerToReal ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
x
| SemiRingLiteral SemiRingRepr sr
SR.SemiRingIntegerRepr Coefficient sr
i ProgramLoc
l <- SymInteger (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr (forall a. Real a => a -> Rational
toRational Coefficient sr
i) ProgramLoc
l
| Just (RealToInteger Expr t BaseRealType
y) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseRealType
y
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseIntegerType -> App e BaseRealType
IntegerToReal SymInteger (ExprBuilder t st fs)
x)
realToInteger :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realToInteger ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
| SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a b. (RealFrac a, Integral b) => a -> b
floor Coefficient sr
r) ProgramLoc
l
| Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
x)
bvToInteger :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymInteger (ExprBuilder t st fs))
bvToInteger ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x =
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
xv)
| Just (IntegerToBV IntegerExpr t
xi NatRepr w
w) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMod ExprBuilder t st fs
sym IntegerExpr t
xi forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> App e BaseIntegerType
BVToInteger SymBV (ExprBuilder t st fs) w
x)
sbvToInteger :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymBV (ExprBuilder t st fs) w
-> IO (SymInteger (ExprBuilder t st fs))
sbvToInteger ExprBuilder t st fs
sym SymBV (ExprBuilder t st fs) w
x
| Just BV w
xv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x =
forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall (w :: Natural). (1 <= w) => NatRepr w -> BV w -> Integer
BV.asSigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
xv)
| Just (IntegerToBV IntegerExpr t
xi NatRepr w
w) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) w
x =
do IntegerExpr t
halfmod <- forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
2 forall a b. (Num a, Integral b) => a -> b -> a
^ (forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w forall a. Num a => a -> a -> a
- Natural
1))
IntegerExpr t
modulus <- forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (Integer
2 forall a b. (Num a, Integral b) => a -> b -> a
^ forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr w
w)
IntegerExpr t
x' <- forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intAdd ExprBuilder t st fs
sym IntegerExpr t
xi IntegerExpr t
halfmod
IntegerExpr t
z <- forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intMod ExprBuilder t st fs
sym IntegerExpr t
x' IntegerExpr t
modulus
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (SymInteger sym)
intSub ExprBuilder t st fs
sym IntegerExpr t
z IntegerExpr t
halfmod
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e (BaseBVType w) -> App e BaseIntegerType
SBVToInteger SymBV (ExprBuilder t st fs) w
x)
predToBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> NatRepr w
-> IO (SymBV (ExprBuilder t st fs) w)
predToBV ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
p NatRepr w
w
| Just Bool
b <- forall (e :: BaseType -> Type).
IsExpr e =>
e 'BaseBoolType -> Maybe Bool
asConstantPred Pred (ExprBuilder t st fs)
p =
if Bool
b then forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). (1 <= w) => NatRepr w -> BV w
BV.one NatRepr w
w) else forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> BV w
BV.zero NatRepr w
w)
| Bool
otherwise =
case forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases NatRepr w
w (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) of
NatCases w 1
NatCaseEQ -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e 'BaseBoolType -> App e ('BaseBVType w)
BVFill (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) Pred (ExprBuilder t st fs)
p)
NatCaseGT LeqProof (1 + 1) w
LeqProof -> forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
w forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
NatRepr w -> e 'BaseBoolType -> App e ('BaseBVType w)
BVFill (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @1) Pred (ExprBuilder t st fs)
p)
NatCaseLT LeqProof (w + 1) 1
LeqProof -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"impossible case in predToBV"
integerToBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SymInteger (ExprBuilder t st fs)
-> NatRepr w
-> IO (SymBV (ExprBuilder t st fs) w)
integerToBV ExprBuilder t st fs
sym SymInteger (ExprBuilder t st fs)
xr NatRepr w
w
| SemiRingLiteral SemiRingRepr sr
SR.SemiRingIntegerRepr Coefficient sr
i ProgramLoc
_ <- SymInteger (ExprBuilder t st fs)
xr =
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Coefficient sr
i)
| Just (BVToInteger Expr t (BaseBVType w)
r) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
xr =
case forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
r) NatRepr w
w of
NatCaseLT LeqProof (w + 1) w
LeqProof -> forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvZext ExprBuilder t st fs
sym NatRepr w
w Expr t (BaseBVType w)
r
NatCases w w
NatCaseEQ -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseBVType w)
r
NatCaseGT LeqProof (w + 1) w
LeqProof -> forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc ExprBuilder t st fs
sym NatRepr w
w Expr t (BaseBVType w)
r
| Just (SBVToInteger Expr t (BaseBVType w)
r) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymInteger (ExprBuilder t st fs)
xr =
case forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatCases m n
testNatCases (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth Expr t (BaseBVType w)
r) NatRepr w
w of
NatCaseLT LeqProof (w + 1) w
LeqProof -> forall sym (u :: Natural) (r :: Natural).
(IsExprBuilder sym, 1 <= u, (u + 1) <= r) =>
sym -> NatRepr r -> SymBV sym u -> IO (SymBV sym r)
bvSext ExprBuilder t st fs
sym NatRepr w
w Expr t (BaseBVType w)
r
NatCases w w
NatCaseEQ -> forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseBVType w)
r
NatCaseGT LeqProof (w + 1) w
LeqProof -> forall sym (r :: Natural) (w :: Natural).
(IsExprBuilder sym, 1 <= r, (r + 1) <= w) =>
sym -> NatRepr r -> SymBV sym w -> IO (SymBV sym r)
bvTrunc ExprBuilder t st fs
sym NatRepr w
w Expr t (BaseBVType w)
r
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (e :: BaseType -> Type).
(1 <= w) =>
e BaseIntegerType -> NatRepr w -> App e ('BaseBVType w)
IntegerToBV SymInteger (ExprBuilder t st fs)
xr NatRepr w
w)
realRound :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realRound ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
| SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a. RealFrac a => a -> Integer
roundAway Coefficient sr
r) ProgramLoc
l
| Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
| Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
x)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RoundReal SymReal (ExprBuilder t st fs)
x)
realRoundEven :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realRoundEven ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
| SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a b. (RealFrac a, Integral b) => a -> b
round Coefficient sr
r) ProgramLoc
l
| Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
| Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
x)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RoundEvenReal SymReal (ExprBuilder t st fs)
x)
realFloor :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realFloor ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
| SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a b. (RealFrac a, Integral b) => a -> b
floor Coefficient sr
r) ProgramLoc
l
| Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
| Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
x)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
FloorReal SymReal (ExprBuilder t st fs)
x)
realCeil :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymInteger (ExprBuilder t st fs))
realCeil ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x
| SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
l <- SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr SemiRingInteger
SR.SemiRingIntegerRepr (forall a b. (RealFrac a, Integral b) => a -> b
ceiling Coefficient sr
r) ProgramLoc
l
| Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return IntegerExpr t
xi
| Just Bool
True <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
RealToInteger SymReal (ExprBuilder t st fs)
x)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseIntegerType
CeilReal SymReal (ExprBuilder t st fs)
x)
realLit :: ExprBuilder t st fs
-> Rational -> IO (SymReal (ExprBuilder t st fs))
realLit ExprBuilder t st fs
sb Rational
r = do
ProgramLoc
l <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sb
forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall (sr :: SemiRing) t.
SemiRingRepr sr
-> Coefficient sr -> ProgramLoc -> Expr t (SemiRingBase sr)
SemiRingLiteral SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr Rational
r ProgramLoc
l)
realZero :: ExprBuilder t st fs -> SymReal (ExprBuilder t st fs)
realZero = forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> RealExpr t
sbZero
realEq :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
realEq ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
| Just Bool
b <- RealAbstractValue -> RealAbstractValue -> Maybe Bool
ravCheckEq (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
y)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x
, Just (IntegerToReal IntegerExpr t
yi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
y
= forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym IntegerExpr t
xi IntegerExpr t
yi
| Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x
, SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
yr ProgramLoc
_ <- SymReal (ExprBuilder t st fs)
y
= if forall a. Ratio a -> a
denominator Coefficient sr
yr forall a. Eq a => a -> a -> Bool
== Integer
1
then forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym IntegerExpr t
xi forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall a. Ratio a -> a
numerator Coefficient sr
yr)
else forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
| SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
xr ProgramLoc
_ <- SymReal (ExprBuilder t st fs)
x
, Just (IntegerToReal IntegerExpr t
yi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
y
= if forall a. Ratio a -> a
denominator Coefficient sr
xr forall a. Eq a => a -> a -> Bool
== Integer
1
then forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intEq ExprBuilder t st fs
sym IntegerExpr t
yi forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall a. Ratio a -> a
numerator Coefficient sr
xr)
else forall (m :: Type -> Type) a. Monad m => a -> m a
return (forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym)
| Bool
otherwise
= forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t 'BaseBoolType)
semiRingEq ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq ExprBuilder t st fs
sym) SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
realLe :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
realLe ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
| Just Bool
b <- RealAbstractValue -> RealAbstractValue -> Maybe Bool
ravCheckLe (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
y)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym Bool
b
| Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x
, Just (IntegerToReal IntegerExpr t
yi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
y
= forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe ExprBuilder t st fs
sym IntegerExpr t
xi IntegerExpr t
yi
| Just (IntegerToReal IntegerExpr t
xi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
x
, SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
yr ProgramLoc
_ <- SymReal (ExprBuilder t st fs)
y
= forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IntegerExpr t
xi forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall a b. (RealFrac a, Integral b) => a -> b
floor Coefficient sr
yr))
| SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
xr ProgramLoc
_ <- SymReal (ExprBuilder t st fs)
x
, Just (IntegerToReal IntegerExpr t
yi) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymReal (ExprBuilder t st fs)
y
= forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join (forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> SymInteger sym -> IO (Pred sym)
intLe ExprBuilder t st fs
sym forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit ExprBuilder t st fs
sym (forall a b. (RealFrac a, Integral b) => a -> b
ceiling Coefficient sr
xr) forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (f :: Type -> Type) a. Applicative f => a -> f a
pure IntegerExpr t
yi)
| Bool
otherwise
= forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> OrderedSemiRingRepr sr
-> (Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr) -> IO (Expr t 'BaseBoolType))
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t 'BaseBoolType)
semiRingLe ExprBuilder t st fs
sym OrderedSemiRingRepr 'SemiRingReal
SR.OrderedSemiRingRealRepr (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLe ExprBuilder t st fs
sym) SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
realIte :: ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t 'BaseBoolType
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingIte ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr Pred (ExprBuilder t st fs)
c SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
realNeg :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realNeg ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr (-Rational
1) SymReal (ExprBuilder t st fs)
x
realAdd :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realAdd ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingAdd ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
realMul :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realMul ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y = forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Expr t (SemiRingBase sr)
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
semiRingMul ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
realDiv :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realDiv ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
| Just Rational
0 <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
x =
forall (m :: Type -> Type) a. Monad m => a -> m a
return SymReal (ExprBuilder t st fs)
x
| Just Rational
xd <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
x, Just Rational
yd <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
y, Rational
yd forall a. Eq a => a -> a -> Bool
/= Rational
0 = do
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (Rational
xd forall a. Fractional a => a -> a -> a
/ Rational
yd)
| Just Rational
yd <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
y, Rational
yd forall a. Eq a => a -> a -> Bool
/= Rational
0 = do
forall t (st :: Type -> Type) fs (sr :: SemiRing).
ExprBuilder t st fs
-> SemiRingRepr sr
-> Coefficient sr
-> Expr t (SemiRingBase sr)
-> IO (Expr t (SemiRingBase sr))
scalarMul ExprBuilder t st fs
sym SemiRingRepr 'SemiRingReal
SR.SemiRingRealRepr (Rational
1 forall a. Fractional a => a -> a -> a
/ Rational
yd) SymReal (ExprBuilder t st fs)
x
| Bool
otherwise =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type).
e BaseRealType -> e BaseRealType -> App e BaseRealType
RealDiv SymReal (ExprBuilder t st fs)
x SymReal (ExprBuilder t st fs)
y
isInteger :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs) -> IO (Pred (ExprBuilder t st fs))
isInteger ExprBuilder t st fs
sb SymReal (ExprBuilder t st fs)
x
| Just Rational
r <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
x = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sb (forall a. Ratio a -> a
denominator Rational
r forall a. Eq a => a -> a -> Bool
== Integer
1)
| Just Bool
b <- RealAbstractValue -> Maybe Bool
ravIsInteger (forall t (tp :: BaseType). Expr t tp -> AbstractValue tp
exprAbsValue SymReal (ExprBuilder t st fs)
x) = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sb Bool
b
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sb forall a b. (a -> b) -> a -> b
$ forall (e :: BaseType -> Type).
e BaseRealType -> App e 'BaseBoolType
RealIsInteger SymReal (ExprBuilder t st fs)
x
realSqrt :: ExprBuilder t st fs
-> SymReal (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
realSqrt ExprBuilder t st fs
sym SymReal (ExprBuilder t st fs)
x = do
let sqrt_dbl :: Double -> Double
sqrt_dbl :: Double -> Double
sqrt_dbl = forall a. Floating a => a -> a
sqrt
case SymReal (ExprBuilder t st fs)
x of
SemiRingLiteral SemiRingRepr sr
SR.SemiRingRealRepr Coefficient sr
r ProgramLoc
_
| Coefficient sr
r forall a. Ord a => a -> a -> Bool
< Rational
0 -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealSqrt SymReal (ExprBuilder t st fs)
x)
| Just Rational
w <- Rational -> Maybe Rational
tryRationalSqrt Coefficient sr
r -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
w
| forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (Double -> Double
sqrt_dbl (forall a. Fractional a => Rational -> a
fromRational Coefficient sr
r)))
SymReal (ExprBuilder t st fs)
_ -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e BaseRealType -> App e BaseRealType
RealSqrt SymReal (ExprBuilder t st fs)
x)
realSpecialFunction :: forall (args :: Ctx Type).
ExprBuilder t st fs
-> SpecialFunction args
-> Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
-> IO (SymReal (ExprBuilder t st fs))
realSpecialFunction ExprBuilder t st fs
sym SpecialFunction args
fn Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
Assignment (SpecialFnArg (Expr t) BaseRealType) args
Empty
| forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym =
case SpecialFunction args
fn of
SpecialFunction args
SFn.Pi -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a
pi :: Double))
SpecialFunction args
_ -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Empty))
realSpecialFunction ExprBuilder t st fs
sym SpecialFunction args
fn args :: Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args@(Assignment (SpecialFnArg (Expr t) BaseRealType) ctx
Empty :> SFn.SpecialFnArg Expr t BaseRealType
x)
| Just Rational
c <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational Expr t BaseRealType
x =
case SpecialFunction args
fn of
SpecialFunction args
SFn.Sin
| Rational
c forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
0
| forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
sin (Rational -> Double
toDouble Rational
c)))
SpecialFunction args
SFn.Cos
| Rational
c forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
| forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
cos (Rational -> Double
toDouble Rational
c)))
SpecialFunction args
SFn.Sinh
| Rational
c forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
0
| forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
sinh (Rational -> Double
toDouble Rational
c)))
SpecialFunction args
SFn.Cosh
| Rational
c forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
| forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
cosh (Rational -> Double
toDouble Rational
c)))
SpecialFunction args
SFn.Exp
| Rational
c forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
| forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
exp (Rational -> Double
toDouble Rational
c)))
SpecialFunction args
SFn.Log
| Rational
c forall a. Ord a => a -> a -> Bool
> Rational
0, forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
log (Rational -> Double
toDouble Rational
c)))
SpecialFunction args
_ -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args))
realSpecialFunction ExprBuilder t st fs
sym SpecialFunction args
fn args :: Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args@(Assignment (SpecialFnArg (Expr t) BaseRealType) ctx
Empty :> SFn.SpecialFnArg Expr t BaseRealType
x :> SFn.SpecialFnArg Expr t BaseRealType
y)
| Just Rational
xc <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational Expr t BaseRealType
x,
Just Rational
yc <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational Expr t BaseRealType
y =
case SpecialFunction args
fn of
SpecialFunction args
SFn.Arctan2
| forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (forall a. RealFloat a => a -> a -> a
atan2 (Rational -> Double
toDouble Rational
xc) (Rational -> Double
toDouble Rational
yc)))
SpecialFunction args
SFn.Pow
| Rational
yc forall a. Eq a => a -> a -> Bool
== Rational
0 -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
1
| forall t (st :: Type -> Type) fs. ExprBuilder t st fs -> Bool
sbFloatReduce ExprBuilder t st fs
sym ->
forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym (forall a. Real a => a -> Rational
toRational (Rational -> Double
toDouble Rational
xc forall a. Floating a => a -> a -> a
** Rational -> Double
toDouble Rational
yc))
SpecialFunction args
_ -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args))
realSpecialFunction ExprBuilder t st fs
sym SpecialFunction args
fn Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (args :: Ctx Type) (e :: BaseType -> Type).
SpecialFunction args
-> SpecialFnArgs e BaseRealType args -> App e BaseRealType
RealSpecialFunction SpecialFunction args
fn (forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) BaseRealType) args
args))
floatLit :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> BigFloat
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
f =
do ProgramLoc
l <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (fpp :: FloatPrecision) t.
FloatPrecisionRepr fpp
-> BigFloat -> ProgramLoc -> Expr t ('BaseFloatType fpp)
FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
f ProgramLoc
l
floatPZero :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatPZero ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfPosZero
floatNZero :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNZero ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfNegZero
floatNaN :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNaN ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfNaN
floatPInf :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatPInf ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfPosInf
floatNInf :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNInf ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp BigFloat
BF.bfNegInf
floatNeg :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatNeg ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BigFloat -> BigFloat
BF.bfNeg BigFloat
x)
floatNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOp forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp)
FloatNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
floatAbs :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatAbs ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BigFloat -> BigFloat
BF.bfAbs BigFloat
x)
floatAbs ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOp forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp)
FloatAbs ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
floatSqrt :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatSqrt ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) =
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> (BigFloat, Status)
BF.bfSqrt (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x))
floatSqrt ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOpR forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatSqrt ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x
floatAdd :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatAdd ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfAdd (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y))
floatAdd ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatAdd ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatSub :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatSub ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfSub (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y ))
floatSub ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatSub ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatMul :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatMul ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfMul (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y))
floatMul ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatMul ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatDiv :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatDiv ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfDiv (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y))
floatDiv ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatDiv ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatRem :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatRem ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfRem (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
RNE) BigFloat
x BigFloat
y))
floatRem ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOp forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatRem ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatFMA :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatFMA ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
z ProgramLoc
_) =
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> BigFloat -> BigFloat -> (BigFloat, Status)
BF.bfFMA (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x BigFloat
y BigFloat
z))
floatFMA ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
z =
let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymFloat (ExprBuilder t st fs) fpp
x in forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatFMA FloatPrecisionRepr fpp
fpp RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
z
floatEq :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatEq ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! (BigFloat -> BigFloat -> Ordering
BF.bfCompare BigFloat
x BigFloat
y forall a. Eq a => a -> a -> Bool
== Ordering
EQ)
floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
| SymFloat (ExprBuilder t st fs) fpp
x forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall sym. IsExprBuilder sym => sym -> Pred sym
truePred ExprBuilder t st fs
sym
| Bool
otherwise = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicBinOp (forall (tp1 :: BaseType) (e :: BaseType -> Type).
BaseTypeRepr tp1 -> e tp1 -> e tp1 -> App e 'BaseBoolType
BaseEq (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymFloat (ExprBuilder t st fs) fpp
x)) ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatNe :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatNe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatFpEq :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatFpEq ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! (BigFloat
x forall a. Eq a => a -> a -> Bool
== BigFloat
y)
floatFpEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
| SymFloat (ExprBuilder t st fs) fpp
x forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
y = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
| Bool
otherwise = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicBinOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatFpEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatLe :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLe ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! (BigFloat
x forall a. Ord a => a -> a -> Bool
<= BigFloat
y)
floatLe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
| SymFloat (ExprBuilder t st fs) fpp
x forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
y = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st fs
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
| Bool
otherwise = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicBinOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatLe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatLt :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatLt ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
y ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! (BigFloat
x forall a. Ord a => a -> a -> Bool
< BigFloat
y)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
| SymFloat (ExprBuilder t st fs) fpp
x forall a. Eq a => a -> a -> Bool
== SymFloat (ExprBuilder t st fs) fpp
y = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st fs
sym
| Bool
otherwise = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicBinOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatGe :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatGe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLe ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x
floatGt :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatGt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x
floatIte :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> Pred (ExprBuilder t st fs)
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y = forall t (st :: Type -> Type) fs (bt :: BaseType).
ExprBuilder t st fs
-> Expr t 'BaseBoolType -> Expr t bt -> Expr t bt -> IO (Expr t bt)
mkIte ExprBuilder t st fs
sym Pred (ExprBuilder t st fs)
c SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y
floatIsNaN :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNaN ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsNaN BigFloat
x
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicUnOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
floatIsInf :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsInf ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsInf BigFloat
x
floatIsInf ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicUnOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsInf ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
floatIsZero :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsZero ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsZero BigFloat
x
floatIsZero ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicUnOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsZero ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
floatIsPos :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsPos ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsPos BigFloat
x
floatIsPos ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicUnOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsPos ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
floatIsNeg :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNeg ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! BigFloat -> Bool
BF.bfIsNeg BigFloat
x
floatIsNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicUnOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsNeg ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
floatIsSubnorm :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsSubnorm ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! BFOpts -> BigFloat -> Bool
BF.bfIsSubnormal (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
RNE) BigFloat
x
floatIsSubnorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicUnOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsSubnorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
floatIsNorm :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (Pred (ExprBuilder t st fs))
floatIsNorm ExprBuilder t st fs
sym (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) =
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym. IsExprBuilder sym => sym -> Bool -> Pred sym
backendPred ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! BFOpts -> BigFloat -> Bool
BF.bfIsNormal (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
RNE) BigFloat
x
floatIsNorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicUnOp forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e 'BaseBoolType
FloatIsNorm ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
floatCast :: forall (fpp :: FloatPrecision) (fpp' :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp'
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatCast ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
_ BigFloat
x ProgramLoc
_) =
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall a. HasCallStack => (a, Status) -> a
bfStatus (BFOpts -> BigFloat -> (BigFloat, Status)
BF.bfRoundFloat (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) BigFloat
x))
floatCast ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymFloat (ExprBuilder t st fs) fpp'
x
| FloatingPointPrecisionRepr NatRepr eb
eb NatRepr sb
sb <- FloatPrecisionRepr fpp
fpp
, Just (FloatCast (FloatingPointPrecisionRepr NatRepr eb
eb' NatRepr sb
sb') RoundingMode
_ Expr t (BaseFloatType fpp')
fval) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymFloat (ExprBuilder t st fs) fpp'
x
, forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr eb
eb forall a. Ord a => a -> a -> Bool
<= forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr eb
eb'
, forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr sb
sb forall a. Ord a => a -> a -> Bool
<= forall (n :: Natural). NatRepr n -> Natural
natValue NatRepr sb
sb'
, Just 'BaseFloatType fpp :~: BaseFloatType fpp'
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr FloatPrecisionRepr fpp
fpp) (forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Expr t (BaseFloatType fpp')
fval)
= forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseFloatType fpp')
fval
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (fpp :: FloatPrecision) (e :: BaseType -> Type)
(fpp' :: FloatPrecision).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp')
-> App e ('BaseFloatType fpp)
FloatCast FloatPrecisionRepr fpp
fpp RoundingMode
r SymFloat (ExprBuilder t st fs) fpp'
x
floatRound :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatRound ExprBuilder t st fs
sym RoundingMode
r (FloatExpr FloatPrecisionRepr fpp
fpp BigFloat
x ProgramLoc
_) =
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (forall (fpp :: FloatPrecision).
HasCallStack =>
FloatPrecisionRepr fpp -> RoundingMode -> BigFloat -> BigFloat
floatRoundToInt FloatPrecisionRepr fpp
fpp RoundingMode
r BigFloat
x)
floatRound ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x = forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOpR forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
FloatRound ExprBuilder t st fs
sym RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x
floatFromBinary :: forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st fs
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV (ExprBuilder t st fs) (eb + sb)
-> IO
(SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st fs
sym FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp SymBV (ExprBuilder t st fs) (eb + sb)
x
| Just BV (eb + sb)
bv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) (eb + sb)
x
= forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp (BFOpts -> Integer -> BigFloat
BF.bfFromBits (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp RoundingMode
RNE) (forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV (eb + sb)
bv))
| Just (FloatToBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp' Expr t (BaseFloatType (FloatingPointPrecision eb sb))
fval) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymBV (ExprBuilder t st fs) (eb + sb)
x
, Just FloatingPointPrecision eb sb :~: FloatingPointPrecision eb sb
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp'
= forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t (BaseFloatType (FloatingPointPrecision eb sb))
fval
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (eb :: Natural) (sb :: Natural) (e :: BaseType -> Type).
(2 <= eb, 2 <= sb) =>
FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> e (BaseBVType (eb + sb))
-> App e ('BaseFloatType (FloatingPointPrecision eb sb))
FloatFromBinary FloatPrecisionRepr (FloatingPointPrecision eb sb)
fpp SymBV (ExprBuilder t st fs) (eb + sb)
x
floatToBinary :: forall (eb :: Natural) (sb :: Natural).
(2 <= eb, 2 <= sb) =>
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
-> IO (SymBV (ExprBuilder t st fs) (eb + sb))
floatToBinary ExprBuilder t st fs
sym (FloatExpr fpp :: FloatPrecisionRepr fpp
fpp@(FloatingPointPrecisionRepr NatRepr eb
eb NatRepr sb
sb) BigFloat
x ProgramLoc
_)
| Just LeqProof 1 (eb + sb)
LeqProof <- forall (n :: Natural). NatRepr n -> Maybe (LeqProof 1 n)
isPosNat (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr eb
eb NatRepr sb
sb) =
forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr eb
eb NatRepr sb
sb) (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV (forall (m :: Natural) (n :: Natural).
NatRepr m -> NatRepr n -> NatRepr (m + n)
addNat NatRepr eb
eb NatRepr sb
sb) (BFOpts -> BigFloat -> Integer
BF.bfToBits (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
RNE) BigFloat
x))
floatToBinary ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
x = case forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
x of
BaseFloatRepr FloatPrecisionRepr fpp
fpp | LeqProof 1 (eb + sb)
LeqProof <- forall (eb' :: Natural) (sb' :: Natural).
FloatPrecisionRepr (FloatingPointPrecision eb' sb')
-> LeqProof 1 (eb' + sb')
lemmaFloatPrecisionIsPos FloatPrecisionRepr fpp
fpp ->
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall (eb :: Natural) (sb :: Natural) (e :: BaseType -> Type).
(2 <= eb, 2 <= sb, 1 <= (eb + sb)) =>
FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> e (BaseFloatType (FloatingPointPrecision eb sb))
-> App e ('BaseBVType (eb + sb))
FloatToBinary FloatPrecisionRepr fpp
fpp SymFloat (ExprBuilder t st fs) (FloatingPointPrecision eb sb)
x
floatMin :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatMin ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y =
forall sym v.
IsExprBuilder sym =>
(sym -> Pred sym -> v -> v -> IO v)
-> sym -> [(IO (Pred sym), IO v)] -> IO v -> IO v
iteList forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte ExprBuilder t st fs
sym
[ (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x, forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
y)
, (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y, forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
, (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
, (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
y)
, (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
]
(do Expr t 'BaseBoolType
b <- forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
emptySymbol BaseTypeRepr 'BaseBoolType
BaseBoolRepr
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
b SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y)
floatMax :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatMax ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y =
forall sym v.
IsExprBuilder sym =>
(sym -> Pred sym -> v -> v -> IO v)
-> sym -> [(IO (Pred sym), IO v)] -> IO v -> IO v
iteList forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte ExprBuilder t st fs
sym
[ (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x, forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
y)
, (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y, forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
, (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
y)
, (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
y SymFloat (ExprBuilder t st fs) fpp
x , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
, (forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatEq ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y , forall (f :: Type -> Type) a. Applicative f => a -> f a
pure SymFloat (ExprBuilder t st fs) fpp
x)
]
(do Expr t 'BaseBoolType
b <- forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
emptySymbol BaseTypeRepr 'BaseBoolType
BaseBoolRepr
forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte ExprBuilder t st fs
sym Expr t 'BaseBoolType
b SymFloat (ExprBuilder t st fs) fpp
x SymFloat (ExprBuilder t st fs) fpp
y)
bvToFloat :: forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV (ExprBuilder t st fs) w
-> IO (SymFloat (ExprBuilder t st fs) fpp)
bvToFloat ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymBV (ExprBuilder t st fs) w
x
| Just BV w
bv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BFOpts -> Integer -> BigFloat
floatFromInteger (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) (forall (w :: Natural). BV w -> Integer
BV.asUnsigned BV w
bv))
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (fpp :: FloatPrecision)
(e :: BaseType -> Type).
(1 <= w) =>
FloatPrecisionRepr fpp
-> RoundingMode -> e (BaseBVType w) -> App e ('BaseFloatType fpp)
BVToFloat FloatPrecisionRepr fpp
fpp RoundingMode
r SymBV (ExprBuilder t st fs) w
x)
sbvToFloat :: forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV (ExprBuilder t st fs) w
-> IO (SymFloat (ExprBuilder t st fs) fpp)
sbvToFloat ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymBV (ExprBuilder t st fs) w
x
| Just BV w
bv <- forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> Maybe (BV w)
asBV SymBV (ExprBuilder t st fs) w
x = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BFOpts -> Integer -> BigFloat
floatFromInteger (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) (forall (w :: Natural). (1 <= w) => NatRepr w -> BV w -> Integer
BV.asSigned (forall (e :: BaseType -> Type) (w :: Natural).
IsExpr e =>
e (BaseBVType w) -> NatRepr w
bvWidth SymBV (ExprBuilder t st fs) w
x) BV w
bv))
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (fpp :: FloatPrecision)
(e :: BaseType -> Type).
(1 <= w) =>
FloatPrecisionRepr fpp
-> RoundingMode -> e (BaseBVType w) -> App e ('BaseFloatType fpp)
SBVToFloat FloatPrecisionRepr fpp
fpp RoundingMode
r SymBV (ExprBuilder t st fs) w
x)
realToFloat :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymReal (ExprBuilder t st fs)
-> IO (SymFloat (ExprBuilder t st fs) fpp)
realToFloat ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp RoundingMode
r SymReal (ExprBuilder t st fs)
x
| Just Rational
x' <- forall (e :: BaseType -> Type).
IsExpr e =>
e BaseRealType -> Maybe Rational
asRational SymReal (ExprBuilder t st fs)
x = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> BigFloat -> IO (SymFloat sym fpp)
floatLit ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp (BFOpts -> Rational -> BigFloat
floatFromRational (forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> RoundingMode -> BFOpts
fppOpts FloatPrecisionRepr fpp
fpp RoundingMode
r) Rational
x')
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (fpp :: FloatPrecision) (e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> RoundingMode -> e BaseRealType -> App e ('BaseFloatType fpp)
RealToFloat FloatPrecisionRepr fpp
fpp RoundingMode
r SymReal (ExprBuilder t st fs)
x)
floatToBV :: forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymBV (ExprBuilder t st fs) w)
floatToBV ExprBuilder t st fs
sym NatRepr w
w RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x
| FloatExpr FloatPrecisionRepr fpp
_ BigFloat
bf ProgramLoc
_ <- SymFloat (ExprBuilder t st fs) fpp
x
, Just Integer
i <- RoundingMode -> BigFloat -> Maybe Integer
floatToInteger RoundingMode
r BigFloat
bf
, Integer
0 forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
<= forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (e :: BaseType -> Type)
(fpp :: FloatPrecision).
(1 <= w) =>
NatRepr w
-> RoundingMode -> e (BaseFloatType fpp) -> App e ('BaseBVType w)
FloatToBV NatRepr w
w RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x)
floatToSBV :: forall (w :: Natural) (fpp :: FloatPrecision).
(1 <= w) =>
ExprBuilder t st fs
-> NatRepr w
-> RoundingMode
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymBV (ExprBuilder t st fs) w)
floatToSBV ExprBuilder t st fs
sym NatRepr w
w RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x
| FloatExpr FloatPrecisionRepr fpp
_ BigFloat
bf ProgramLoc
_ <- SymFloat (ExprBuilder t st fs) fpp
x
, Just Integer
i <- RoundingMode -> BigFloat -> Maybe Integer
floatToInteger RoundingMode
r BigFloat
bf
, forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
<= forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
= forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st fs
sym NatRepr w
w (forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV NatRepr w
w Integer
i)
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (w :: Natural) (e :: BaseType -> Type)
(fpp :: FloatPrecision).
(1 <= w) =>
NatRepr w
-> RoundingMode -> e (BaseFloatType fpp) -> App e ('BaseBVType w)
FloatToSBV NatRepr w
w RoundingMode
r SymFloat (ExprBuilder t st fs) fpp
x)
floatToReal :: forall (fpp :: FloatPrecision).
ExprBuilder t st fs
-> SymFloat (ExprBuilder t st fs) fpp
-> IO (SymReal (ExprBuilder t st fs))
floatToReal ExprBuilder t st fs
sym SymFloat (ExprBuilder t st fs) fpp
x
| FloatExpr FloatPrecisionRepr fpp
_ BigFloat
bf ProgramLoc
_ <- SymFloat (ExprBuilder t st fs) fpp
x
, Just Rational
q <- BigFloat -> Maybe Rational
floatToRational BigFloat
bf
= forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st fs
sym Rational
q
| Bool
otherwise = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type) (fpp :: FloatPrecision).
e (BaseFloatType fpp) -> App e BaseRealType
FloatToReal SymFloat (ExprBuilder t st fs) fpp
x)
floatSpecialFunction :: forall (fpp :: FloatPrecision) (args :: Ctx Type).
ExprBuilder t st fs
-> FloatPrecisionRepr fpp
-> SpecialFunction args
-> Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) (BaseFloatType fpp))
args
-> IO (SymFloat (ExprBuilder t st fs) fpp)
floatSpecialFunction ExprBuilder t st fs
sym FloatPrecisionRepr fpp
fpp SpecialFunction args
fn Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) (BaseFloatType fpp))
args
args =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (fpp :: FloatPrecision) (args :: Ctx Type)
(e :: BaseType -> Type).
FloatPrecisionRepr fpp
-> SpecialFunction args
-> SpecialFnArgs e (BaseFloatType fpp) args
-> App e (BaseFloatType fpp)
FloatSpecialFunction FloatPrecisionRepr fpp
fpp SpecialFunction args
fn (forall k (e :: k -> Type) (tp :: k) (args :: Ctx Type).
Assignment (SpecialFnArg e tp) args -> SpecialFnArgs e tp args
SFn.SpecialFnArgs Assignment
(SpecialFnArg (SymExpr (ExprBuilder t st fs)) (BaseFloatType fpp))
args
args))
mkComplex :: ExprBuilder t st fs
-> Complex (SymReal (ExprBuilder t st fs))
-> IO (SymCplx (ExprBuilder t st fs))
mkComplex ExprBuilder t st fs
sym Complex (SymReal (ExprBuilder t st fs))
c = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
Complex (e BaseRealType) -> App e 'BaseComplexType
Cplx Complex (SymReal (ExprBuilder t st fs))
c)
getRealPart :: ExprBuilder t st fs
-> SymCplx (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
getRealPart ExprBuilder t st fs
_ SymCplx (ExprBuilder t st fs)
e
| Just (Cplx (Expr t BaseRealType
r :+ Expr t BaseRealType
_)) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymCplx (ExprBuilder t st fs)
e = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseRealType
r
getRealPart ExprBuilder t st fs
sym SymCplx (ExprBuilder t st fs)
x =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
RealPart SymCplx (ExprBuilder t st fs)
x)
getImagPart :: ExprBuilder t st fs
-> SymCplx (ExprBuilder t st fs)
-> IO (SymReal (ExprBuilder t st fs))
getImagPart ExprBuilder t st fs
_ SymCplx (ExprBuilder t st fs)
e
| Just (Cplx (Expr t BaseRealType
_ :+ Expr t BaseRealType
i)) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymCplx (ExprBuilder t st fs)
e = forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t BaseRealType
i
getImagPart ExprBuilder t st fs
sym SymCplx (ExprBuilder t st fs)
x =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
ImagPart SymCplx (ExprBuilder t st fs)
x)
cplxGetParts :: ExprBuilder t st fs
-> SymCplx (ExprBuilder t st fs)
-> IO (Complex (SymReal (ExprBuilder t st fs)))
cplxGetParts ExprBuilder t st fs
_ SymCplx (ExprBuilder t st fs)
e
| Just (Cplx Complex (Expr t BaseRealType)
c) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp SymCplx (ExprBuilder t st fs)
e = forall (m :: Type -> Type) a. Monad m => a -> m a
return Complex (Expr t BaseRealType)
c
cplxGetParts ExprBuilder t st fs
sym SymCplx (ExprBuilder t st fs)
x =
forall a. a -> a -> Complex a
(:+) forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
RealPart SymCplx (ExprBuilder t st fs)
x)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym (forall (e :: BaseType -> Type).
e 'BaseComplexType -> App e BaseRealType
ImagPart SymCplx (ExprBuilder t st fs)
x)
inSameBVSemiRing :: Expr t (BaseBVType w) -> Expr t (BaseBVType w) -> Maybe (Some SR.BVFlavorRepr)
inSameBVSemiRing :: forall t (w :: Natural).
Expr t (BaseBVType w)
-> Expr t (BaseBVType w) -> Maybe (Some BVFlavorRepr)
inSameBVSemiRing Expr t (BaseBVType w)
x Expr t (BaseBVType w)
y
| Just (SemiRingSum WeightedSum (Expr t) sr
s1) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseBVType w)
x
, Just (SemiRingSum WeightedSum (Expr t) sr
s2) <- forall t (tp :: BaseType). Expr t tp -> Maybe (App (Expr t) tp)
asApp Expr t (BaseBVType w)
y
, SR.SemiRingBVRepr BVFlavorRepr fv
flv1 NatRepr w
_w <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s1
, SR.SemiRingBVRepr BVFlavorRepr fv
flv2 NatRepr w
_w <- forall (f :: BaseType -> Type) (sr :: SemiRing).
WeightedSum f sr -> SemiRingRepr sr
WSum.sumRepr WeightedSum (Expr t) sr
s2
, Just fv :~: fv
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality BVFlavorRepr fv
flv1 BVFlavorRepr fv
flv2
= forall a. a -> Maybe a
Just (forall k (f :: k -> Type) (x :: k). f x -> Some f
Some BVFlavorRepr fv
flv1)
| Bool
otherwise
= forall a. Maybe a
Nothing
floatIEEEArithBinOp
:: (e ~ Expr t)
=> ( FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOp :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOp FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor ExprBuilder t st fs
sym e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y =
let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor FloatPrecisionRepr fpp
fpp e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y
floatIEEEArithBinOpR
:: (e ~ Expr t)
=> ( FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
)
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithBinOpR FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor ExprBuilder t st fs
sym RoundingMode
r e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y =
let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor FloatPrecisionRepr fpp
fpp RoundingMode
r e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y
floatIEEEArithUnOp
:: (e ~ Expr t)
=> ( FloatPrecisionRepr fpp
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOp :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOp FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp)
ctor ExprBuilder t st fs
sym e (BaseFloatType fpp)
x =
let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> e (BaseFloatType fpp) -> App e (BaseFloatType fpp)
ctor FloatPrecisionRepr fpp
fpp e (BaseFloatType fpp)
x
floatIEEEArithUnOpR
:: (e ~ Expr t)
=> ( FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
)
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOpR :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp))
-> ExprBuilder t st fs
-> RoundingMode
-> e (BaseFloatType fpp)
-> IO (e (BaseFloatType fpp))
floatIEEEArithUnOpR FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor ExprBuilder t st fs
sym RoundingMode
r e (BaseFloatType fpp)
x =
let BaseFloatRepr FloatPrecisionRepr fpp
FloatPrecisionRepr fpp
fpp = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e (BaseFloatType fpp)
x in forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ FloatPrecisionRepr fpp
-> RoundingMode
-> e (BaseFloatType fpp)
-> App e (BaseFloatType fpp)
ctor FloatPrecisionRepr fpp
fpp RoundingMode
r e (BaseFloatType fpp)
x
floatIEEELogicBinOp
:: (e ~ Expr t)
=> (e (BaseFloatType fpp) -> e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicBinOp :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicBinOp e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType
ctor ExprBuilder t st fs
sym e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ e (BaseFloatType fpp)
-> e (BaseFloatType fpp) -> App e 'BaseBoolType
ctor e (BaseFloatType fpp)
x e (BaseFloatType fpp)
y
floatIEEELogicUnOp
:: (e ~ Expr t)
=> (e (BaseFloatType fpp) -> App e BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e BaseBoolType)
floatIEEELogicUnOp :: forall (e :: BaseType -> Type) t (fpp :: FloatPrecision)
(st :: Type -> Type) fs.
(e ~ Expr t) =>
(e (BaseFloatType fpp) -> App e 'BaseBoolType)
-> ExprBuilder t st fs
-> e (BaseFloatType fpp)
-> IO (e 'BaseBoolType)
floatIEEELogicUnOp e (BaseFloatType fpp) -> App e 'BaseBoolType
ctor ExprBuilder t st fs
sym e (BaseFloatType fpp)
x = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> App (Expr t) tp -> IO (Expr t tp)
sbMakeExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ e (BaseFloatType fpp) -> App e 'BaseBoolType
ctor e (BaseFloatType fpp)
x
type instance SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi =
BaseRealType
instance IsInterpretedFloatExprBuilder (ExprBuilder t st (Flags FloatReal)) where
iFloatPZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatPZero ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
iFloatNZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatNZero ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
iFloatNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatNaN ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ = forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"NaN cannot be represented as a real value."
iFloatPInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatPInf ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ = forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"+Infinity cannot be represented as a real value."
iFloatNInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatNInf ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ = forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"-Infinity cannot be represented as a real value."
iFloatLitRational :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> Rational
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatLitRational ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ = forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym
iFloatLitSingle :: ExprBuilder t st (Flags FloatReal)
-> Float
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatReal)) SingleFloat)
iFloatLitSingle ExprBuilder t st (Flags FloatReal)
sym = forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational
iFloatLitDouble :: ExprBuilder t st (Flags FloatReal)
-> Double
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatReal)) DoubleFloat)
iFloatLitDouble ExprBuilder t st (Flags FloatReal)
sym = forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational
iFloatLitLongDouble :: ExprBuilder t st (Flags FloatReal)
-> X86_80Val
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatReal)) X86_80Float)
iFloatLitLongDouble ExprBuilder t st (Flags FloatReal)
sym X86_80Val
x =
case X86_80Val -> Maybe Rational
fp80ToRational X86_80Val
x of
Maybe Rational
Nothing -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (String
"80-bit floating point value does not represent a rational number: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show X86_80Val
x)
Just Rational
r -> forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatReal)
sym Rational
r
iFloatNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatNeg = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymReal sym)
realNeg
iFloatAbs :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatAbs = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymReal sym)
realAbs
iFloatSqrt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatSqrt ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymReal sym)
realSqrt ExprBuilder t st (Flags FloatReal)
sym
iFloatAdd :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatAdd ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realAdd ExprBuilder t st (Flags FloatReal)
sym
iFloatSub :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatSub ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realSub ExprBuilder t st (Flags FloatReal)
sym
iFloatMul :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatMul ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realMul ExprBuilder t st (Flags FloatReal)
sym
iFloatDiv :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatDiv ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realDiv ExprBuilder t st (Flags FloatReal)
sym
iFloatRem :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatRem = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realMod
iFloatMin :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatMin ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y = do
Expr t 'BaseBoolType
c <- forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLe ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realIte ExprBuilder t st (Flags FloatReal)
sym Expr t 'BaseBoolType
c SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
iFloatMax :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatMax ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y = do
Expr t 'BaseBoolType
c <- forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGe ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realIte ExprBuilder t st (Flags FloatReal)
sym Expr t 'BaseBoolType
c SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y
iFloatFMA :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatFMA ExprBuilder t st (Flags FloatReal)
sym RoundingMode
_ SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
z = do
Expr t BaseRealType
tmp <- (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realMul ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
y)
forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realAdd ExprBuilder t st (Flags FloatReal)
sym Expr t BaseRealType
tmp SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
z
iFloatEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatEq = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq
iFloatNe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatNe = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realNe
iFloatFpEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatFpEq = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq
iFloatFpApart :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatFpApart = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realNe
iFloatLe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatLe = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLe
iFloatLt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatLt = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLt
iFloatGe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatGe = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGe
iFloatGt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatGt = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGt
iFloatIte :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> Pred (ExprBuilder t st (Flags FloatReal))
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatIte = forall sym.
IsExprBuilder sym =>
sym -> Pred sym -> SymReal sym -> SymReal sym -> IO (SymReal sym)
realIte
iFloatIsNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsNaN ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st (Flags FloatReal)
sym
iFloatIsInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsInf ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st (Flags FloatReal)
sym
iFloatIsZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsZero ExprBuilder t st (Flags FloatReal)
sym = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realEq ExprBuilder t st (Flags FloatReal)
sym forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
iFloatIsPos :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsPos ExprBuilder t st (Flags FloatReal)
sym = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLt ExprBuilder t st (Flags FloatReal)
sym forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
iFloatIsNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsNeg ExprBuilder t st (Flags FloatReal)
sym = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realGt ExprBuilder t st (Flags FloatReal)
sym forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
iFloatIsSubnorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsSubnorm ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> Pred sym
falsePred ExprBuilder t st (Flags FloatReal)
sym
iFloatIsNorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatReal)))
iFloatIsNorm ExprBuilder t st (Flags FloatReal)
sym = forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realNe ExprBuilder t st (Flags FloatReal)
sym forall a b. (a -> b) -> a -> b
$ forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym
iFloatCast :: forall (fi :: FloatInfo) (fi' :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi'
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatCast ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ RoundingMode
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return
iFloatRound :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatRound ExprBuilder t st (Flags FloatReal)
sym RoundingMode
r SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x =
forall sym.
IsExprBuilder sym =>
sym -> SymInteger sym -> IO (SymReal sym)
integerToReal ExprBuilder t st (Flags FloatReal)
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< case RoundingMode
r of
RoundingMode
RNA -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realRound ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
RoundingMode
RTP -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realCeil ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
RoundingMode
RTN -> forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realFloor ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
RoundingMode
RTZ -> do
Expr t 'BaseBoolType
is_pos <- forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> SymReal sym -> IO (Pred sym)
realLt ExprBuilder t st (Flags FloatReal)
sym (forall sym. IsExprBuilder sym => sym -> SymReal sym
realZero ExprBuilder t st (Flags FloatReal)
sym) SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x
forall sym v.
IsExprBuilder sym =>
(sym -> Pred sym -> v -> v -> IO v)
-> sym -> Pred sym -> IO v -> IO v -> IO v
iteM forall sym.
IsExprBuilder sym =>
sym
-> Pred sym
-> SymInteger sym
-> SymInteger sym
-> IO (SymInteger sym)
intIte ExprBuilder t st (Flags FloatReal)
sym Expr t 'BaseBoolType
is_pos (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realFloor ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x) (forall sym.
IsExprBuilder sym =>
sym -> SymReal sym -> IO (SymInteger sym)
realCeil ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x)
RoundingMode
RNE -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Unsupported rond to nearest even for real values."
iFloatFromBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> SymBV
(ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatFromBinary ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ SymBV (ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi)
x
| Just (FnApp ExprSymFn t args (BaseBVType (FloatInfoToBitWidth fi))
fn Assignment (Expr t) args
args) <- forall t (tp :: BaseType).
Expr t tp -> Maybe (NonceApp t (Expr t) tp)
asNonceApp SymBV (ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi)
x
, Text
"uninterpreted_real_to_float_binary" forall a. Eq a => a -> a -> Bool
== SolverSymbol -> Text
solverSymbolAsText (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SolverSymbol
symFnName ExprSymFn t args (BaseBVType (FloatInfoToBitWidth fi))
fn)
, UninterpFnInfo Assignment BaseTypeRepr args
param_types (BaseBVRepr NatRepr w
_) <- forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo ExprSymFn t args (BaseBVType (FloatInfoToBitWidth fi))
fn
, (Assignment BaseTypeRepr ctx
Ctx.Empty Ctx.:> BaseTypeRepr tp
BaseRealRepr) <- Assignment BaseTypeRepr args
param_types
, (Assignment (Expr t) ctx
Ctx.Empty Ctx.:> Expr t tp
rval) <- Assignment (Expr t) args
args
= forall (m :: Type -> Type) a. Monad m => a -> m a
return Expr t tp
rval
| Bool
otherwise = forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkFreshUninterpFnApp ExprBuilder t st (Flags FloatReal)
sym
String
"uninterpreted_real_from_float_binary"
(forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymBV (ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi)
x)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
iFloatToBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO
(SymBV
(ExprBuilder t st (Flags FloatReal)) (FloatInfoToBitWidth fi))
iFloatToBinary ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
fi SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x =
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkFreshUninterpFnApp ExprBuilder t st (Flags FloatReal)
sym
String
"uninterpreted_real_to_float_binary"
(forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x)
(forall (fi :: FloatInfo).
FloatInfoRepr fi
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
floatInfoToBVTypeRepr FloatInfoRepr fi
fi)
iBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatReal)) w
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iBVToFloat ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ RoundingMode
_ = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymReal sym)
uintToReal ExprBuilder t st (Flags FloatReal)
sym
iSBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatReal)) w
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iSBVToFloat ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ RoundingMode
_ = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymBV sym w -> IO (SymReal sym)
sbvToReal ExprBuilder t st (Flags FloatReal)
sym
iRealToFloat :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatReal))
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iRealToFloat ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ RoundingMode
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return
iFloatToBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatReal)) w)
iFloatToBV ExprBuilder t st (Flags FloatReal)
sym NatRepr w
w RoundingMode
_ SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymReal sym -> NatRepr w -> IO (SymBV sym w)
realToBV ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x NatRepr w
w
iFloatToSBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatReal)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatReal)) w)
iFloatToSBV ExprBuilder t st (Flags FloatReal)
sym NatRepr w
w RoundingMode
_ SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x = forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> SymReal sym -> NatRepr w -> IO (SymBV sym w)
realToSBV ExprBuilder t st (Flags FloatReal)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
x NatRepr w
w
iFloatToReal :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi
-> IO (SymReal (ExprBuilder t st (Flags FloatReal)))
iFloatToReal ExprBuilder t st (Flags FloatReal)
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return
iFloatSpecialFunction :: forall (fi :: FloatInfo) (args :: Ctx Type).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> SpecialFunction args
-> Assignment
(SpecialFnArg
(SymExpr (ExprBuilder t st (Flags FloatReal)))
(SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
args
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatReal)) fi)
iFloatSpecialFunction ExprBuilder t st (Flags FloatReal)
sym FloatInfoRepr fi
_ SpecialFunction args
fn Assignment
(SpecialFnArg
(SymExpr (ExprBuilder t st (Flags FloatReal)))
(SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
args
args = forall sym (args :: Ctx Type).
IsExprBuilder sym =>
sym
-> SpecialFunction args
-> Assignment (SpecialFnArg (SymExpr sym) BaseRealType) args
-> IO (SymReal sym)
realSpecialFunction ExprBuilder t st (Flags FloatReal)
sym SpecialFunction args
fn Assignment
(SpecialFnArg
(SymExpr (ExprBuilder t st (Flags FloatReal)))
(SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi))
args
args
iFloatBaseTypeRepr :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatReal)
-> FloatInfoRepr fi
-> BaseTypeRepr
(SymInterpretedFloatType (ExprBuilder t st (Flags FloatReal)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatReal)
_ FloatInfoRepr fi
_ = forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
type instance SymInterpretedFloatType (ExprBuilder t st (Flags FloatUninterpreted)) fi =
BaseBVType (FloatInfoToBitWidth fi)
instance IsInterpretedFloatExprBuilder (ExprBuilder t st (Flags FloatUninterpreted)) where
iFloatPZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatPZero ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_pzero" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
iFloatNZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatNZero ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_nzero" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
iFloatNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatNaN ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_nan" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
iFloatPInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatPInf ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_pinf" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
iFloatNInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatNInf ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
"uninterpreted_float_ninf" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
iFloatLitRational :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> Rational
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatLitRational ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr fi
fi Rational
x = forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal sym
-> IO (SymInterpretedFloat sym fi)
iRealToFloat ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr fi
fi RoundingMode
RNE forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym.
IsExprBuilder sym =>
sym -> Rational -> IO (SymReal sym)
realLit ExprBuilder t st (Flags FloatUninterpreted)
sym Rational
x
iFloatLitSingle :: ExprBuilder t st (Flags FloatUninterpreted)
-> Float
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) SingleFloat)
iFloatLitSingle ExprBuilder t st (Flags FloatUninterpreted)
sym Float
x =
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SymBV sym (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat sym fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr SingleFloat
SingleFloatRepr
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatUninterpreted)
sym forall (n :: Natural). KnownNat n => NatRepr n
knownNat forall a b. (a -> b) -> a -> b
$ Word32 -> BV 32
BV.word32 forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 Float
x)
iFloatLitDouble :: ExprBuilder t st (Flags FloatUninterpreted)
-> Double
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) DoubleFloat)
iFloatLitDouble ExprBuilder t st (Flags FloatUninterpreted)
sym Double
x =
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SymBV sym (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat sym fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr DoubleFloat
DoubleFloatRepr
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatUninterpreted)
sym forall (n :: Natural). KnownNat n => NatRepr n
knownNat forall a b. (a -> b) -> a -> b
$ Word64 -> BV 64
BV.word64 forall a b. (a -> b) -> a -> b
$ Double -> Word64
castDoubleToWord64 Double
x)
iFloatLitLongDouble :: ExprBuilder t st (Flags FloatUninterpreted)
-> X86_80Val
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) X86_80Float)
iFloatLitLongDouble ExprBuilder t st (Flags FloatUninterpreted)
sym X86_80Val
x =
forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> SymBV sym (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat sym fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr X86_80Float
X86_80FloatRepr
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatUninterpreted)
sym forall (n :: Natural). KnownNat n => NatRepr n
knownNat forall a b. (a -> b) -> a -> b
$ forall (w :: Natural). NatRepr w -> Integer -> BV w
BV.mkBV forall (n :: Natural). KnownNat n => NatRepr n
knownNat forall a b. (a -> b) -> a -> b
$ X86_80Val -> Integer
fp80ToBits X86_80Val
x)
iFloatNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatNeg = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e bt)
floatUninterpArithUnOp String
"uninterpreted_float_neg"
iFloatAbs :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatAbs = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e bt)
floatUninterpArithUnOp String
"uninterpreted_float_abs"
iFloatSqrt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatSqrt = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> RoundingMode -> e bt -> IO (e bt)
floatUninterpArithUnOpR String
"uninterpreted_float_sqrt"
iFloatAdd :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatAdd = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
"uninterpreted_float_add"
iFloatSub :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatSub = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
"uninterpreted_float_sub"
iFloatMul :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatMul = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
"uninterpreted_float_mul"
iFloatDiv :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatDiv = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
"uninterpreted_float_div"
iFloatRem :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatRem = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp String
"uninterpreted_float_rem"
iFloatMin :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatMin = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp String
"uninterpreted_float_min"
iFloatMax :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatMax = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp String
"uninterpreted_float_max"
iFloatFMA :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatFMA ExprBuilder t st (Flags FloatUninterpreted)
sym RoundingMode
r SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
y SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
z = do
let ret_type :: BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
ret_type = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x
Expr t BaseIntegerType
r_arg <- forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt ExprBuilder t st (Flags FloatUninterpreted)
sym RoundingMode
r
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st (Flags FloatUninterpreted)
sym
String
"uninterpreted_float_fma"
(forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> Expr t BaseIntegerType
r_arg forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
y forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
z)
BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
ret_type
iFloatEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatEq = forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym -> SymExpr sym tp -> SymExpr sym tp -> IO (Pred sym)
isEq
iFloatNe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatNe ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
y = forall sym. IsExprBuilder sym => sym -> Pred sym -> IO (Pred sym)
notPred ExprBuilder t st (Flags FloatUninterpreted)
sym forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym -> SymExpr sym tp -> SymExpr sym tp -> IO (Pred sym)
isEq ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
y
iFloatFpEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatFpEq = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_fp_eq"
iFloatFpApart :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatFpApart = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_fp_apart"
iFloatLe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatLe = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_le"
iFloatLt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatLt = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_lt"
iFloatGe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatGe ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
y = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_le" ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
y SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x
iFloatGt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatGt ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
y = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicBinOp String
"uninterpreted_float_lt" ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
y SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x
iFloatIte :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> Pred (ExprBuilder t st (Flags FloatUninterpreted))
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatIte = forall sym (tp :: BaseType).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymExpr sym tp
-> SymExpr sym tp
-> IO (SymExpr sym tp)
baseTypeIte
iFloatIsNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsNaN = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_nan"
iFloatIsInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsInf = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_inf"
iFloatIsZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsZero = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_zero"
iFloatIsPos :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsPos = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_pos"
iFloatIsNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsNeg = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_neg"
iFloatIsSubnorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsSubnorm = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_subnorm"
iFloatIsNorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatIsNorm = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicUnOp String
"uninterpreted_float_is_norm"
iFloatCast :: forall (fi :: FloatInfo) (fi' :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi'
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatCast ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_float_cast" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
iFloatRound :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatRound = forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> RoundingMode -> e bt -> IO (e bt)
floatUninterpArithUnOpR String
"uninterpreted_float_round"
iFloatFromBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> SymBV
(ExprBuilder t st (Flags FloatUninterpreted))
(FloatInfoToBitWidth fi)
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatFromBinary ExprBuilder t st (Flags FloatUninterpreted)
_ FloatInfoRepr fi
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return
iFloatToBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO
(SymBV
(ExprBuilder t st (Flags FloatUninterpreted))
(FloatInfoToBitWidth fi))
iFloatToBinary ExprBuilder t st (Flags FloatUninterpreted)
_ FloatInfoRepr fi
_ = forall (m :: Type -> Type) a. Monad m => a -> m a
return
iBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iBVToFloat ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_bv_to_float" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
iSBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iSBVToFloat ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_sbv_to_float" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
iRealToFloat :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatUninterpreted))
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iRealToFloat ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_real_to_float" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym
iFloatToBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w)
iFloatToBV ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_float_to_bv" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr
iFloatToSBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatUninterpreted)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatUninterpreted)) w)
iFloatToSBV ExprBuilder t st (Flags FloatUninterpreted)
sym =
forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
"uninterpreted_float_to_sbv" ExprBuilder t st (Flags FloatUninterpreted)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr
iFloatToReal :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
-> IO (SymReal (ExprBuilder t st (Flags FloatUninterpreted)))
iFloatToReal ExprBuilder t st (Flags FloatUninterpreted)
sym SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x =
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st (Flags FloatUninterpreted)
sym
String
"uninterpreted_float_to_real"
(forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi
x)
forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
iFloatSpecialFunction :: forall (fi :: FloatInfo) (args :: Ctx Type).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> SpecialFunction args
-> Assignment
(SpecialFnArg
(SymExpr (ExprBuilder t st (Flags FloatUninterpreted)))
(SymInterpretedFloatType
(ExprBuilder t st (Flags FloatUninterpreted)) fi))
args
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatSpecialFunction ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr fi
fi SpecialFunction args
fn Assignment
(SpecialFnArg
(SymExpr (ExprBuilder t st (Flags FloatUninterpreted)))
(SymInterpretedFloatType
(ExprBuilder t st (Flags FloatUninterpreted)) fi))
args
args =
forall (e :: BaseType -> Type) t (sf :: Type -> Type) tfs
(bt :: BaseType) (args :: Ctx Type).
(e ~ Expr t) =>
ExprBuilder t sf tfs
-> BaseTypeRepr bt
-> SpecialFunction args
-> Assignment (SpecialFnArg e bt) args
-> IO (e bt)
floatUninterpSpecialFn ExprBuilder t st (Flags FloatUninterpreted)
sym (forall sym (fi :: FloatInfo).
IsInterpretedFloatExprBuilder sym =>
sym
-> FloatInfoRepr fi
-> BaseTypeRepr (SymInterpretedFloatType sym fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
sym FloatInfoRepr fi
fi) SpecialFunction args
fn Assignment
(SpecialFnArg
(SymExpr (ExprBuilder t st (Flags FloatUninterpreted)))
(SymInterpretedFloatType
(ExprBuilder t st (Flags FloatUninterpreted)) fi))
args
args
iFloatBaseTypeRepr :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatUninterpreted)
-> FloatInfoRepr fi
-> BaseTypeRepr
(SymInterpretedFloatType
(ExprBuilder t st (Flags FloatUninterpreted)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatUninterpreted)
_ = forall (fi :: FloatInfo).
FloatInfoRepr fi
-> BaseTypeRepr (BaseBVType (FloatInfoToBitWidth fi))
floatInfoToBVTypeRepr
floatUninterpArithBinOp
:: (e ~ Expr t) => String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOp String
fn ExprBuilder t st fs
sym e bt
x e bt
y =
let ret_type :: BaseTypeRepr bt
ret_type = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
in forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
y) BaseTypeRepr bt
ret_type
floatUninterpSpecialFn
:: (e ~ Expr t)
=> ExprBuilder t sf tfs
-> BaseTypeRepr bt
-> SFn.SpecialFunction args
-> Assignment (SFn.SpecialFnArg e bt) args
-> IO (e bt)
floatUninterpSpecialFn :: forall (e :: BaseType -> Type) t (sf :: Type -> Type) tfs
(bt :: BaseType) (args :: Ctx Type).
(e ~ Expr t) =>
ExprBuilder t sf tfs
-> BaseTypeRepr bt
-> SpecialFunction args
-> Assignment (SpecialFnArg e bt) args
-> IO (e bt)
floatUninterpSpecialFn ExprBuilder t sf tfs
sym BaseTypeRepr bt
btr SpecialFunction args
fn Assignment (SpecialFnArg e bt) args
Ctx.Empty =
do SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol (String
"uninterpreted_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SpecialFunction args
fn)
ExprSymFn t EmptyCtx bt
fn' <- forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn ExprBuilder t sf tfs
sym SolverSymbol
fn_name forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty BaseTypeRepr bt
btr forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t sf tfs
sym ExprSymFn t EmptyCtx bt
fn' forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty
floatUninterpSpecialFn ExprBuilder t sf tfs
sym BaseTypeRepr bt
btr SpecialFunction args
fn (Assignment (SpecialFnArg e bt) ctx
Ctx.Empty Ctx.:> SFn.SpecialFnArg e bt
x) =
do SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol (String
"uninterpreted_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SpecialFunction args
fn)
ExprSymFn t (EmptyCtx ::> bt) bt
fn' <- forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn ExprBuilder t sf tfs
sym SolverSymbol
fn_name (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> BaseTypeRepr bt
btr) BaseTypeRepr bt
btr forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t sf tfs
sym ExprSymFn t (EmptyCtx ::> bt) bt
fn' (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x)
floatUninterpSpecialFn ExprBuilder t sf tfs
sym BaseTypeRepr bt
btr SpecialFunction args
fn (Assignment (SpecialFnArg e bt) ctx
Ctx.Empty Ctx.:> SFn.SpecialFnArg e bt
x Ctx.:> SFn.SpecialFnArg e bt
y) =
do SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol (String
"uninterpreted_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show SpecialFunction args
fn)
ExprSymFn t ((EmptyCtx ::> bt) ::> bt) bt
fn' <- forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn ExprBuilder t sf tfs
sym SolverSymbol
fn_name (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> BaseTypeRepr bt
btr forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> BaseTypeRepr bt
btr) BaseTypeRepr bt
btr forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn ExprBuilder t sf tfs
sym ExprSymFn t ((EmptyCtx ::> bt) ::> bt) bt
fn' (forall {k} (ctx :: Ctx k) (f :: k -> Type).
(ctx ~ EmptyCtx) =>
Assignment f ctx
Ctx.Empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
y)
floatUninterpSpecialFn ExprBuilder t sf tfs
_sym BaseTypeRepr bt
_btr SpecialFunction args
fn Assignment (SpecialFnArg e bt) args
_args =
forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Special function with unexpected arity", forall a. Show a => a -> String
show SpecialFunction args
fn]
floatUninterpArithBinOpR
:: (e ~ Expr t)
=> String
-> ExprBuilder t st fs
-> RoundingMode
-> e bt
-> e bt
-> IO (e bt)
floatUninterpArithBinOpR :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> RoundingMode -> e bt -> e bt -> IO (e bt)
floatUninterpArithBinOpR String
fn ExprBuilder t st fs
sym RoundingMode
r e bt
x e bt
y = do
let ret_type :: BaseTypeRepr bt
ret_type = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
e BaseIntegerType
r_arg <- forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt ExprBuilder t st fs
sym RoundingMode
r
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e BaseIntegerType
r_arg forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
y) BaseTypeRepr bt
ret_type
floatUninterpArithUnOp
:: (e ~ Expr t) => String -> ExprBuilder t st fs -> e bt -> IO (e bt)
floatUninterpArithUnOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e bt)
floatUninterpArithUnOp String
fn ExprBuilder t st fs
sym e bt
x =
let ret_type :: BaseTypeRepr bt
ret_type = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
in forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x) BaseTypeRepr bt
ret_type
floatUninterpArithUnOpR
:: (e ~ Expr t)
=> String
-> ExprBuilder t st fs
-> RoundingMode
-> e bt
-> IO (e bt)
floatUninterpArithUnOpR :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> RoundingMode -> e bt -> IO (e bt)
floatUninterpArithUnOpR String
fn ExprBuilder t st fs
sym RoundingMode
r e bt
x = do
let ret_type :: BaseTypeRepr bt
ret_type = forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType e bt
x
e BaseIntegerType
r_arg <- forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt ExprBuilder t st fs
sym RoundingMode
r
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e BaseIntegerType
r_arg forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x) BaseTypeRepr bt
ret_type
floatUninterpArithCt
:: (e ~ Expr t)
=> String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> IO (e bt)
floatUninterpArithCt :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> BaseTypeRepr bt -> IO (e bt)
floatUninterpArithCt String
fn ExprBuilder t st fs
sym BaseTypeRepr bt
ret_type =
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty BaseTypeRepr bt
ret_type
floatUninterpLogicBinOp
:: (e ~ Expr t)
=> String
-> ExprBuilder t st fs
-> e bt
-> e bt
-> IO (e BaseBoolType)
floatUninterpLogicBinOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs -> e bt -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicBinOp String
fn ExprBuilder t st fs
sym e bt
x e bt
y =
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
y) forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
floatUninterpLogicUnOp
:: (e ~ Expr t)
=> String
-> ExprBuilder t st fs
-> e bt
-> IO (e BaseBoolType)
floatUninterpLogicUnOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType).
(e ~ Expr t) =>
String -> ExprBuilder t st fs -> e bt -> IO (e 'BaseBoolType)
floatUninterpLogicUnOp String
fn ExprBuilder t st fs
sym e bt
x =
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt
x) forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
floatUninterpCastOp
:: (e ~ Expr t)
=> String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp :: forall (e :: BaseType -> Type) t (st :: Type -> Type) fs
(bt :: BaseType) (bt' :: BaseType).
(e ~ Expr t) =>
String
-> ExprBuilder t st fs
-> BaseTypeRepr bt
-> RoundingMode
-> e bt'
-> IO (e bt)
floatUninterpCastOp String
fn ExprBuilder t st fs
sym BaseTypeRepr bt
ret_type RoundingMode
r e bt'
x = do
e BaseIntegerType
r_arg <- forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt ExprBuilder t st fs
sym RoundingMode
r
forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp ExprBuilder t st fs
sym String
fn (forall {k} (f :: k -> Type). Assignment f EmptyCtx
Ctx.empty forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e BaseIntegerType
r_arg forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> e bt'
x) BaseTypeRepr bt
ret_type
roundingModeToSymInt
:: (sym ~ ExprBuilder t st fs) => sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt :: forall sym t (st :: Type -> Type) fs.
(sym ~ ExprBuilder t st fs) =>
sym -> RoundingMode -> IO (SymInteger sym)
roundingModeToSymInt sym
sym = forall sym.
IsExprBuilder sym =>
sym -> Integer -> IO (SymInteger sym)
intLit sym
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum
type instance SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi =
BaseFloatType (FloatInfoToPrecision fi)
instance IsInterpretedFloatExprBuilder (ExprBuilder t st (Flags FloatIEEE)) where
iFloatPZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatPZero ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatPZero ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iFloatNZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatNZero ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatNZero ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iFloatNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatNaN ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatNaN ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iFloatPInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatPInf ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatPInf ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iFloatNInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatNInf ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> IO (SymFloat sym fpp)
floatNInf ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iFloatLitRational :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> Rational
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatLitRational ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> FloatPrecisionRepr fpp -> Rational -> IO (SymFloat sym fpp)
floatLitRational ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iFloatLitSingle :: ExprBuilder t st (Flags FloatIEEE)
-> Float
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatIEEE)) SingleFloat)
iFloatLitSingle ExprBuilder t st (Flags FloatIEEE)
sym Float
x =
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatIEEE)
sym forall (n :: Natural). KnownNat n => NatRepr n
knownNat forall a b. (a -> b) -> a -> b
$ Word32 -> BV 32
BV.word32 forall a b. (a -> b) -> a -> b
$ Float -> Word32
castFloatToWord32 Float
x)
iFloatLitDouble :: ExprBuilder t st (Flags FloatIEEE)
-> Double
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatIEEE)) DoubleFloat)
iFloatLitDouble ExprBuilder t st (Flags FloatIEEE)
sym Double
x =
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr
forall (m :: Type -> Type) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatIEEE)
sym forall (n :: Natural). KnownNat n => NatRepr n
knownNat forall a b. (a -> b) -> a -> b
$ Word64 -> BV 64
BV.word64 forall a b. (a -> b) -> a -> b
$ Double -> Word64
castDoubleToWord64 Double
x)
iFloatLitLongDouble :: ExprBuilder t st (Flags FloatIEEE)
-> X86_80Val
-> IO
(SymInterpretedFloat
(ExprBuilder t st (Flags FloatIEEE)) X86_80Float)
iFloatLitLongDouble ExprBuilder t st (Flags FloatIEEE)
sym (X86_80Val Word16
e Word64
s) = do
Expr t (BaseBVType 16)
el <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatIEEE)
sym (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @16) forall a b. (a -> b) -> a -> b
$ Word16 -> BV 16
BV.word16 Word16
e
Expr t (BaseBVType 64)
sl <- forall sym (w :: Natural).
(IsExprBuilder sym, 1 <= w) =>
sym -> NatRepr w -> BV w -> IO (SymBV sym w)
bvLit ExprBuilder t st (Flags FloatIEEE)
sym (forall (n :: Natural). KnownNat n => NatRepr n
knownNat @64) forall a b. (a -> b) -> a -> b
$ Word64 -> BV 64
BV.word64 Word64
s
Expr t (BaseBVType (16 + 64))
fl <- forall sym (u :: Natural) (v :: Natural).
(IsExprBuilder sym, 1 <= u, 1 <= v) =>
sym -> SymBV sym u -> SymBV sym v -> IO (SymBV sym (u + v))
bvConcat ExprBuilder t st (Flags FloatIEEE)
sym Expr t (BaseBVType 16)
el Expr t (BaseBVType 64)
sl
forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr Expr t (BaseBVType (16 + 64))
fl
iFloatNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatNeg = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatNeg
iFloatAbs :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatAbs = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatAbs
iFloatSqrt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatSqrt = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> RoundingMode -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatSqrt
iFloatAdd :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatAdd = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatAdd
iFloatSub :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatSub = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatSub
iFloatMul :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatMul = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatMul
iFloatDiv :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatDiv = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatDiv
iFloatRem :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatRem = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatRem
iFloatMin :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatMin = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatMin
iFloatMax :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatMax = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> SymFloat sym fpp -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatMax
iFloatFMA :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatFMA = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> RoundingMode
-> SymFloat sym fpp
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatFMA
iFloatEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatEq = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatEq
iFloatNe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatNe = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatNe
iFloatFpEq :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatFpEq = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatFpEq
iFloatFpApart :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatFpApart = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatFpApart
iFloatLe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatLe = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLe
iFloatLt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatLt = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatLt
iFloatGe :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatGe = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatGe
iFloatGt :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatGt = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> SymFloat sym fpp -> IO (Pred sym)
floatGt
iFloatIte :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> Pred (ExprBuilder t st (Flags FloatIEEE))
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatIte = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> Pred sym
-> SymFloat sym fpp
-> SymFloat sym fpp
-> IO (SymFloat sym fpp)
floatIte
iFloatIsNaN :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsNaN = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNaN
iFloatIsInf :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsInf = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsInf
iFloatIsZero :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsZero = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsZero
iFloatIsPos :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsPos = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsPos
iFloatIsNeg :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsNeg = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNeg
iFloatIsSubnorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsSubnorm = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsSubnorm
iFloatIsNorm :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (Pred (ExprBuilder t st (Flags FloatIEEE)))
iFloatIsNorm = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (Pred sym)
floatIsNorm
iFloatCast :: forall (fi :: FloatInfo) (fi' :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi'
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatCast ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (fpp :: FloatPrecision) (fpp' :: FloatPrecision).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymFloat sym fpp'
-> IO (SymFloat sym fpp)
floatCast ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iFloatRound :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatRound = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> RoundingMode -> SymFloat sym fpp -> IO (SymFloat sym fpp)
floatRound
iFloatFromBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> SymBV
(ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatInfoRepr fi
fi SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x = case FloatInfoRepr fi
fi of
FloatInfoRepr fi
HalfFloatRepr -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
FloatInfoRepr fi
SingleFloatRepr -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
FloatInfoRepr fi
DoubleFloatRepr -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
FloatInfoRepr fi
QuadFloatRepr -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> FloatPrecisionRepr (FloatingPointPrecision eb sb)
-> SymBV sym (eb + sb)
-> IO (SymFloat sym (FloatingPointPrecision eb sb))
floatFromBinary ExprBuilder t st (Flags FloatIEEE)
sym forall k (f :: k -> Type) (ctx :: k). KnownRepr f ctx => f ctx
knownRepr SymBV (ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi)
x
FloatInfoRepr fi
X86_80FloatRepr -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"x86_80 is not an IEEE-754 format."
FloatInfoRepr fi
DoubleDoubleFloatRepr -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"double-double is not an IEEE-754 format."
iFloatToBinary :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO
(SymBV
(ExprBuilder t st (Flags FloatIEEE)) (FloatInfoToBitWidth fi))
iFloatToBinary ExprBuilder t st (Flags FloatIEEE)
sym FloatInfoRepr fi
fi SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x = case FloatInfoRepr fi
fi of
FloatInfoRepr fi
HalfFloatRepr -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st (Flags FloatIEEE)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
FloatInfoRepr fi
SingleFloatRepr -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st (Flags FloatIEEE)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
FloatInfoRepr fi
DoubleFloatRepr -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st (Flags FloatIEEE)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
FloatInfoRepr fi
QuadFloatRepr -> forall sym (eb :: Natural) (sb :: Natural).
(IsExprBuilder sym, 2 <= eb, 2 <= sb) =>
sym
-> SymFloat sym (FloatingPointPrecision eb sb)
-> IO (SymBV sym (eb + sb))
floatToBinary ExprBuilder t st (Flags FloatIEEE)
sym SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
x
FloatInfoRepr fi
X86_80FloatRepr -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"x86_80 is not an IEEE-754 format."
FloatInfoRepr fi
DoubleDoubleFloatRepr -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"double-double is not an IEEE-754 format."
iBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) w
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iBVToFloat ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV sym w
-> IO (SymFloat sym fpp)
bvToFloat ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iSBVToFloat :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> RoundingMode
-> SymBV (ExprBuilder t st (Flags FloatIEEE)) w
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iSBVToFloat ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymBV sym w
-> IO (SymFloat sym fpp)
sbvToFloat ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iRealToFloat :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> RoundingMode
-> SymReal (ExprBuilder t st (Flags FloatIEEE))
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iRealToFloat ExprBuilder t st (Flags FloatIEEE)
sym = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> RoundingMode
-> SymReal sym
-> IO (SymFloat sym fpp)
realToFloat ExprBuilder t st (Flags FloatIEEE)
sym forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
iFloatToBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
iFloatToBV = forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> NatRepr w
-> RoundingMode
-> SymFloat sym fpp
-> IO (SymBV sym w)
floatToBV
iFloatToSBV :: forall (w :: Natural) (fi :: FloatInfo).
(1 <= w) =>
ExprBuilder t st (Flags FloatIEEE)
-> NatRepr w
-> RoundingMode
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymBV (ExprBuilder t st (Flags FloatIEEE)) w)
iFloatToSBV = forall sym (w :: Natural) (fpp :: FloatPrecision).
(IsExprBuilder sym, 1 <= w) =>
sym
-> NatRepr w
-> RoundingMode
-> SymFloat sym fpp
-> IO (SymBV sym w)
floatToSBV
iFloatToReal :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi
-> IO (SymReal (ExprBuilder t st (Flags FloatIEEE)))
iFloatToReal = forall sym (fpp :: FloatPrecision).
IsExprBuilder sym =>
sym -> SymFloat sym fpp -> IO (SymReal sym)
floatToReal
iFloatSpecialFunction :: forall (fi :: FloatInfo) (args :: Ctx Type).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> SpecialFunction args
-> Assignment
(SpecialFnArg
(SymExpr (ExprBuilder t st (Flags FloatIEEE)))
(SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
args
-> IO (SymInterpretedFloat (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatSpecialFunction ExprBuilder t st (Flags FloatIEEE)
sym FloatInfoRepr fi
fi SpecialFunction args
fn Assignment
(SpecialFnArg
(SymExpr (ExprBuilder t st (Flags FloatIEEE)))
(SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
args
args =
forall sym (fpp :: FloatPrecision) (args :: Ctx Type).
IsExprBuilder sym =>
sym
-> FloatPrecisionRepr fpp
-> SpecialFunction args
-> Assignment (SpecialFnArg (SymExpr sym) (BaseFloatType fpp)) args
-> IO (SymFloat sym fpp)
floatSpecialFunction ExprBuilder t st (Flags FloatIEEE)
sym (forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr FloatInfoRepr fi
fi) SpecialFunction args
fn Assignment
(SpecialFnArg
(SymExpr (ExprBuilder t st (Flags FloatIEEE)))
(SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi))
args
args
iFloatBaseTypeRepr :: forall (fi :: FloatInfo).
ExprBuilder t st (Flags FloatIEEE)
-> FloatInfoRepr fi
-> BaseTypeRepr
(SymInterpretedFloatType (ExprBuilder t st (Flags FloatIEEE)) fi)
iFloatBaseTypeRepr ExprBuilder t st (Flags FloatIEEE)
_ = forall (fpp :: FloatPrecision).
FloatPrecisionRepr fpp -> BaseTypeRepr ('BaseFloatType fpp)
BaseFloatRepr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (fi :: FloatInfo).
FloatInfoRepr fi -> FloatPrecisionRepr (FloatInfoToPrecision fi)
floatInfoToPrecisionRepr
instance IsSymExprBuilder (ExprBuilder t st fs) where
freshConstant :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp = do
ExprBoundVar t tp
v <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp VarKind
UninterpVarKind forall a. Maybe a
Nothing
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t tp
v)
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t tp
v
freshBoundedBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SolverSymbol
-> NatRepr w
-> Maybe Natural
-> Maybe Natural
-> IO (SymBV (ExprBuilder t st fs) w)
freshBoundedBV ExprBuilder t st fs
sym SolverSymbol
nm NatRepr w
w Maybe Natural
Nothing Maybe Natural
Nothing = forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
nm (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w)
freshBoundedBV ExprBuilder t st fs
sym SolverSymbol
nm NatRepr w
w Maybe Natural
mlo Maybe Natural
mhi =
do forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
boundsOK (forall e a. Exception e => e -> IO a
Ex.throwIO (forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Integral a => a -> Integer
toInteger Maybe Natural
mlo) (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Integral a => a -> Integer
toInteger Maybe Natural
mhi)))
ExprBoundVar t ('BaseBVType w)
v <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) VarKind
UninterpVarKind (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! (forall (w :: Natural).
NatRepr w -> Integer -> Integer -> BVDomain w
BVD.range NatRepr w
w Integer
lo Integer
hi))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t ('BaseBVType w)
v)
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t ('BaseBVType w)
v
where
boundsOK :: Bool
boundsOK = Integer
lo forall a. Ord a => a -> a -> Bool
<= Integer
hi Bool -> Bool -> Bool
&& forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w forall a. Ord a => a -> a -> Bool
<= Integer
lo Bool -> Bool -> Bool
&& Integer
hi forall a. Ord a => a -> a -> Bool
<= forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w
lo :: Integer
lo = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (w :: Natural). NatRepr w -> Integer
minUnsigned NatRepr w
w) forall a. Integral a => a -> Integer
toInteger Maybe Natural
mlo
hi :: Integer
hi = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (w :: Natural). NatRepr w -> Integer
maxUnsigned NatRepr w
w) forall a. Integral a => a -> Integer
toInteger Maybe Natural
mhi
freshBoundedSBV :: forall (w :: Natural).
(1 <= w) =>
ExprBuilder t st fs
-> SolverSymbol
-> NatRepr w
-> Maybe Integer
-> Maybe Integer
-> IO (SymBV (ExprBuilder t st fs) w)
freshBoundedSBV ExprBuilder t st fs
sym SolverSymbol
nm NatRepr w
w Maybe Integer
Nothing Maybe Integer
Nothing = forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (SymExpr sym tp)
freshConstant ExprBuilder t st fs
sym SolverSymbol
nm (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w)
freshBoundedSBV ExprBuilder t st fs
sym SolverSymbol
nm NatRepr w
w Maybe Integer
mlo Maybe Integer
mhi =
do forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
boundsOK (forall e a. Exception e => e -> IO a
Ex.throwIO (forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) Maybe Integer
mlo Maybe Integer
mhi))
ExprBoundVar t ('BaseBVType w)
v <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm (forall (w :: Natural).
(1 <= w) =>
NatRepr w -> BaseTypeRepr ('BaseBVType w)
BaseBVRepr NatRepr w
w) VarKind
UninterpVarKind (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! (forall (w :: Natural).
NatRepr w -> Integer -> Integer -> BVDomain w
BVD.range NatRepr w
w Integer
lo Integer
hi))
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t ('BaseBVType w)
v)
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t ('BaseBVType w)
v
where
boundsOK :: Bool
boundsOK = Integer
lo forall a. Ord a => a -> a -> Bool
<= Integer
hi Bool -> Bool -> Bool
&& forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w forall a. Ord a => a -> a -> Bool
<= Integer
lo Bool -> Bool -> Bool
&& Integer
hi forall a. Ord a => a -> a -> Bool
<= forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w
lo :: Integer
lo = forall a. a -> Maybe a -> a
fromMaybe (forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
minSigned NatRepr w
w) Maybe Integer
mlo
hi :: Integer
hi = forall a. a -> Maybe a -> a
fromMaybe (forall (w :: Natural). (1 <= w) => NatRepr w -> Integer
maxSigned NatRepr w
w) Maybe Integer
mhi
freshBoundedInt :: ExprBuilder t st fs
-> SolverSymbol
-> Maybe Integer
-> Maybe Integer
-> IO (SymInteger (ExprBuilder t st fs))
freshBoundedInt ExprBuilder t st fs
sym SolverSymbol
nm Maybe Integer
mlo Maybe Integer
mhi =
do forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (forall {a}. Ord a => Maybe a -> Maybe a -> Bool
boundsOK Maybe Integer
mlo Maybe Integer
mhi) (forall e a. Exception e => e -> IO a
Ex.throwIO (forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange BaseTypeRepr BaseIntegerType
BaseIntegerRepr Maybe Integer
mlo Maybe Integer
mhi))
ExprBoundVar t BaseIntegerType
v <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr BaseIntegerType
BaseIntegerRepr VarKind
UninterpVarKind (forall {tp}. Maybe tp -> Maybe tp -> Maybe (ValueRange tp)
absVal Maybe Integer
mlo Maybe Integer
mhi)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t BaseIntegerType
v)
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t BaseIntegerType
v
where
boundsOK :: Maybe a -> Maybe a -> Bool
boundsOK (Just a
lo) (Just a
hi) = a
lo forall a. Ord a => a -> a -> Bool
<= a
hi
boundsOK Maybe a
_ Maybe a
_ = Bool
True
absVal :: Maybe tp -> Maybe tp -> Maybe (ValueRange tp)
absVal Maybe tp
Nothing Maybe tp
Nothing = forall a. Maybe a
Nothing
absVal (Just tp
lo) Maybe tp
Nothing = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (forall tp. tp -> ValueBound tp
Inclusive tp
lo) forall tp. ValueBound tp
Unbounded
absVal Maybe tp
Nothing (Just tp
hi) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange forall tp. ValueBound tp
Unbounded (forall tp. tp -> ValueBound tp
Inclusive tp
hi)
absVal (Just tp
lo) (Just tp
hi) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (forall tp. tp -> ValueBound tp
Inclusive tp
lo) (forall tp. tp -> ValueBound tp
Inclusive tp
hi)
freshBoundedReal :: ExprBuilder t st fs
-> SolverSymbol
-> Maybe Rational
-> Maybe Rational
-> IO (SymReal (ExprBuilder t st fs))
freshBoundedReal ExprBuilder t st fs
sym SolverSymbol
nm Maybe Rational
mlo Maybe Rational
mhi =
do forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (forall {a}. Ord a => Maybe a -> Maybe a -> Bool
boundsOK Maybe Rational
mlo Maybe Rational
mhi) (forall e a. Exception e => e -> IO a
Ex.throwIO (forall (bt :: BaseType).
BaseTypeRepr bt
-> Maybe (ConcreteValue bt)
-> Maybe (ConcreteValue bt)
-> InvalidRange
InvalidRange BaseTypeRepr BaseRealType
BaseRealRepr Maybe Rational
mlo Maybe Rational
mhi))
ExprBoundVar t BaseRealType
v <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr BaseRealType
BaseRealRepr VarKind
UninterpVarKind (Maybe Rational -> Maybe Rational -> Maybe RealAbstractValue
absVal Maybe Rational
mlo Maybe Rational
mhi)
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t BaseRealType
v)
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t BaseRealType
v
where
boundsOK :: Maybe a -> Maybe a -> Bool
boundsOK (Just a
lo) (Just a
hi) = a
lo forall a. Ord a => a -> a -> Bool
<= a
hi
boundsOK Maybe a
_ Maybe a
_ = Bool
True
absVal :: Maybe Rational -> Maybe Rational -> Maybe RealAbstractValue
absVal Maybe Rational
Nothing Maybe Rational
Nothing = forall a. Maybe a
Nothing
absVal (Just Rational
lo) Maybe Rational
Nothing = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (forall tp. tp -> ValueBound tp
Inclusive Rational
lo) forall tp. ValueBound tp
Unbounded) forall a. Maybe a
Nothing
absVal Maybe Rational
Nothing (Just Rational
hi) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange forall tp. ValueBound tp
Unbounded (forall tp. tp -> ValueBound tp
Inclusive Rational
hi)) forall a. Maybe a
Nothing
absVal (Just Rational
lo) (Just Rational
hi) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ValueRange Rational -> Maybe Bool -> RealAbstractValue
RAV (forall tp. ValueBound tp -> ValueBound tp -> ValueRange tp
MultiRange (forall tp. tp -> ValueBound tp
Inclusive Rational
lo) (forall tp. tp -> ValueBound tp
Inclusive Rational
hi)) forall a. Maybe a
Nothing
freshLatch :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
freshLatch ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp = do
ExprBoundVar t tp
v <- forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp VarKind
LatchVarKind forall a. Maybe a
Nothing
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
nm (forall t (tp :: BaseType). ExprBoundVar t tp -> SymbolBinding t
VarSymbolBinding ExprBoundVar t tp
v)
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr ExprBoundVar t tp
v
exprUninterpConstants :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SymExpr (ExprBuilder t st fs) tp
-> Set (Some (BoundVar (ExprBuilder t st fs)))
exprUninterpConstants ExprBuilder t st fs
_sym SymExpr (ExprBuilder t st fs) tp
expr =
(forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall s t. VarRecorder s t () -> ST s (CollectedVarInfo t)
VI.collectVarInfo forall a b. (a -> b) -> a -> b
$ forall t (tp :: BaseType) s.
Scope -> Expr t tp -> VarRecorder s t ()
VI.recordExprVars Scope
VI.ExistsOnly SymExpr (ExprBuilder t st fs) tp
expr) forall s a. s -> Getting a s a -> a
^. forall t.
Simple Lens (CollectedVarInfo t) (Set (Some (ExprBoundVar t)))
VI.uninterpConstants
freshBoundVar :: forall (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> IO (BoundVar (ExprBuilder t st fs) tp)
freshBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp =
forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> BaseTypeRepr tp
-> VarKind
-> Maybe (AbstractValue tp)
-> IO (ExprBoundVar t tp)
sbMakeBoundVar ExprBuilder t st fs
sym SolverSymbol
nm BaseTypeRepr tp
tp VarKind
QuantifierVarKind forall a. Maybe a
Nothing
varExpr :: forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> SymExpr (ExprBuilder t st fs) tp
varExpr ExprBuilder t st fs
_ = forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr
forallPred :: forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
forallPred ExprBuilder t st fs
sym BoundVar (ExprBuilder t st fs) tp
bv Pred (ExprBuilder t st fs)
e = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall t (tp1 :: BaseType) (e :: BaseType -> Type).
ExprBoundVar t tp1 -> e 'BaseBoolType -> NonceApp t e 'BaseBoolType
Forall BoundVar (ExprBuilder t st fs) tp
bv Pred (ExprBuilder t st fs)
e
existsPred :: forall (tp :: BaseType).
ExprBuilder t st fs
-> BoundVar (ExprBuilder t st fs) tp
-> Pred (ExprBuilder t st fs)
-> IO (Pred (ExprBuilder t st fs))
existsPred ExprBuilder t st fs
sym BoundVar (ExprBuilder t st fs) tp
bv Pred (ExprBuilder t st fs)
e = forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$ forall t (tp1 :: BaseType) (e :: BaseType -> Type).
ExprBoundVar t tp1 -> e 'BaseBoolType -> NonceApp t e 'BaseBoolType
Exists BoundVar (ExprBuilder t st fs) tp
bv Pred (ExprBuilder t st fs)
e
definedFn :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> Assignment (BoundVar (ExprBuilder t st fs)) args
-> SymExpr (ExprBuilder t st fs) ret
-> UnfoldPolicy
-> IO (SymFn (ExprBuilder t st fs) args ret)
definedFn ExprBuilder t st fs
sym SolverSymbol
fn_name Assignment (BoundVar (ExprBuilder t st fs)) args
bound_vars SymExpr (ExprBuilder t st fs) ret
result UnfoldPolicy
policy = do
ProgramLoc
l <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
Nonce t (args ::> ret)
n <- forall t (st :: Type -> Type) fs (ctx :: Ctx BaseType).
ExprBuilder t st fs -> IO (Nonce t ctx)
sbFreshSymFnNonce ExprBuilder t st fs
sym
let fn :: ExprSymFn t args ret
fn = ExprSymFn { symFnId :: Nonce t (args ::> ret)
symFnId = Nonce t (args ::> ret)
n
, symFnName :: SolverSymbol
symFnName = SolverSymbol
fn_name
, symFnInfo :: SymFnInfo t args ret
symFnInfo = forall t (args :: Ctx BaseType) (ret :: BaseType).
Assignment (ExprBoundVar t) args
-> Expr t ret -> UnfoldPolicy -> SymFnInfo t args ret
DefinedFnInfo Assignment (BoundVar (ExprBuilder t st fs)) args
bound_vars SymExpr (ExprBuilder t st fs) ret
result UnfoldPolicy
policy
, symFnLoc :: ProgramLoc
symFnLoc = ProgramLoc
l
}
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
fn_name (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymbolBinding t
FnSymbolBinding ExprSymFn t args ret
fn)
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t args ret
fn
freshTotalUninterpFn :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn (ExprBuilder t st fs) args ret)
freshTotalUninterpFn ExprBuilder t st fs
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type = do
Nonce t (args ::> ret)
n <- forall t (st :: Type -> Type) fs (ctx :: Ctx BaseType).
ExprBuilder t st fs -> IO (Nonce t ctx)
sbFreshSymFnNonce ExprBuilder t st fs
sym
ProgramLoc
l <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
let fn :: ExprSymFn t args ret
fn = ExprSymFn { symFnId :: Nonce t (args ::> ret)
symFnId = Nonce t (args ::> ret)
n
, symFnName :: SolverSymbol
symFnName = SolverSymbol
fn_name
, symFnInfo :: SymFnInfo t args ret
symFnInfo = forall t (args :: Ctx BaseType) (ret :: BaseType).
Assignment BaseTypeRepr args
-> BaseTypeRepr ret -> SymFnInfo t args ret
UninterpFnInfo Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type
, symFnLoc :: ProgramLoc
symFnLoc = ProgramLoc
l
}
seq :: forall a b. a -> b -> b
seq ExprSymFn t args ret
fn forall a b. (a -> b) -> a -> b
$ do
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
fn_name (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymbolBinding t
FnSymbolBinding ExprSymFn t args ret
fn)
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t args ret
fn
applySymFn :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> SymFn (ExprBuilder t st fs) args ret
-> Assignment (SymExpr (ExprBuilder t st fs)) args
-> IO (SymExpr (ExprBuilder t st fs) ret)
applySymFn ExprBuilder t st fs
sym SymFn (ExprBuilder t st fs) args ret
fn Assignment (SymExpr (ExprBuilder t st fs)) args
args = do
case forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymFnInfo t args ret
symFnInfo SymFn (ExprBuilder t st fs) args ret
fn of
DefinedFnInfo Assignment (ExprBoundVar t) args
bound_vars Expr t ret
e UnfoldPolicy
policy
| forall (e :: BaseType -> Type) (args :: Ctx BaseType).
IsExpr e =>
UnfoldPolicy -> Assignment e args -> Bool
shouldUnfold UnfoldPolicy
policy Assignment (SymExpr (ExprBuilder t st fs)) args
args ->
forall t (st :: Type -> Type) fs (ret :: BaseType)
(args :: Ctx BaseType).
ExprBuilder t st fs
-> Expr t ret
-> Assignment (ExprBoundVar t) args
-> Assignment (Expr t) args
-> IO (Expr t ret)
evalBoundVars ExprBuilder t st fs
sym Expr t ret
e Assignment (ExprBoundVar t) args
bound_vars Assignment (SymExpr (ExprBuilder t st fs)) args
args
MatlabSolverFnInfo MatlabSolverFn (Expr t) args ret
f Assignment (ExprBoundVar t) args
_ Expr t ret
_ -> do
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsExprBuilder sym =>
MatlabSolverFn (SymExpr sym) args ret
-> sym -> Assignment (SymExpr sym) args -> IO (SymExpr sym ret)
evalMatlabSolverFn MatlabSolverFn (Expr t) args ret
f ExprBuilder t st fs
sym Assignment (SymExpr (ExprBuilder t st fs)) args
args
SymFnInfo t args ret
_ -> forall t (st :: Type -> Type) fs (tp :: BaseType).
ExprBuilder t st fs -> NonceApp t (Expr t) tp -> IO (Expr t tp)
sbNonceExpr ExprBuilder t st fs
sym forall a b. (a -> b) -> a -> b
$! forall t (args :: Ctx BaseType) (tp :: BaseType)
(e :: BaseType -> Type).
ExprSymFn t args tp -> Assignment e args -> NonceApp t e tp
FnApp SymFn (ExprBuilder t st fs) args ret
fn Assignment (SymExpr (ExprBuilder t st fs)) args
args
substituteBoundVars :: forall (tp :: BaseType).
ExprBuilder t st fs
-> MapF
(BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
-> SymExpr (ExprBuilder t st fs) tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
substituteBoundVars ExprBuilder t st fs
sym MapF
(BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
subst SymExpr (ExprBuilder t st fs) tp
e = do
EvalHashTables t
tbls <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ do
HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- forall {k1} s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized forall a b. (a -> b) -> a -> b
$ forall t e. IsBinTree t e => t -> Int
PM.size MapF
(BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
subst
HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl <- forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
forall {v} (m :: Type -> Type) (ktp :: v -> Type) (f :: v -> Type).
Applicative m =>
(forall (tp :: v). ktp tp -> f tp -> m ()) -> MapF ktp f -> m ()
PM.traverseWithKey_ (forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld (Expr t) (Expr t)
expr_tbl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr) MapF
(BoundVar (ExprBuilder t st fs)) (SymExpr (ExprBuilder t st fs))
subst
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ EvalHashTables
{ exprTable :: HashTable RealWorld (Expr t) (Expr t)
exprTable = HashTable RealWorld (Expr t) (Expr t)
expr_tbl
, fnTable :: HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable = HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl
}
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym SymExpr (ExprBuilder t st fs) tp
e
substituteSymFns :: forall (tp :: BaseType).
ExprBuilder t st fs
-> MapF
(SymFnWrapper (ExprBuilder t st fs))
(SymFnWrapper (ExprBuilder t st fs))
-> SymExpr (ExprBuilder t st fs) tp
-> IO (SymExpr (ExprBuilder t st fs) tp)
substituteSymFns ExprBuilder t st fs
sym MapF
(SymFnWrapper (ExprBuilder t st fs))
(SymFnWrapper (ExprBuilder t st fs))
subst SymExpr (ExprBuilder t st fs) tp
e = do
EvalHashTables t
tbls <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ do
HashTable RealWorld (Expr t) (Expr t)
expr_tbl <- forall {k} s (key :: k -> Type) (val :: k -> Type).
ST s (HashTable s key val)
PH.new
HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl <- forall {k1} s (k2 :: k1 -> Type) (v :: k1 -> Type).
Int -> ST s (HashTable s k2 v)
PH.newSized forall a b. (a -> b) -> a -> b
$ forall t e. IsBinTree t e => t -> Int
PM.size MapF
(SymFnWrapper (ExprBuilder t st fs))
(SymFnWrapper (ExprBuilder t st fs))
subst
forall {v} (m :: Type -> Type) (ktp :: v -> Type) (f :: v -> Type).
Applicative m =>
(forall (tp :: v). ktp tp -> f tp -> m ()) -> MapF ktp f -> m ()
PM.traverseWithKey_
(\(SymFnWrapper SymFn (ExprBuilder t st fs) args ret
f) (SymFnWrapper SymFn (ExprBuilder t st fs) args ret
g) -> forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> Nonce t (args ::> ret)
symFnId SymFn (ExprBuilder t st fs) args ret
f) (forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
Bool -> ExprSymFn t a r -> CachedSymFn t c
CachedSymFn Bool
True SymFn (ExprBuilder t st fs) args ret
g))
MapF
(SymFnWrapper (ExprBuilder t st fs))
(SymFnWrapper (ExprBuilder t st fs))
subst
forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ EvalHashTables
{ exprTable :: HashTable RealWorld (Expr t) (Expr t)
exprTable = HashTable RealWorld (Expr t) (Expr t)
expr_tbl
, fnTable :: HashTable RealWorld (Nonce t) (CachedSymFn t)
fnTable = HashTable RealWorld (Nonce t) (CachedSymFn t)
fn_tbl
}
forall t (st :: Type -> Type) fs (ret :: BaseType).
EvalHashTables t
-> ExprBuilder t st fs -> Expr t ret -> IO (Expr t ret)
evalBoundVars' EvalHashTables t
tbls ExprBuilder t st fs
sym SymExpr (ExprBuilder t st fs) tp
e
instance IsInterpretedFloatExprBuilder (ExprBuilder t st fs) => IsInterpretedFloatSymExprBuilder (ExprBuilder t st fs)
instance MatlabSymbolicArrayBuilder (ExprBuilder t st fs) where
mkMatlabSolverFn :: forall (args :: Ctx BaseType) (ret :: BaseType).
ExprBuilder t st fs
-> MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
-> IO (SymFn (ExprBuilder t st fs) args ret)
mkMatlabSolverFn ExprBuilder t st fs
sym MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
fn_id = do
let key :: MatlabFnWrapper t (args ::> ret)
key = forall t (a :: Ctx BaseType) (r :: BaseType).
MatlabSolverFn (Expr t) a r -> MatlabFnWrapper t (a ::> r)
MatlabFnWrapper MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
fn_id
Maybe (ExprSymFnWrapper t (args ::> ret))
mr <- forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall {k} (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> ST s (Maybe (val tp))
PH.lookup (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
sbMatlabFnCache ExprBuilder t st fs
sym) MatlabFnWrapper t (args ::> ret)
key
case Maybe (ExprSymFnWrapper t (args ::> ret))
mr of
Just (ExprSymFnWrapper ExprSymFn t a r
f) -> forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t a r
f
Maybe (ExprSymFnWrapper t (args ::> ret))
Nothing -> do
let tps :: Assignment BaseTypeRepr args
tps = forall (f :: BaseType -> Type) (args :: Ctx BaseType)
(ret :: BaseType).
MatlabSolverFn f args ret -> Assignment BaseTypeRepr args
matlabSolverArgTypes MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
fn_id
Assignment (ExprBoundVar t) args
vars <- forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type) (m :: Type -> Type).
(TraversableFC t, Applicative m) =>
(forall (x :: k). f x -> m (g x))
-> forall (x :: l). t f x -> m (t g x)
traverseFC (forall sym (tp :: BaseType).
IsSymExprBuilder sym =>
sym -> SolverSymbol -> BaseTypeRepr tp -> IO (BoundVar sym tp)
freshBoundVar ExprBuilder t st fs
sym SolverSymbol
emptySymbol) Assignment BaseTypeRepr args
tps
Expr t ret
r <- forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsExprBuilder sym =>
MatlabSolverFn (SymExpr sym) args ret
-> sym -> Assignment (SymExpr sym) args -> IO (SymExpr sym ret)
evalMatlabSolverFn MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
fn_id ExprBuilder t st fs
sym (forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC forall t (tp :: BaseType). ExprBoundVar t tp -> Expr t tp
BoundVarExpr Assignment (ExprBoundVar t) args
vars)
ProgramLoc
l <- forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> IO ProgramLoc
curProgramLoc ExprBuilder t st fs
sym
Nonce t (args ::> ret)
n <- forall t (st :: Type -> Type) fs (ctx :: Ctx BaseType).
ExprBuilder t st fs -> IO (Nonce t ctx)
sbFreshSymFnNonce ExprBuilder t st fs
sym
let f :: ExprSymFn t args ret
f = ExprSymFn { symFnId :: Nonce t (args ::> ret)
symFnId = Nonce t (args ::> ret)
n
, symFnName :: SolverSymbol
symFnName = SolverSymbol
emptySymbol
, symFnInfo :: SymFnInfo t args ret
symFnInfo = forall t (args :: Ctx BaseType) (ret :: BaseType).
MatlabSolverFn (Expr t) args ret
-> Assignment (ExprBoundVar t) args
-> Expr t ret
-> SymFnInfo t args ret
MatlabSolverFnInfo MatlabSolverFn (SymExpr (ExprBuilder t st fs)) args ret
fn_id Assignment (ExprBoundVar t) args
vars Expr t ret
r
, symFnLoc :: ProgramLoc
symFnLoc = ProgramLoc
l
}
forall t (st :: Type -> Type) fs.
ExprBuilder t st fs -> SolverSymbol -> SymbolBinding t -> IO ()
updateVarBinding ExprBuilder t st fs
sym SolverSymbol
emptySymbol (forall t (args :: Ctx BaseType) (ret :: BaseType).
ExprSymFn t args ret -> SymbolBinding t
FnSymbolBinding ExprSymFn t args ret
f)
forall a. ST RealWorld a -> IO a
stToIO forall a b. (a -> b) -> a -> b
$ forall k (key :: k -> Type) s (val :: k -> Type) (tp :: k).
(HashableF key, TestEquality key) =>
HashTable s key val -> key tp -> val tp -> ST s ()
PH.insert (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> HashTable RealWorld (MatlabFnWrapper t) (ExprSymFnWrapper t)
sbMatlabFnCache ExprBuilder t st fs
sym) MatlabFnWrapper t (args ::> ret)
key (forall t (c :: Ctx BaseType) (a :: Ctx BaseType) (r :: BaseType).
(c ~ (a ::> r)) =>
ExprSymFn t a r -> ExprSymFnWrapper t c
ExprSymFnWrapper ExprSymFn t args ret
f)
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t args ret
f
unsafeUserSymbol :: String -> IO SolverSymbol
unsafeUserSymbol :: String -> IO SolverSymbol
unsafeUserSymbol String
s =
case String -> Either SolverSymbolError SolverSymbol
userSymbol String
s of
Left SolverSymbolError
err -> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail (forall a. Show a => a -> String
show SolverSymbolError
err)
Right SolverSymbol
symbol -> forall (m :: Type -> Type) a. Monad m => a -> m a
return SolverSymbol
symbol
cachedUninterpFn
:: (sym ~ ExprBuilder t st fs)
=> sym
-> SolverSymbol
-> Ctx.Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> ( sym
-> SolverSymbol
-> Ctx.Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
)
-> IO (SymFn sym args ret)
cachedUninterpFn :: forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn sym
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
handler = do
Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st fs))
fn_cache <- forall a. IORef a -> IO a
readIORef forall a b. (a -> b) -> a -> b
$ forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> IORef
(Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st fs)))
sbUninterpFnCache sym
sym
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (SolverSymbol, Some (Assignment BaseTypeRepr))
fn_key Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st fs))
fn_cache of
Just (SomeSymFn SymFn (ExprBuilder t st fs) args ret
fn)
| Just args :~: args
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (fn :: Ctx BaseType -> BaseType -> Type)
(args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> Assignment BaseTypeRepr args
fnArgTypes SymFn (ExprBuilder t st fs) args ret
fn) Assignment BaseTypeRepr args
arg_types
, Just ret :~: ret
Refl <- forall {k} (f :: k -> Type) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (forall (fn :: Ctx BaseType -> BaseType -> Type)
(args :: Ctx BaseType) (ret :: BaseType).
IsSymFn fn =>
fn args ret -> BaseTypeRepr ret
fnReturnType SymFn (ExprBuilder t st fs) args ret
fn) BaseTypeRepr ret
ret_type
-> forall (m :: Type -> Type) a. Monad m => a -> m a
return SymFn (ExprBuilder t st fs) args ret
fn
| Bool
otherwise
-> forall (m :: Type -> Type) a. MonadFail m => String -> m a
fail String
"Duplicate uninterpreted function declaration."
Maybe (SomeSymFn (ExprBuilder t st fs))
Nothing -> do
ExprSymFn t args ret
fn <- sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
handler sym
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' (forall t (st :: Type -> Type) fs.
ExprBuilder t st fs
-> IORef
(Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st fs)))
sbUninterpFnCache sym
sym) (\Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st fs))
m -> (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (SolverSymbol, Some (Assignment BaseTypeRepr))
fn_key (forall sym (args :: Ctx BaseType) (ret :: BaseType).
SymFn sym args ret -> SomeSymFn sym
SomeSymFn ExprSymFn t args ret
fn) Map
(SolverSymbol, Some (Assignment BaseTypeRepr))
(SomeSymFn (ExprBuilder t st fs))
m, ()))
forall (m :: Type -> Type) a. Monad m => a -> m a
return ExprSymFn t args ret
fn
where fn_key :: (SolverSymbol, Some (Assignment BaseTypeRepr))
fn_key = (SolverSymbol
fn_name, forall k (f :: k -> Type) (x :: k). f x -> Some f
Some (Assignment BaseTypeRepr args
arg_types forall {k} (ctx' :: Ctx k) (f :: k -> Type) (ctx :: Ctx k)
(tp :: k).
(ctx' ~ (ctx ::> tp)) =>
Assignment f ctx -> f tp -> Assignment f ctx'
Ctx.:> BaseTypeRepr ret
ret_type))
mkUninterpFnApp
:: (sym ~ ExprBuilder t st fs)
=> sym
-> String
-> Ctx.Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp :: forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkUninterpFnApp sym
sym String
str_fn_name Assignment (SymExpr sym) args
args BaseTypeRepr ret
ret_type = do
SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol String
str_fn_name
let arg_types :: Assignment BaseTypeRepr args
arg_types = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr sym) args
args
ExprSymFn t args ret
fn <- forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> (sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret))
-> IO (SymFn sym args ret)
cachedUninterpFn sym
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn sym
sym ExprSymFn t args ret
fn Assignment (SymExpr sym) args
args
mkFreshUninterpFnApp
:: (sym ~ ExprBuilder t st fs)
=> sym
-> String
-> Ctx.Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkFreshUninterpFnApp :: forall sym t (st :: Type -> Type) fs (args :: Ctx BaseType)
(ret :: BaseType).
(sym ~ ExprBuilder t st fs) =>
sym
-> String
-> Assignment (SymExpr sym) args
-> BaseTypeRepr ret
-> IO (SymExpr sym ret)
mkFreshUninterpFnApp sym
sym String
str_fn_name Assignment (SymExpr sym) args
args BaseTypeRepr ret
ret_type = do
SolverSymbol
fn_name <- String -> IO SolverSymbol
unsafeUserSymbol String
str_fn_name
let arg_types :: Assignment BaseTypeRepr args
arg_types = forall k l (t :: (k -> Type) -> l -> Type) (f :: k -> Type)
(g :: k -> Type).
FunctorFC t =>
(forall (x :: k). f x -> g x) -> forall (x :: l). t f x -> t g x
fmapFC forall (e :: BaseType -> Type) (tp :: BaseType).
IsExpr e =>
e tp -> BaseTypeRepr tp
exprType Assignment (SymExpr sym) args
args
ExprSymFn t args ret
fn <- forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SolverSymbol
-> Assignment BaseTypeRepr args
-> BaseTypeRepr ret
-> IO (SymFn sym args ret)
freshTotalUninterpFn sym
sym SolverSymbol
fn_name Assignment BaseTypeRepr args
arg_types BaseTypeRepr ret
ret_type
forall sym (args :: Ctx BaseType) (ret :: BaseType).
IsSymExprBuilder sym =>
sym
-> SymFn sym args ret
-> Assignment (SymExpr sym) args
-> IO (SymExpr sym ret)
applySymFn sym
sym ExprSymFn t args ret
fn Assignment (SymExpr sym) args
args