{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -Werror -fno-warn-orphans #-}
module Data.SBV.Core.Model (
Mergeable(..), Equality(..), EqSymbolic(..), OrdSymbolic(..), SDivisible(..), Uninterpreted(..), Metric(..), minimize, maximize, assertWithPenalty, SIntegral, SFiniteBits(..)
, ite, iteLazy, sFromIntegral, sShiftLeft, sShiftRight, sRotateLeft, sBarrelRotateLeft, sRotateRight, sBarrelRotateRight, sSignedShiftArithRight, (.^)
, oneIf, genVar, genVar_, forall, forall_, exists, exists_
, pbAtMost, pbAtLeast, pbExactly, pbLe, pbGe, pbEq, pbMutexed, pbStronglyMutexed
, sBool, sBool_, sBools, sWord8, sWord8_, sWord8s, sWord16, sWord16_, sWord16s, sWord32, sWord32_, sWord32s
, sWord64, sWord64_, sWord64s, sInt8, sInt8_, sInt8s, sInt16, sInt16_, sInt16s, sInt32, sInt32_, sInt32s, sInt64, sInt64_
, sInt64s, sInteger, sInteger_, sIntegers, sReal, sReal_, sReals, sFloat, sFloat_, sFloats, sDouble, sDouble_, sDoubles
, sFPHalf, sFPHalf_, sFPHalfs, sFPBFloat, sFPBFloat_, sFPBFloats, sFPSingle, sFPSingle_, sFPSingles, sFPDouble, sFPDouble_, sFPDoubles, sFPQuad, sFPQuad_, sFPQuads
, sFloatingPoint, sFloatingPoint_, sFloatingPoints
, sChar, sChar_, sChars, sString, sString_, sStrings, sList, sList_, sLists
, sRational, sRational_, sRationals
, SymTuple, sTuple, sTuple_, sTuples
, sEither, sEither_, sEithers, sMaybe, sMaybe_, sMaybes
, sSet, sSet_, sSets
, solve
, slet
, sRealToSInteger, label, observe, observeIf, sObserve
, sAssert
, liftQRem, liftDMod, symbolicMergeWithKind
, genLiteral, genFromCV, genMkSymVar
, sbvQuickCheck
)
where
import Control.Applicative (ZipList(ZipList))
import Control.Monad (when, unless, mplus)
import Control.Monad.Trans (liftIO)
import Control.Monad.IO.Class (MonadIO)
import GHC.Generics (U1(..), M1(..), (:*:)(..), K1(..))
import qualified GHC.Generics as G
import GHC.Stack
import Data.Array (Array, Ix, listArray, elems, bounds, rangeSize)
import Data.Bits (Bits(..))
import Data.Char (toLower, isDigit)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Kind (Type)
import Data.List (genericLength, genericIndex, genericTake, unzip4, unzip5, unzip6, unzip7, intercalate, isPrefixOf)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.String (IsString(..))
import Data.Word (Word8, Word16, Word32, Word64)
import qualified Data.Set as Set
import Data.Proxy
import Data.Dynamic (fromDynamic, toDyn)
import Test.QuickCheck (Testable(..), Arbitrary(..))
import qualified Test.QuickCheck.Test as QC (isSuccess)
import qualified Test.QuickCheck as QC (quickCheckResult, counterexample)
import qualified Test.QuickCheck.Monadic as QC (monadicIO, run, assert, pre, monitor)
import qualified Data.Foldable as F (toList)
import Data.SBV.Core.AlgReals
import Data.SBV.Core.SizedFloats
import Data.SBV.Core.Data
import Data.SBV.Core.Symbolic
import Data.SBV.Core.Operations
import Data.SBV.Core.Kind
import Data.SBV.Provers.Prover (defaultSMTCfg, SafeResult(..), prove)
import Data.SBV.SMT.SMT (ThmResult, showModel)
import Data.SBV.Utils.Lib (isKString)
genVar :: MonadSymbolic m => VarContext -> Kind -> String -> m (SBV a)
genVar :: forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> [Char] -> m (SBV a)
genVar VarContext
q Kind
k = VarContext -> Kind -> Maybe [Char] -> m (SBV a)
forall a (m :: * -> *).
MonadSymbolic m =>
VarContext -> Kind -> Maybe [Char] -> m (SBV a)
mkSymSBV VarContext
q Kind
k (Maybe [Char] -> m (SBV a))
-> ([Char] -> Maybe [Char]) -> [Char] -> m (SBV a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just
genVar_ :: MonadSymbolic m => VarContext -> Kind -> m (SBV a)
genVar_ :: forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> m (SBV a)
genVar_ VarContext
q Kind
k = VarContext -> Kind -> Maybe [Char] -> m (SBV a)
forall a (m :: * -> *).
MonadSymbolic m =>
VarContext -> Kind -> Maybe [Char] -> m (SBV a)
mkSymSBV VarContext
q Kind
k Maybe [Char]
forall a. Maybe a
Nothing
genLiteral :: Integral a => Kind -> a -> SBV b
genLiteral :: forall a b. Integral a => Kind -> a -> SBV b
genLiteral Kind
k = SVal -> SBV b
forall a. SVal -> SBV a
SBV (SVal -> SBV b) -> (a -> SVal) -> a -> SBV b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> (a -> Either CV (Cached SV)) -> a -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (a -> CV) -> a -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> a -> CV
forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
k
genFromCV :: Integral a => CV -> a
genFromCV :: forall a. Integral a => CV -> a
genFromCV (CV Kind
_ (CInteger Integer
x)) = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x
genFromCV CV
c = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"genFromCV: Unsupported non-integral value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
c
genMkSymVar :: MonadSymbolic m => Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar :: forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
k VarContext
mbq Maybe [Char]
Nothing = VarContext -> Kind -> m (SBV a)
forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> m (SBV a)
genVar_ VarContext
mbq Kind
k
genMkSymVar Kind
k VarContext
mbq (Just [Char]
s) = VarContext -> Kind -> [Char] -> m (SBV a)
forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> [Char] -> m (SBV a)
genVar VarContext
mbq Kind
k [Char]
s
instance SymVal Bool where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SBool
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SBool
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KBool
literal :: Bool -> SBool
literal = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> (Bool -> SVal) -> Bool -> SBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> SVal
svBool
fromCV :: CV -> Bool
fromCV = CV -> Bool
cvToBool
instance SymVal Word8 where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SWord8
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SWord8
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
False Int
8)
literal :: Word8 -> SWord8
literal = Kind -> Word8 -> SWord8
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (Bool -> Int -> Kind
KBounded Bool
False Int
8)
fromCV :: CV -> Word8
fromCV = CV -> Word8
forall a. Integral a => CV -> a
genFromCV
instance SymVal Int8 where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInt8
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SInt8
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
True Int
8)
literal :: Int8 -> SInt8
literal = Kind -> Int8 -> SInt8
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (Bool -> Int -> Kind
KBounded Bool
True Int
8)
fromCV :: CV -> Int8
fromCV = CV -> Int8
forall a. Integral a => CV -> a
genFromCV
instance SymVal Word16 where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SWord16
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SWord16
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
False Int
16)
literal :: Word16 -> SWord16
literal = Kind -> Word16 -> SWord16
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (Bool -> Int -> Kind
KBounded Bool
False Int
16)
fromCV :: CV -> Word16
fromCV = CV -> Word16
forall a. Integral a => CV -> a
genFromCV
instance SymVal Int16 where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInt16
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SInt16
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
True Int
16)
literal :: Int16 -> SInt16
literal = Kind -> Int16 -> SInt16
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (Bool -> Int -> Kind
KBounded Bool
True Int
16)
fromCV :: CV -> Int16
fromCV = CV -> Int16
forall a. Integral a => CV -> a
genFromCV
instance SymVal Word32 where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SWord32
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SWord32
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
False Int
32)
literal :: Word32 -> SWord32
literal = Kind -> Word32 -> SWord32
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (Bool -> Int -> Kind
KBounded Bool
False Int
32)
fromCV :: CV -> Word32
fromCV = CV -> Word32
forall a. Integral a => CV -> a
genFromCV
instance SymVal Int32 where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInt32
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SInt32
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
True Int
32)
literal :: Int32 -> SInt32
literal = Kind -> Int32 -> SInt32
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (Bool -> Int -> Kind
KBounded Bool
True Int
32)
fromCV :: CV -> Int32
fromCV = CV -> Int32
forall a. Integral a => CV -> a
genFromCV
instance SymVal Word64 where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SWord64
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SWord64
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
False Int
64)
literal :: Word64 -> SWord64
literal = Kind -> Word64 -> SWord64
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (Bool -> Int -> Kind
KBounded Bool
False Int
64)
fromCV :: CV -> Word64
fromCV = CV -> Word64
forall a. Integral a => CV -> a
genFromCV
instance SymVal Int64 where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInt64
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SInt64
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
True Int
64)
literal :: Int64 -> SInt64
literal = Kind -> Int64 -> SInt64
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (Bool -> Int -> Kind
KBounded Bool
True Int
64)
fromCV :: CV -> Int64
fromCV = CV -> Int64
forall a. Integral a => CV -> a
genFromCV
instance SymVal Integer where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInteger
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SInteger
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KUnbounded
literal :: Integer -> SInteger
literal = SVal -> SInteger
forall a. SVal -> SBV a
SBV (SVal -> SInteger) -> (Integer -> SVal) -> Integer -> SInteger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KUnbounded (Either CV (Cached SV) -> SVal)
-> (Integer -> Either CV (Cached SV)) -> Integer -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Integer -> CV) -> Integer -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Integer -> CV
forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
KUnbounded
fromCV :: CV -> Integer
fromCV = CV -> Integer
forall a. Integral a => CV -> a
genFromCV
instance SymVal Rational where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV Rational)
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV Rational)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KRational
literal :: Rational -> SBV Rational
literal = SVal -> SBV Rational
forall a. SVal -> SBV a
SBV (SVal -> SBV Rational)
-> (Rational -> SVal) -> Rational -> SBV Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KRational (Either CV (Cached SV) -> SVal)
-> (Rational -> Either CV (Cached SV)) -> Rational -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Rational -> CV) -> Rational -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KRational (CVal -> CV) -> (Rational -> CVal) -> Rational -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> CVal
CRational
fromCV :: CV -> Rational
fromCV (CV Kind
_ (CRational Rational
r)) = Rational
r
fromCV CV
c = [Char] -> Rational
forall a. HasCallStack => [Char] -> a
error ([Char] -> Rational) -> [Char] -> Rational
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.Rational: Unexpected non-rational value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
c
instance SymVal AlgReal where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SReal
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m SReal
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KReal
literal :: AlgReal -> SReal
literal = SVal -> SReal
forall a. SVal -> SBV a
SBV (SVal -> SReal) -> (AlgReal -> SVal) -> AlgReal -> SReal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KReal (Either CV (Cached SV) -> SVal)
-> (AlgReal -> Either CV (Cached SV)) -> AlgReal -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (AlgReal -> CV) -> AlgReal -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KReal (CVal -> CV) -> (AlgReal -> CVal) -> AlgReal -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlgReal -> CVal
CAlgReal
fromCV :: CV -> AlgReal
fromCV (CV Kind
_ (CAlgReal AlgReal
a)) = AlgReal
a
fromCV CV
c = [Char] -> AlgReal
forall a. HasCallStack => [Char] -> a
error ([Char] -> AlgReal) -> [Char] -> AlgReal
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.AlgReal: Unexpected non-real value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
c
isConcretely :: SReal -> (AlgReal -> Bool) -> Bool
isConcretely (SBV (SVal Kind
KReal (Left (CV Kind
KReal (CAlgReal AlgReal
v))))) AlgReal -> Bool
p
| AlgReal -> Bool
isExactRational AlgReal
v = AlgReal -> Bool
p AlgReal
v
isConcretely SReal
_ AlgReal -> Bool
_ = Bool
False
instance SymVal Float where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV Float)
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV Float)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KFloat
literal :: Float -> SBV Float
literal = SVal -> SBV Float
forall a. SVal -> SBV a
SBV (SVal -> SBV Float) -> (Float -> SVal) -> Float -> SBV Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KFloat (Either CV (Cached SV) -> SVal)
-> (Float -> Either CV (Cached SV)) -> Float -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Float -> CV) -> Float -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KFloat (CVal -> CV) -> (Float -> CVal) -> Float -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> CVal
CFloat
fromCV :: CV -> Float
fromCV (CV Kind
_ (CFloat Float
a)) = Float
a
fromCV CV
c = [Char] -> Float
forall a. HasCallStack => [Char] -> a
error ([Char] -> Float) -> [Char] -> Float
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.Float: Unexpected non-float value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
c
isConcretely :: SBV Float -> (Float -> Bool) -> Bool
isConcretely SBV Float
_ Float -> Bool
_ = Bool
False
instance SymVal Double where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV Double)
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV Double)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KDouble
literal :: Double -> SBV Double
literal = SVal -> SBV Double
forall a. SVal -> SBV a
SBV (SVal -> SBV Double) -> (Double -> SVal) -> Double -> SBV Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KDouble (Either CV (Cached SV) -> SVal)
-> (Double -> Either CV (Cached SV)) -> Double -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Double -> CV) -> Double -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KDouble (CVal -> CV) -> (Double -> CVal) -> Double -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CVal
CDouble
fromCV :: CV -> Double
fromCV (CV Kind
_ (CDouble Double
a)) = Double
a
fromCV CV
c = [Char] -> Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> Double) -> [Char] -> Double
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.Double: Unexpected non-double value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
c
isConcretely :: SBV Double -> (Double -> Bool) -> Bool
isConcretely SBV Double
_ Double -> Bool
_ = Bool
False
instance SymVal Char where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV Char)
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV Char)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KChar
literal :: Char -> SBV Char
literal Char
c = SVal -> SBV Char
forall a. SVal -> SBV a
SBV (SVal -> SBV Char) -> (CVal -> SVal) -> CVal -> SBV Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KChar (Either CV (Cached SV) -> SVal)
-> (CVal -> Either CV (Cached SV)) -> CVal -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (CVal -> CV) -> CVal -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KChar (CVal -> SBV Char) -> CVal -> SBV Char
forall a b. (a -> b) -> a -> b
$ Char -> CVal
CChar Char
c
fromCV :: CV -> Char
fromCV (CV Kind
_ (CChar Char
a)) = Char
a
fromCV CV
c = [Char] -> Char
forall a. HasCallStack => [Char] -> a
error ([Char] -> Char) -> [Char] -> Char
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.String: Unexpected non-char value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
c
instance SymVal a => SymVal [a] where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV [a])
mkSymVal
| forall a. Typeable a => a -> Bool
isKString @[a] [a]
forall a. HasCallStack => a
undefined = Kind -> VarContext -> Maybe [Char] -> m (SBV [a])
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KString
| Bool
True = Kind -> VarContext -> Maybe [Char] -> m (SBV [a])
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Kind -> Kind
KList (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)))
literal :: [a] -> SBV [a]
literal [a]
as
| forall a. Typeable a => a -> Bool
isKString @[a] [a]
forall a. HasCallStack => a
undefined = case Dynamic -> Maybe [Char]
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic ([a] -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn [a]
as) of
Just [Char]
s -> SVal -> SBV [a]
forall a. SVal -> SBV a
SBV (SVal -> SBV [a]) -> ([Char] -> SVal) -> [Char] -> SBV [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KString (Either CV (Cached SV) -> SVal)
-> ([Char] -> Either CV (Cached SV)) -> [Char] -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> ([Char] -> CV) -> [Char] -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KString (CVal -> CV) -> ([Char] -> CVal) -> [Char] -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CVal
CString ([Char] -> SBV [a]) -> [Char] -> SBV [a]
forall a b. (a -> b) -> a -> b
$ [Char]
s
Maybe [Char]
Nothing -> [Char] -> SBV [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"SString: Cannot construct literal string!"
| Bool
True = let k :: Kind
k = Kind -> Kind
KList (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))
in SVal -> SBV [a]
forall a. SVal -> SBV a
SBV (SVal -> SBV [a]) -> SVal -> SBV [a]
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV)) -> CV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k (CVal -> CV) -> CVal -> CV
forall a b. (a -> b) -> a -> b
$ [CVal] -> CVal
CList ([CVal] -> CVal) -> [CVal] -> CVal
forall a b. (a -> b) -> a -> b
$ (a -> CVal) -> [a] -> [CVal]
forall a b. (a -> b) -> [a] -> [b]
map a -> CVal
forall a. SymVal a => a -> CVal
toCV [a]
as
fromCV :: CV -> [a]
fromCV (CV Kind
_ (CString [Char]
a)) = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> [a]
forall a. HasCallStack => [Char] -> a
error [Char]
"SString: Cannot extract a literal string!")
(Dynamic -> Maybe [a]
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic ([Char] -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn [Char]
a))
fromCV (CV Kind
_ (CList [CVal]
a)) = CV -> a
forall a. SymVal a => CV -> a
fromCV (CV -> a) -> (CVal -> CV) -> CVal -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) (CVal -> a) -> [CVal] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CVal]
a
fromCV CV
c = [Char] -> [a]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [a]) -> [Char] -> [a]
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCV: Unexpected non-list value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
c
instance ValidFloat eb sb => HasKind (FloatingPoint eb sb) where
kindOf :: FloatingPoint eb sb -> Kind
kindOf FloatingPoint eb sb
_ = Int -> Int -> Kind
KFP (Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @eb)) (Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @sb))
instance ValidFloat eb sb => SymVal (FloatingPoint eb sb) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (FloatingPoint eb sb))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (FloatingPoint eb sb))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Int -> Int -> Kind
KFP (Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @eb)) (Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @sb)))
literal :: FloatingPoint eb sb -> SBV (FloatingPoint eb sb)
literal (FloatingPoint FP
r) = let k :: Kind
k = Int -> Int -> Kind
KFP (Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @eb)) (Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @sb))
in SVal -> SBV (FloatingPoint eb sb)
forall a. SVal -> SBV a
SBV (SVal -> SBV (FloatingPoint eb sb))
-> SVal -> SBV (FloatingPoint eb sb)
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV)) -> CV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k (FP -> CVal
CFP FP
r)
fromCV :: CV -> FloatingPoint eb sb
fromCV (CV Kind
_ (CFP FP
r)) = FP -> FloatingPoint eb sb
forall (eb :: Nat) (sb :: Nat). FP -> FloatingPoint eb sb
FloatingPoint FP
r
fromCV CV
c = [Char] -> FloatingPoint eb sb
forall a. HasCallStack => [Char] -> a
error ([Char] -> FloatingPoint eb sb) -> [Char] -> FloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.FPR: Unexpected non-arbitrary-precision value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
c
toCV :: SymVal a => a -> CVal
toCV :: forall a. SymVal a => a -> CVal
toCV a
a = case a -> SBV a
forall a. SymVal a => a -> SBV a
literal a
a of
SBV (SVal Kind
_ (Left CV
cv)) -> CV -> CVal
cvVal CV
cv
SBV a
_ -> [Char] -> CVal
forall a. HasCallStack => [Char] -> a
error [Char]
"SymVal.toCV: Impossible happened, couldn't produce a concrete value"
mkCVTup :: Int -> Kind -> [CVal] -> SBV a
mkCVTup :: forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
i k :: Kind
k@(KTuple [Kind]
ks) [CVal]
cs
| Int
lks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lcs Bool -> Bool -> Bool
&& Int
lks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV)) -> CV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k (CVal -> CV) -> CVal -> CV
forall a b. (a -> b) -> a -> b
$ [CVal] -> CVal
CTuple [CVal]
cs
| Bool
True
= [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.mkCVTup: Impossible happened. Malformed tuple received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Kind) -> [Char]
forall a. Show a => a -> [Char]
show (Int
i, Kind
k)
where lks :: Int
lks = [Kind] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
ks
lcs :: Int
lcs = [CVal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CVal]
cs
mkCVTup Int
i Kind
k [CVal]
_
= [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.mkCVTup: Impossible happened. Non-tuple received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Kind) -> [Char]
forall a. Show a => a -> [Char]
show (Int
i, Kind
k)
fromCVTup :: Int -> CV -> [CV]
fromCVTup :: Int -> CV -> [CV]
fromCVTup Int
i inp :: CV
inp@(CV (KTuple [Kind]
ks) (CTuple [CVal]
cs))
| Int
lks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lcs Bool -> Bool -> Bool
&& Int
lks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
= (Kind -> CVal -> CV) -> [Kind] -> [CVal] -> [CV]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Kind -> CVal -> CV
CV [Kind]
ks [CVal]
cs
| Bool
True
= [Char] -> [CV]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [CV]) -> [Char] -> [CV]
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCTup: Impossible happened. Malformed tuple received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, CV) -> [Char]
forall a. Show a => a -> [Char]
show (Int
i, CV
inp)
where lks :: Int
lks = [Kind] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
ks
lcs :: Int
lcs = [CVal] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CVal]
cs
fromCVTup Int
i CV
inp = [Char] -> [CV]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [CV]) -> [Char] -> [CV]
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCVTup: Impossible happened. Non-tuple received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, CV) -> [Char]
forall a. Show a => a -> [Char]
show (Int
i, CV
inp)
instance (SymVal a, SymVal b) => SymVal (Either a b) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (Either a b))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (Either a b))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (Either a b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Either a b)))
literal :: Either a b -> SBV (Either a b)
literal Either a b
s
| Left a
a <- Either a b
s = Either CVal CVal -> SBV (Either a b)
mk (Either CVal CVal -> SBV (Either a b))
-> Either CVal CVal -> SBV (Either a b)
forall a b. (a -> b) -> a -> b
$ CVal -> Either CVal CVal
forall a b. a -> Either a b
Left (a -> CVal
forall a. SymVal a => a -> CVal
toCV a
a)
| Right b
b <- Either a b
s = Either CVal CVal -> SBV (Either a b)
mk (Either CVal CVal -> SBV (Either a b))
-> Either CVal CVal -> SBV (Either a b)
forall a b. (a -> b) -> a -> b
$ CVal -> Either CVal CVal
forall a b. b -> Either a b
Right (b -> CVal
forall a. SymVal a => a -> CVal
toCV b
b)
where k :: Kind
k = Proxy (Either a b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Either a b))
mk :: Either CVal CVal -> SBV (Either a b)
mk = SVal -> SBV (Either a b)
forall a. SVal -> SBV a
SBV (SVal -> SBV (Either a b))
-> (Either CVal CVal -> SVal)
-> Either CVal CVal
-> SBV (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> (Either CVal CVal -> Either CV (Cached SV))
-> Either CVal CVal
-> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Either CVal CVal -> CV)
-> Either CVal CVal
-> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
k (CVal -> CV)
-> (Either CVal CVal -> CVal) -> Either CVal CVal -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either CVal CVal -> CVal
CEither
fromCV :: CV -> Either a b
fromCV (CV (KEither Kind
k1 Kind
_ ) (CEither (Left CVal
c))) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ CV -> a
forall a. SymVal a => CV -> a
fromCV (CV -> a) -> CV -> a
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k1 CVal
c
fromCV (CV (KEither Kind
_ Kind
k2) (CEither (Right CVal
c))) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> b -> Either a b
forall a b. (a -> b) -> a -> b
$ CV -> b
forall a. SymVal a => CV -> a
fromCV (CV -> b) -> CV -> b
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k2 CVal
c
fromCV CV
bad = [Char] -> Either a b
forall a. HasCallStack => [Char] -> a
error ([Char] -> Either a b) -> [Char] -> Either a b
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCV (Either): Malformed either received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
bad
instance SymVal a => SymVal (Maybe a) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (Maybe a))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (Maybe a))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (Maybe a) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Maybe a)))
literal :: Maybe a -> SBV (Maybe a)
literal Maybe a
s
| Maybe a
Nothing <- Maybe a
s = Maybe CVal -> SBV (Maybe a)
mk Maybe CVal
forall a. Maybe a
Nothing
| Just a
a <- Maybe a
s = Maybe CVal -> SBV (Maybe a)
mk (Maybe CVal -> SBV (Maybe a)) -> Maybe CVal -> SBV (Maybe a)
forall a b. (a -> b) -> a -> b
$ CVal -> Maybe CVal
forall a. a -> Maybe a
Just (a -> CVal
forall a. SymVal a => a -> CVal
toCV a
a)
where k :: Kind
k = Proxy (Maybe a) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Maybe a))
mk :: Maybe CVal -> SBV (Maybe a)
mk = SVal -> SBV (Maybe a)
forall a. SVal -> SBV a
SBV (SVal -> SBV (Maybe a))
-> (Maybe CVal -> SVal) -> Maybe CVal -> SBV (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> (Maybe CVal -> Either CV (Cached SV)) -> Maybe CVal -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Maybe CVal -> CV) -> Maybe CVal -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
k (CVal -> CV) -> (Maybe CVal -> CVal) -> Maybe CVal -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CVal -> CVal
CMaybe
fromCV :: CV -> Maybe a
fromCV (CV (KMaybe Kind
_) (CMaybe Maybe CVal
Nothing)) = Maybe a
forall a. Maybe a
Nothing
fromCV (CV (KMaybe Kind
k) (CMaybe (Just CVal
x))) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ CV -> a
forall a. SymVal a => CV -> a
fromCV (CV -> a) -> CV -> a
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k CVal
x
fromCV CV
bad = [Char] -> Maybe a
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe a) -> [Char] -> Maybe a
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCV (Maybe): Malformed sum received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
bad
instance (Ord a, SymVal a) => SymVal (RCSet a) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (RCSet a))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (RCSet a))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (RCSet a) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(RCSet a)))
literal :: RCSet a -> SBV (RCSet a)
literal RCSet a
eur = SVal -> SBV (RCSet a)
forall a. SVal -> SBV a
SBV (SVal -> SBV (RCSet a)) -> SVal -> SBV (RCSet a)
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV)) -> CV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k (CVal -> CV) -> CVal -> CV
forall a b. (a -> b) -> a -> b
$ RCSet CVal -> CVal
CSet (RCSet CVal -> CVal) -> RCSet CVal -> CVal
forall a b. (a -> b) -> a -> b
$ Set CVal -> RCSet CVal
dir (Set CVal -> RCSet CVal) -> Set CVal -> RCSet CVal
forall a b. (a -> b) -> a -> b
$ (a -> CVal) -> Set a -> Set CVal
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> CVal
forall a. SymVal a => a -> CVal
toCV Set a
s
where (Set CVal -> RCSet CVal
dir, Set a
s) = case RCSet a
eur of
RegularSet Set a
x -> (Set CVal -> RCSet CVal
forall a. Set a -> RCSet a
RegularSet, Set a
x)
ComplementSet Set a
x -> (Set CVal -> RCSet CVal
forall a. Set a -> RCSet a
ComplementSet, Set a
x)
k :: Kind
k = Proxy (RCSet a) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(RCSet a))
fromCV :: CV -> RCSet a
fromCV (CV (KSet Kind
a) (CSet (RegularSet Set CVal
s))) = Set a -> RCSet a
forall a. Set a -> RCSet a
RegularSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ (CVal -> a) -> Set CVal -> Set a
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (CV -> a
forall a. SymVal a => CV -> a
fromCV (CV -> a) -> (CVal -> CV) -> CVal -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
a) Set CVal
s
fromCV (CV (KSet Kind
a) (CSet (ComplementSet Set CVal
s))) = Set a -> RCSet a
forall a. Set a -> RCSet a
ComplementSet (Set a -> RCSet a) -> Set a -> RCSet a
forall a b. (a -> b) -> a -> b
$ (CVal -> a) -> Set CVal -> Set a
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (CV -> a
forall a. SymVal a => CV -> a
fromCV (CV -> a) -> (CVal -> CV) -> CVal -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
a) Set CVal
s
fromCV CV
bad = [Char] -> RCSet a
forall a. HasCallStack => [Char] -> a
error ([Char] -> RCSet a) -> [Char] -> RCSet a
forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCV (Set): Malformed set received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ CV -> [Char]
forall a. Show a => a -> [Char]
show CV
bad
instance SymVal () where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV ())
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV ())
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar ([Kind] -> Kind
KTuple [])
literal :: () -> SBV ()
literal () = Int -> Kind -> [CVal] -> SBV ()
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
0 (Proxy () -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @())) []
fromCV :: CV -> ()
fromCV CV
cv = Int -> CV -> [CV]
fromCVTup Int
0 CV
cv [CV] -> () -> ()
`seq` ()
instance (SymVal a, SymVal b) => SymVal (a, b) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (a, b))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (a, b))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (a, b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b)))
literal :: (a, b) -> SBV (a, b)
literal (a
v1, b
v2) = Int -> Kind -> [CVal] -> SBV (a, b)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
2 (Proxy (a, b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2]
fromCV :: CV -> (a, b)
fromCV CV
cv = let ~[CV
v1, CV
v2] = Int -> CV -> [CV]
fromCVTup Int
2 CV
cv
in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2)
instance (SymVal a, SymVal b, SymVal c) => SymVal (a, b, c) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (a, b, c))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (a, b, c))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (a, b, c) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c)))
literal :: (a, b, c) -> SBV (a, b, c)
literal (a
v1, b
v2, c
v3) = Int -> Kind -> [CVal] -> SBV (a, b, c)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
3 (Proxy (a, b, c) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2, c -> CVal
forall a. SymVal a => a -> CVal
toCV c
v3]
fromCV :: CV -> (a, b, c)
fromCV CV
cv = let ~[CV
v1, CV
v2, CV
v3] = Int -> CV -> [CV]
fromCVTup Int
3 CV
cv
in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2, CV -> c
forall a. SymVal a => CV -> a
fromCV CV
v3)
instance (SymVal a, SymVal b, SymVal c, SymVal d) => SymVal (a, b, c, d) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (a, b, c, d))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (a, b, c, d))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (a, b, c, d) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d)))
literal :: (a, b, c, d) -> SBV (a, b, c, d)
literal (a
v1, b
v2, c
v3, d
v4) = Int -> Kind -> [CVal] -> SBV (a, b, c, d)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
4 (Proxy (a, b, c, d) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2, c -> CVal
forall a. SymVal a => a -> CVal
toCV c
v3, d -> CVal
forall a. SymVal a => a -> CVal
toCV d
v4]
fromCV :: CV -> (a, b, c, d)
fromCV CV
cv = let ~[CV
v1, CV
v2, CV
v3, CV
v4] = Int -> CV -> [CV]
fromCVTup Int
4 CV
cv
in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2, CV -> c
forall a. SymVal a => CV -> a
fromCV CV
v3, CV -> d
forall a. SymVal a => CV -> a
fromCV CV
v4)
instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e) => SymVal (a, b, c, d, e) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (a, b, c, d, e))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (a, b, c, d, e))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (a, b, c, d, e) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e)))
literal :: (a, b, c, d, e) -> SBV (a, b, c, d, e)
literal (a
v1, b
v2, c
v3, d
v4, e
v5) = Int -> Kind -> [CVal] -> SBV (a, b, c, d, e)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
5 (Proxy (a, b, c, d, e) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2, c -> CVal
forall a. SymVal a => a -> CVal
toCV c
v3, d -> CVal
forall a. SymVal a => a -> CVal
toCV d
v4, e -> CVal
forall a. SymVal a => a -> CVal
toCV e
v5]
fromCV :: CV -> (a, b, c, d, e)
fromCV CV
cv = let ~[CV
v1, CV
v2, CV
v3, CV
v4, CV
v5] = Int -> CV -> [CV]
fromCVTup Int
5 CV
cv
in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2, CV -> c
forall a. SymVal a => CV -> a
fromCV CV
v3, CV -> d
forall a. SymVal a => CV -> a
fromCV CV
v4, CV -> e
forall a. SymVal a => CV -> a
fromCV CV
v5)
instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f) => SymVal (a, b, c, d, e, f) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (a, b, c, d, e, f))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (a, b, c, d, e, f))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (a, b, c, d, e, f) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e, f)))
literal :: (a, b, c, d, e, f) -> SBV (a, b, c, d, e, f)
literal (a
v1, b
v2, c
v3, d
v4, e
v5, f
v6) = Int -> Kind -> [CVal] -> SBV (a, b, c, d, e, f)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
6 (Proxy (a, b, c, d, e, f) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e, f))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2, c -> CVal
forall a. SymVal a => a -> CVal
toCV c
v3, d -> CVal
forall a. SymVal a => a -> CVal
toCV d
v4, e -> CVal
forall a. SymVal a => a -> CVal
toCV e
v5, f -> CVal
forall a. SymVal a => a -> CVal
toCV f
v6]
fromCV :: CV -> (a, b, c, d, e, f)
fromCV CV
cv = let ~[CV
v1, CV
v2, CV
v3, CV
v4, CV
v5, CV
v6] = Int -> CV -> [CV]
fromCVTup Int
6 CV
cv
in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2, CV -> c
forall a. SymVal a => CV -> a
fromCV CV
v3, CV -> d
forall a. SymVal a => CV -> a
fromCV CV
v4, CV -> e
forall a. SymVal a => CV -> a
fromCV CV
v5, CV -> f
forall a. SymVal a => CV -> a
fromCV CV
v6)
instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g) => SymVal (a, b, c, d, e, f, g) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (a, b, c, d, e, f, g))
mkSymVal = Kind -> VarContext -> Maybe [Char] -> m (SBV (a, b, c, d, e, f, g))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (a, b, c, d, e, f, g) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e, f, g)))
literal :: (a, b, c, d, e, f, g) -> SBV (a, b, c, d, e, f, g)
literal (a
v1, b
v2, c
v3, d
v4, e
v5, f
v6, g
v7) = Int -> Kind -> [CVal] -> SBV (a, b, c, d, e, f, g)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
7 (Proxy (a, b, c, d, e, f, g) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e, f, g))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2, c -> CVal
forall a. SymVal a => a -> CVal
toCV c
v3, d -> CVal
forall a. SymVal a => a -> CVal
toCV d
v4, e -> CVal
forall a. SymVal a => a -> CVal
toCV e
v5, f -> CVal
forall a. SymVal a => a -> CVal
toCV f
v6, g -> CVal
forall a. SymVal a => a -> CVal
toCV g
v7]
fromCV :: CV -> (a, b, c, d, e, f, g)
fromCV CV
cv = let ~[CV
v1, CV
v2, CV
v3, CV
v4, CV
v5, CV
v6, CV
v7] = Int -> CV -> [CV]
fromCVTup Int
7 CV
cv
in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2, CV -> c
forall a. SymVal a => CV -> a
fromCV CV
v3, CV -> d
forall a. SymVal a => CV -> a
fromCV CV
v4, CV -> e
forall a. SymVal a => CV -> a
fromCV CV
v5, CV -> f
forall a. SymVal a => CV -> a
fromCV CV
v6, CV -> g
forall a. SymVal a => CV -> a
fromCV CV
v7)
instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g, SymVal h) => SymVal (a, b, c, d, e, f, g, h) where
mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (a, b, c, d, e, f, g, h))
mkSymVal = Kind
-> VarContext -> Maybe [Char] -> m (SBV (a, b, c, d, e, f, g, h))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Proxy (a, b, c, d, e, f, g, h) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e, f, g, h)))
literal :: (a, b, c, d, e, f, g, h) -> SBV (a, b, c, d, e, f, g, h)
literal (a
v1, b
v2, c
v3, d
v4, e
v5, f
v6, g
v7, h
v8) = Int -> Kind -> [CVal] -> SBV (a, b, c, d, e, f, g, h)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
8 (Proxy (a, b, c, d, e, f, g, h) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e, f, g, h))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2, c -> CVal
forall a. SymVal a => a -> CVal
toCV c
v3, d -> CVal
forall a. SymVal a => a -> CVal
toCV d
v4, e -> CVal
forall a. SymVal a => a -> CVal
toCV e
v5, f -> CVal
forall a. SymVal a => a -> CVal
toCV f
v6, g -> CVal
forall a. SymVal a => a -> CVal
toCV g
v7, h -> CVal
forall a. SymVal a => a -> CVal
toCV h
v8]
fromCV :: CV -> (a, b, c, d, e, f, g, h)
fromCV CV
cv = let ~[CV
v1, CV
v2, CV
v3, CV
v4, CV
v5, CV
v6, CV
v7, CV
v8] = Int -> CV -> [CV]
fromCVTup Int
8 CV
cv
in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2, CV -> c
forall a. SymVal a => CV -> a
fromCV CV
v3, CV -> d
forall a. SymVal a => CV -> a
fromCV CV
v4, CV -> e
forall a. SymVal a => CV -> a
fromCV CV
v5, CV -> f
forall a. SymVal a => CV -> a
fromCV CV
v6, CV -> g
forall a. SymVal a => CV -> a
fromCV CV
v7, CV -> h
forall a. SymVal a => CV -> a
fromCV CV
v8)
instance IsString SString where
fromString :: [Char] -> SString
fromString = [Char] -> SString
forall a. SymVal a => a -> SBV a
literal
sBool :: MonadSymbolic m => String -> m SBool
sBool :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SBool
sBool = [Char] -> m SBool
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sBool_ :: MonadSymbolic m => m SBool
sBool_ :: forall (m :: * -> *). MonadSymbolic m => m SBool
sBool_ = m SBool
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sBools :: MonadSymbolic m => [String] -> m [SBool]
sBools :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SBool]
sBools = [[Char]] -> m [SBool]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sWord8 :: MonadSymbolic m => String -> m SWord8
sWord8 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SWord8
sWord8 = [Char] -> m SWord8
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sWord8_ :: MonadSymbolic m => m SWord8
sWord8_ :: forall (m :: * -> *). MonadSymbolic m => m SWord8
sWord8_ = m SWord8
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sWord8s :: MonadSymbolic m => [String] -> m [SWord8]
sWord8s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SWord8]
sWord8s = [[Char]] -> m [SWord8]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sWord16 :: MonadSymbolic m => String -> m SWord16
sWord16 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SWord16
sWord16 = [Char] -> m SWord16
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sWord16_ :: MonadSymbolic m => m SWord16
sWord16_ :: forall (m :: * -> *). MonadSymbolic m => m SWord16
sWord16_ = m SWord16
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sWord16s :: MonadSymbolic m => [String] -> m [SWord16]
sWord16s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SWord16]
sWord16s = [[Char]] -> m [SWord16]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sWord32 :: MonadSymbolic m => String -> m SWord32
sWord32 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SWord32
sWord32 = [Char] -> m SWord32
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sWord32_ :: MonadSymbolic m => m SWord32
sWord32_ :: forall (m :: * -> *). MonadSymbolic m => m SWord32
sWord32_ = m SWord32
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sWord32s :: MonadSymbolic m => [String] -> m [SWord32]
sWord32s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SWord32]
sWord32s = [[Char]] -> m [SWord32]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sWord64 :: MonadSymbolic m => String -> m SWord64
sWord64 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SWord64
sWord64 = [Char] -> m SWord64
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sWord64_ :: MonadSymbolic m => m SWord64
sWord64_ :: forall (m :: * -> *). MonadSymbolic m => m SWord64
sWord64_ = m SWord64
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sWord64s :: MonadSymbolic m => [String] -> m [SWord64]
sWord64s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SWord64]
sWord64s = [[Char]] -> m [SWord64]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sInt8 :: MonadSymbolic m => String -> m SInt8
sInt8 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInt8
sInt8 = [Char] -> m SInt8
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sInt8_ :: MonadSymbolic m => m SInt8
sInt8_ :: forall (m :: * -> *). MonadSymbolic m => m SInt8
sInt8_ = m SInt8
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sInt8s :: MonadSymbolic m => [String] -> m [SInt8]
sInt8s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInt8]
sInt8s = [[Char]] -> m [SInt8]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sInt16 :: MonadSymbolic m => String -> m SInt16
sInt16 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInt16
sInt16 = [Char] -> m SInt16
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sInt16_ :: MonadSymbolic m => m SInt16
sInt16_ :: forall (m :: * -> *). MonadSymbolic m => m SInt16
sInt16_ = m SInt16
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sInt16s :: MonadSymbolic m => [String] -> m [SInt16]
sInt16s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInt16]
sInt16s = [[Char]] -> m [SInt16]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sInt32 :: MonadSymbolic m => String -> m SInt32
sInt32 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInt32
sInt32 = [Char] -> m SInt32
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sInt32_ :: MonadSymbolic m => m SInt32
sInt32_ :: forall (m :: * -> *). MonadSymbolic m => m SInt32
sInt32_ = m SInt32
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sInt32s :: MonadSymbolic m => [String] -> m [SInt32]
sInt32s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInt32]
sInt32s = [[Char]] -> m [SInt32]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sInt64 :: MonadSymbolic m => String -> m SInt64
sInt64 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInt64
sInt64 = [Char] -> m SInt64
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sInt64_ :: MonadSymbolic m => m SInt64
sInt64_ :: forall (m :: * -> *). MonadSymbolic m => m SInt64
sInt64_ = m SInt64
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sInt64s :: MonadSymbolic m => [String] -> m [SInt64]
sInt64s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInt64]
sInt64s = [[Char]] -> m [SInt64]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sInteger:: MonadSymbolic m => String -> m SInteger
sInteger :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInteger
sInteger = [Char] -> m SInteger
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sInteger_:: MonadSymbolic m => m SInteger
sInteger_ :: forall (m :: * -> *). MonadSymbolic m => m SInteger
sInteger_ = m SInteger
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sIntegers :: MonadSymbolic m => [String] -> m [SInteger]
sIntegers :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInteger]
sIntegers = [[Char]] -> m [SInteger]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sReal:: MonadSymbolic m => String -> m SReal
sReal :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SReal
sReal = [Char] -> m SReal
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sReal_:: MonadSymbolic m => m SReal
sReal_ :: forall (m :: * -> *). MonadSymbolic m => m SReal
sReal_ = m SReal
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sReals :: MonadSymbolic m => [String] -> m [SReal]
sReals :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SReal]
sReals = [[Char]] -> m [SReal]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sFloat :: MonadSymbolic m => String -> m SFloat
sFloat :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m (SBV Float)
sFloat = [Char] -> m (SBV Float)
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sFloat_ :: MonadSymbolic m => m SFloat
sFloat_ :: forall (m :: * -> *). MonadSymbolic m => m (SBV Float)
sFloat_ = m (SBV Float)
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sFloats :: MonadSymbolic m => [String] -> m [SFloat]
sFloats :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SBV Float]
sFloats = [[Char]] -> m [SBV Float]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sDouble :: MonadSymbolic m => String -> m SDouble
sDouble :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m (SBV Double)
sDouble = [Char] -> m (SBV Double)
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sDouble_ :: MonadSymbolic m => m SDouble
sDouble_ :: forall (m :: * -> *). MonadSymbolic m => m (SBV Double)
sDouble_ = m (SBV Double)
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sDoubles :: MonadSymbolic m => [String] -> m [SDouble]
sDoubles :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SBV Double]
sDoubles = [[Char]] -> m [SBV Double]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sFPHalf :: String -> Symbolic SFPHalf
sFPHalf :: [Char] -> Symbolic SFPHalf
sFPHalf = [Char] -> Symbolic SFPHalf
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sFPHalf_ :: Symbolic SFPHalf
sFPHalf_ :: Symbolic SFPHalf
sFPHalf_ = Symbolic SFPHalf
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sFPHalfs :: [String] -> Symbolic [SFPHalf]
sFPHalfs :: [[Char]] -> Symbolic [SFPHalf]
sFPHalfs = [[Char]] -> Symbolic [SFPHalf]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sFPBFloat :: String -> Symbolic SFPBFloat
sFPBFloat :: [Char] -> Symbolic SFPBFloat
sFPBFloat = [Char] -> Symbolic SFPBFloat
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sFPBFloat_ :: Symbolic SFPBFloat
sFPBFloat_ :: Symbolic SFPBFloat
sFPBFloat_ = Symbolic SFPBFloat
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sFPBFloats :: [String] -> Symbolic [SFPBFloat]
sFPBFloats :: [[Char]] -> Symbolic [SFPBFloat]
sFPBFloats = [[Char]] -> Symbolic [SFPBFloat]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sFPSingle :: String -> Symbolic SFPSingle
sFPSingle :: [Char] -> Symbolic SFPSingle
sFPSingle = [Char] -> Symbolic SFPSingle
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sFPSingle_ :: Symbolic SFPSingle
sFPSingle_ :: Symbolic SFPSingle
sFPSingle_ = Symbolic SFPSingle
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sFPSingles :: [String] -> Symbolic [SFPSingle]
sFPSingles :: [[Char]] -> Symbolic [SFPSingle]
sFPSingles = [[Char]] -> Symbolic [SFPSingle]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sFPDouble :: String -> Symbolic SFPDouble
sFPDouble :: [Char] -> Symbolic SFPDouble
sFPDouble = [Char] -> Symbolic SFPDouble
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sFPDouble_ :: Symbolic SFPDouble
sFPDouble_ :: Symbolic SFPDouble
sFPDouble_ = Symbolic SFPDouble
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sFPDoubles :: [String] -> Symbolic [SFPDouble]
sFPDoubles :: [[Char]] -> Symbolic [SFPDouble]
sFPDoubles = [[Char]] -> Symbolic [SFPDouble]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sFPQuad :: String -> Symbolic SFPQuad
sFPQuad :: [Char] -> Symbolic SFPQuad
sFPQuad = [Char] -> Symbolic SFPQuad
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sFPQuad_ :: Symbolic SFPQuad
sFPQuad_ :: Symbolic SFPQuad
sFPQuad_ = Symbolic SFPQuad
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sFPQuads :: [String] -> Symbolic [SFPQuad]
sFPQuads :: [[Char]] -> Symbolic [SFPQuad]
sFPQuads = [[Char]] -> Symbolic [SFPQuad]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sFloatingPoint :: ValidFloat eb sb => String -> Symbolic (SFloatingPoint eb sb)
sFloatingPoint :: forall (eb :: Nat) (sb :: Nat).
ValidFloat eb sb =>
[Char] -> Symbolic (SFloatingPoint eb sb)
sFloatingPoint = [Char] -> SymbolicT IO (SBV (FloatingPoint eb sb))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sFloatingPoint_ :: ValidFloat eb sb => Symbolic (SFloatingPoint eb sb)
sFloatingPoint_ :: forall (eb :: Nat) (sb :: Nat).
ValidFloat eb sb =>
Symbolic (SFloatingPoint eb sb)
sFloatingPoint_ = SymbolicT IO (SBV (FloatingPoint eb sb))
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sFloatingPoints :: ValidFloat eb sb => [String] -> Symbolic [SFloatingPoint eb sb]
sFloatingPoints :: forall (eb :: Nat) (sb :: Nat).
ValidFloat eb sb =>
[[Char]] -> Symbolic [SFloatingPoint eb sb]
sFloatingPoints = [[Char]] -> SymbolicT IO [SBV (FloatingPoint eb sb)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sChar :: MonadSymbolic m => String -> m SChar
sChar :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m (SBV Char)
sChar = [Char] -> m (SBV Char)
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sChar_ :: MonadSymbolic m => m SChar
sChar_ :: forall (m :: * -> *). MonadSymbolic m => m (SBV Char)
sChar_ = m (SBV Char)
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sChars :: MonadSymbolic m => [String] -> m [SChar]
sChars :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SBV Char]
sChars = [[Char]] -> m [SBV Char]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sString :: MonadSymbolic m => String -> m SString
sString :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SString
sString = [Char] -> m SString
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sString_ :: MonadSymbolic m => m SString
sString_ :: forall (m :: * -> *). MonadSymbolic m => m SString
sString_ = m SString
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sStrings :: MonadSymbolic m => [String] -> m [SString]
sStrings :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SString]
sStrings = [[Char]] -> m [SString]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sList :: (SymVal a, MonadSymbolic m) => String -> m (SList a)
sList :: forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SList a)
sList = [Char] -> m (SBV [a])
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sList_ :: (SymVal a, MonadSymbolic m) => m (SList a)
sList_ :: forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SList a)
sList_ = m (SBV [a])
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sLists :: (SymVal a, MonadSymbolic m) => [String] -> m [SList a]
sLists :: forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SList a]
sLists = [[Char]] -> m [SBV [a]]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
class SymTuple a
instance SymTuple ()
instance SymTuple (a, b)
instance SymTuple (a, b, c)
instance SymTuple (a, b, c, d)
instance SymTuple (a, b, c, d, e)
instance SymTuple (a, b, c, d, e, f)
instance SymTuple (a, b, c, d, e, f, g)
instance SymTuple (a, b, c, d, e, f, g, h)
sTuple :: (SymTuple tup, SymVal tup, MonadSymbolic m) => String -> m (SBV tup)
sTuple :: forall tup (m :: * -> *).
(SymTuple tup, SymVal tup, MonadSymbolic m) =>
[Char] -> m (SBV tup)
sTuple = [Char] -> m (SBV tup)
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sTuple_ :: (SymTuple tup, SymVal tup, MonadSymbolic m) => m (SBV tup)
sTuple_ :: forall tup (m :: * -> *).
(SymTuple tup, SymVal tup, MonadSymbolic m) =>
m (SBV tup)
sTuple_ = m (SBV tup)
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sTuples :: (SymTuple tup, SymVal tup, MonadSymbolic m) => [String] -> m [SBV tup]
sTuples :: forall tup (m :: * -> *).
(SymTuple tup, SymVal tup, MonadSymbolic m) =>
[[Char]] -> m [SBV tup]
sTuples = [[Char]] -> m [SBV tup]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sRational :: MonadSymbolic m => String -> m SRational
sRational :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m (SBV Rational)
sRational = [Char] -> m (SBV Rational)
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sRational_ :: MonadSymbolic m => m SRational
sRational_ :: forall (m :: * -> *). MonadSymbolic m => m (SBV Rational)
sRational_ = m (SBV Rational)
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sRationals :: MonadSymbolic m => [String] -> m [SRational]
sRationals :: forall (m :: * -> *).
MonadSymbolic m =>
[[Char]] -> m [SBV Rational]
sRationals = [[Char]] -> m [SBV Rational]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sEither :: (SymVal a, SymVal b, MonadSymbolic m) => String -> m (SEither a b)
sEither :: forall a b (m :: * -> *).
(SymVal a, SymVal b, MonadSymbolic m) =>
[Char] -> m (SEither a b)
sEither = [Char] -> m (SBV (Either a b))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sEither_ :: (SymVal a, SymVal b, MonadSymbolic m) => m (SEither a b)
sEither_ :: forall a b (m :: * -> *).
(SymVal a, SymVal b, MonadSymbolic m) =>
m (SEither a b)
sEither_ = m (SBV (Either a b))
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sEithers :: (SymVal a, SymVal b, MonadSymbolic m) => [String] -> m [SEither a b]
sEithers :: forall a b (m :: * -> *).
(SymVal a, SymVal b, MonadSymbolic m) =>
[[Char]] -> m [SEither a b]
sEithers = [[Char]] -> m [SBV (Either a b)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sMaybe :: (SymVal a, MonadSymbolic m) => String -> m (SMaybe a)
sMaybe :: forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SMaybe a)
sMaybe = [Char] -> m (SBV (Maybe a))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sMaybe_ :: (SymVal a, MonadSymbolic m) => m (SMaybe a)
sMaybe_ :: forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SMaybe a)
sMaybe_ = m (SBV (Maybe a))
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sMaybes :: (SymVal a, MonadSymbolic m) => [String] -> m [SMaybe a]
sMaybes :: forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SMaybe a]
sMaybes = [[Char]] -> m [SBV (Maybe a)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
sSet :: (Ord a, SymVal a, MonadSymbolic m) => String -> m (SSet a)
sSet :: forall a (m :: * -> *).
(Ord a, SymVal a, MonadSymbolic m) =>
[Char] -> m (SSet a)
sSet = [Char] -> m (SBV (RCSet a))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic
sSet_ :: (Ord a, SymVal a, MonadSymbolic m) => m (SSet a)
sSet_ :: forall a (m :: * -> *).
(Ord a, SymVal a, MonadSymbolic m) =>
m (SSet a)
sSet_ = m (SBV (RCSet a))
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_
sSets :: (Ord a, SymVal a, MonadSymbolic m) => [String] -> m [SSet a]
sSets :: forall a (m :: * -> *).
(Ord a, SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SSet a]
sSets = [[Char]] -> m [SBV (RCSet a)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics
solve :: MonadSymbolic m => [SBool] -> m SBool
solve :: forall (m :: * -> *). MonadSymbolic m => [SBool] -> m SBool
solve = SBool -> m SBool
forall (m :: * -> *) a. Monad m => a -> m a
return (SBool -> m SBool) -> ([SBool] -> SBool) -> [SBool] -> m SBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SBool] -> SBool
sAnd
sRealToSInteger :: SReal -> SInteger
sRealToSInteger :: SReal -> SInteger
sRealToSInteger SReal
x
| Just AlgReal
i <- SReal -> Maybe AlgReal
forall a. SymVal a => SBV a -> Maybe a
unliteral SReal
x, AlgReal -> Bool
isExactRational AlgReal
i
= Integer -> SInteger
forall a. SymVal a => a -> SBV a
literal (Integer -> SInteger) -> Integer -> SInteger
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (AlgReal -> Rational
forall a. Real a => a -> Rational
toRational AlgReal
i)
| Bool
True
= SVal -> SInteger
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KUnbounded (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
y)))
where y :: State -> IO SV
y State
st = do SV
xsv <- State -> SReal -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SReal
x
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KUnbounded (Op -> [SV] -> SBVExpr
SBVApp (Kind -> Kind -> Op
KindCast Kind
KReal Kind
KUnbounded) [SV
xsv])
label :: SymVal a => String -> SBV a -> SBV a
label :: forall a. SymVal a => [Char] -> SBV a -> SBV a
label [Char]
m SBV a
x
| Just a
_ <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x = SBV a
x
| Bool
True = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
r :: State -> IO SV
r State
st = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Label [Char]
m) [SV
xsv])
checkObservableName :: String -> Maybe String
checkObservableName :: [Char] -> Maybe [Char]
checkObservableName [Char]
lbl
| [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
lbl
= [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"SBV.observe: Bad empty name!"
| (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
lbl [Char] -> [[Char]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
smtLibReservedNames
= [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.observe: The name chosen is reserved, please change it!: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
lbl
| [Char]
"s" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
lbl Bool -> Bool -> Bool
&& (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
1 [Char]
lbl)
= [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.observe: Names of the form sXXX are internal to SBV, please use a different name: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
lbl
| Bool
True
= Maybe [Char]
forall a. Maybe a
Nothing
observeIf :: SymVal a => (a -> Bool) -> String -> SBV a -> SBV a
observeIf :: forall a. SymVal a => (a -> Bool) -> [Char] -> SBV a -> SBV a
observeIf a -> Bool
cond [Char]
m SBV a
x
| Just [Char]
bad <- [Char] -> Maybe [Char]
checkObservableName [Char]
m
= [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error [Char]
bad
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
r :: State -> IO SV
r State
st = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
State -> [Char] -> (CV -> Bool) -> SV -> IO ()
recordObservable State
st [Char]
m (a -> Bool
cond (a -> Bool) -> (CV -> a) -> CV -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> a
forall a. SymVal a => CV -> a
fromCV) SV
xsv
SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
xsv
observe :: SymVal a => String -> SBV a -> SBV a
observe :: forall a. SymVal a => [Char] -> SBV a -> SBV a
observe = (a -> Bool) -> [Char] -> SBV a -> SBV a
forall a. SymVal a => (a -> Bool) -> [Char] -> SBV a -> SBV a
observeIf (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)
sObserve :: SymVal a => String -> SBV a -> Symbolic ()
sObserve :: forall a. SymVal a => [Char] -> SBV a -> Symbolic ()
sObserve [Char]
m SBV a
x
| Just [Char]
bad <- [Char] -> Maybe [Char]
checkObservableName [Char]
m
= [Char] -> Symbolic ()
forall a. HasCallStack => [Char] -> a
error [Char]
bad
| Bool
True
= do State
st <- SymbolicT IO State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
IO () -> Symbolic ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Symbolic ()) -> IO () -> Symbolic ()
forall a b. (a -> b) -> a -> b
$ do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
State -> [Char] -> (CV -> Bool) -> SV -> IO ()
recordObservable State
st [Char]
m (Bool -> CV -> Bool
forall a b. a -> b -> a
const Bool
True) SV
xsv
infix 4 .==, ./=, .===, ./==
class EqSymbolic a where
(.==) :: a -> a -> SBool
(./=) :: a -> a -> SBool
(.===) :: a -> a -> SBool
(./==) :: a -> a -> SBool
distinct :: [a] -> SBool
distinctExcept :: [a] -> [a] -> SBool
allEqual :: [a] -> SBool
sElem :: a -> [a] -> SBool
sNotElem :: a -> [a] -> SBool
{-# MINIMAL (.==) #-}
a
x ./= a
y = SBool -> SBool
sNot (a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
y)
a
x .=== a
y = a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
y
a
x ./== a
y = SBool -> SBool
sNot (a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== a
y)
allEqual [] = SBool
sTrue
allEqual (a
x:[a]
xs) = (a -> SBool) -> [a] -> SBool
forall a. (a -> SBool) -> [a] -> SBool
sAll (a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.==) [a]
xs
distinct [] = SBool
sTrue
distinct (a
x:[a]
xs) = (a -> SBool) -> [a] -> SBool
forall a. (a -> SBool) -> [a] -> SBool
sAll (a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
./=) [a]
xs SBool -> SBool -> SBool
.&& [a] -> SBool
forall a. EqSymbolic a => [a] -> SBool
distinct [a]
xs
distinctExcept [a]
es [a]
ignored = [a] -> SBool
go [a]
es
where isIgnored :: a -> SBool
isIgnored = (a -> [a] -> SBool
forall a. EqSymbolic a => a -> [a] -> SBool
`sElem` [a]
ignored)
go :: [a] -> SBool
go [] = SBool
sTrue
go (a
x:[a]
xs) = let xOK :: SBool
xOK = a -> SBool
isIgnored a
x SBool -> SBool -> SBool
.|| (a -> SBool) -> [a] -> SBool
forall a. (a -> SBool) -> [a] -> SBool
sAll (\a
y -> a -> SBool
isIgnored a
y SBool -> SBool -> SBool
.|| a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
./= a
y) [a]
xs
in SBool
xOK SBool -> SBool -> SBool
.&& [a] -> SBool
go [a]
xs
a
x `sElem` [a]
xs = (a -> SBool) -> [a] -> SBool
forall a. (a -> SBool) -> [a] -> SBool
sAny (a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
x) [a]
xs
a
x `sNotElem` [a]
xs = SBool -> SBool
sNot (a
x a -> [a] -> SBool
forall a. EqSymbolic a => a -> [a] -> SBool
`sElem` [a]
xs)
infix 4 .<, .<=, .>, .>=
class (Mergeable a, EqSymbolic a) => OrdSymbolic a where
(.<) :: a -> a -> SBool
(.<=) :: a -> a -> SBool
(.>) :: a -> a -> SBool
(.>=) :: a -> a -> SBool
smin :: a -> a -> a
smax :: a -> a -> a
inRange :: a -> (a, a) -> SBool
{-# MINIMAL (.<) #-}
a
a .<= a
b = a
a a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
b SBool -> SBool -> SBool
.|| a
a a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
b
a
a .> a
b = a
b a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
a
a
a .>= a
b = a
b a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<= a
a
a
a `smin` a
b = SBool -> a -> a -> a
forall a. Mergeable a => SBool -> a -> a -> a
ite (a
a a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<= a
b) a
a a
b
a
a `smax` a
b = SBool -> a -> a -> a
forall a. Mergeable a => SBool -> a -> a -> a
ite (a
a a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<= a
b) a
b a
a
inRange a
x (a
y, a
z) = a
x a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= a
y SBool -> SBool -> SBool
.&& a
x a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<= a
z
instance EqSymbolic (SBV a) where
SBV SVal
x .== :: SBV a -> SBV a -> SBool
.== SBV SVal
y = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svEqual SVal
x SVal
y)
SBV SVal
x ./= :: SBV a -> SBV a -> SBool
./= SBV SVal
y = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svNotEqual SVal
x SVal
y)
SBV SVal
x .=== :: SBV a -> SBV a -> SBool
.=== SBV SVal
y = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svStrongEqual SVal
x SVal
y)
distinct :: [SBV a] -> SBool
distinct [] = SBool
sTrue
distinct [SBV a
_] = SBool
sTrue
distinct [SBV a]
xs | (SBV a -> Bool) -> [SBV a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBV a -> Bool
forall {a}. SBV a -> Bool
isConc [SBV a]
xs = [SBV a] -> SBool
forall a. EqSymbolic a => [a] -> SBool
checkDiff [SBV a]
xs
| [SBV SVal
a, SBV SVal
b] <- [SBV a]
xs, SVal
a SVal -> SVal -> Bool
`is` Bool -> SVal
svBool Bool
True = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ SVal -> SVal
svNot SVal
b
| [SBV SVal
a, SBV SVal
b] <- [SBV a]
xs, SVal
b SVal -> SVal -> Bool
`is` Bool -> SVal
svBool Bool
True = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ SVal -> SVal
svNot SVal
a
| [SBV SVal
a, SBV SVal
b] <- [SBV a]
xs, SVal
a SVal -> SVal -> Bool
`is` Bool -> SVal
svBool Bool
False = SVal -> SBool
forall a. SVal -> SBV a
SBV SVal
b
| [SBV SVal
a, SBV SVal
b] <- [SBV a]
xs, SVal
b SVal -> SVal -> Bool
`is` Bool -> SVal
svBool Bool
False = SVal -> SBool
forall a. SVal -> SBV a
SBV SVal
a
| [SBV a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBV a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& SBV a -> Bool
forall {a}. SBV a -> Bool
isBool ([SBV a] -> SBV a
forall a. [a] -> a
head [SBV a]
xs) = SBool
sFalse
| Bool
True = SVal -> SBool
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
where r :: State -> IO SV
r State
st = do [SV]
xsv <- (SBV a -> IO SV) -> [SBV a] -> IO [SV]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st) [SBV a]
xs
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool (Op -> [SV] -> SBVExpr
SBVApp Op
NotEqual [SV]
xsv)
checkDiff :: [a] -> SBool
checkDiff [] = SBool
sTrue
checkDiff (a
a:[a]
as) = (a -> SBool) -> [a] -> SBool
forall a. (a -> SBool) -> [a] -> SBool
sAll (a
a a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
./=) [a]
as SBool -> SBool -> SBool
.&& [a] -> SBool
checkDiff [a]
as
isConc :: SBV a -> Bool
isConc (SBV (SVal Kind
_ (Left CV
_))) = Bool
True
isConc SBV a
_ = Bool
False
SVal Kind
k1 (Left CV
c1) is :: SVal -> SVal -> Bool
`is` SVal Kind
k2 (Left CV
c2) = (Kind
k1, CV
c1) (Kind, CV) -> (Kind, CV) -> Bool
forall a. Eq a => a -> a -> Bool
== (Kind
k2, CV
c2)
SVal
_ `is` SVal
_ = Bool
False
isBool :: SBV a -> Bool
isBool (SBV (SVal Kind
KBool Either CV (Cached SV)
_)) = Bool
True
isBool SBV a
_ = Bool
False
distinctExcept :: [SBV a] -> [SBV a] -> SBool
distinctExcept [] [SBV a]
_ = SBool
sTrue
distinctExcept [SBV a
_] [SBV a]
_ = SBool
sTrue
distinctExcept [SBV a]
es [SBV a]
ignored
| (SBV a -> Bool) -> [SBV a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBV a -> Bool
forall {a}. SBV a -> Bool
isConc ([SBV a]
es [SBV a] -> [SBV a] -> [SBV a]
forall a. [a] -> [a] -> [a]
++ [SBV a]
ignored)
= [SBV a] -> SBool
forall a. EqSymbolic a => [a] -> SBool
distinct ((SBV a -> Bool) -> [SBV a] -> [SBV a]
forall a. (a -> Bool) -> [a] -> [a]
filter SBV a -> Bool
ignoreConc [SBV a]
es)
| Bool
True
= SVal -> SBool
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
where ignoreConc :: SBV a -> Bool
ignoreConc SBV a
x = case SBV a
x SBV a -> [SBV a] -> SBool
forall a. EqSymbolic a => a -> [a] -> SBool
`sElem` [SBV a]
ignored of
SBV (SVal Kind
KBool (Left CV
cv)) -> CV -> Bool
cvToBool CV
cv
SBool
_ -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"distinctExcept: Impossible happened, concrete sElem failed: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([SBV a], [SBV a], SBV a) -> [Char]
forall a. Show a => a -> [Char]
show ([SBV a]
es, [SBV a]
ignored, SBV a
x)
ek :: Kind
ek = case [SBV a] -> SBV a
forall a. [a] -> a
head [SBV a]
es of
SBV (SVal Kind
k Either CV (Cached SV)
_) -> Kind
k
r :: State -> IO SV
r State
st = do let zero :: SInteger
zero = SInteger
0 :: SInteger
SArray a Integer
arr <- SArr -> SArray a Integer
forall a b. SArr -> SArray a b
SArray (SArr -> SArray a Integer) -> IO SArr -> IO (SArray a Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> (Kind, Kind) -> (Int -> [Char]) -> Maybe SVal -> IO SArr
newSArr State
st (Kind
ek, Kind
KUnbounded) (\Int
i -> [Char]
"array_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
i) (SVal -> Maybe SVal
forall a. a -> Maybe a
Just (SInteger -> SVal
forall a. SBV a -> SVal
unSBV SInteger
zero))
let incr :: SBV a -> SArray a Integer -> SInteger
incr SBV a
x SArray a Integer
table = SBool -> SInteger -> SInteger -> SInteger
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
x SBV a -> [SBV a] -> SBool
forall a. EqSymbolic a => a -> [a] -> SBool
`sElem` [SBV a]
ignored) SInteger
zero (SInteger
1 SInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
+ SArray a Integer -> SBV a -> SInteger
forall (array :: * -> * -> *) a b.
SymArray array =>
array a b -> SBV a -> SBV b
readArray SArray a Integer
table SBV a
x)
finalArray :: SArray a Integer
finalArray = (SArray a Integer -> SBV a -> SArray a Integer)
-> SArray a Integer -> [SBV a] -> SArray a Integer
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\SArray a Integer
table SBV a
x -> SArray a Integer -> SBV a -> SInteger -> SArray a Integer
forall (array :: * -> * -> *) b a.
(SymArray array, SymVal b) =>
array a b -> SBV a -> SBV b -> array a b
writeArray SArray a Integer
table SBV a
x (SBV a -> SArray a Integer -> SInteger
incr SBV a
x SArray a Integer
table)) SArray a Integer
arr [SBV a]
es
State -> SBool -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBool -> IO SV) -> SBool -> IO SV
forall a b. (a -> b) -> a -> b
$ (SBV a -> SBool) -> [SBV a] -> SBool
forall a. (a -> SBool) -> [a] -> SBool
sAll (\SBV a
e -> SArray a Integer -> SBV a -> SInteger
forall (array :: * -> * -> *) a b.
SymArray array =>
array a b -> SBV a -> SBV b
readArray SArray a Integer
finalArray SBV a
e SInteger -> SInteger -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<= SInteger
1) [SBV a]
es
isConc :: SBV a -> Bool
isConc (SBV (SVal Kind
_ (Left CV
_))) = Bool
True
isConc SBV a
_ = Bool
False
instance (Ord a, SymVal a) => OrdSymbolic (SBV a) where
a :: SBV a
a@(SBV SVal
x) .< :: SBV a -> SBV a -> SBool
.< b :: SBV a
b@(SBV SVal
y) | [Char] -> SBV a -> SBV a -> Bool
forall a. (SymVal a, HasKind a) => [Char] -> SBV a -> SBV a -> Bool
smtComparable [Char]
"<" SBV a
a SBV a
b = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svLessThan SVal
x SVal
y)
| Bool
True = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svStructuralLessThan SVal
x SVal
y)
a :: SBV a
a@(SBV SVal
x) .<= :: SBV a -> SBV a -> SBool
.<= b :: SBV a
b@(SBV SVal
y) | [Char] -> SBV a -> SBV a -> Bool
forall a. (SymVal a, HasKind a) => [Char] -> SBV a -> SBV a -> Bool
smtComparable [Char]
".<=" SBV a
a SBV a
b = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svLessEq SVal
x SVal
y)
| Bool
True = SBV a
a SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< SBV a
b SBool -> SBool -> SBool
.|| SBV a
a SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
b
a :: SBV a
a@(SBV SVal
x) .> :: SBV a -> SBV a -> SBool
.> b :: SBV a
b@(SBV SVal
y) | [Char] -> SBV a -> SBV a -> Bool
forall a. (SymVal a, HasKind a) => [Char] -> SBV a -> SBV a -> Bool
smtComparable [Char]
">" SBV a
a SBV a
b = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svGreaterThan SVal
x SVal
y)
| Bool
True = SBV a
b SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< SBV a
a
a :: SBV a
a@(SBV SVal
x) .>= :: SBV a -> SBV a -> SBool
.>= b :: SBV a
b@(SBV SVal
y) | [Char] -> SBV a -> SBV a -> Bool
forall a. (SymVal a, HasKind a) => [Char] -> SBV a -> SBV a -> Bool
smtComparable [Char]
">=" SBV a
a SBV a
b = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svGreaterEq SVal
x SVal
y)
| Bool
True = SBV a
b SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<= SBV a
a
smtComparable :: (SymVal a, HasKind a) => String -> SBV a -> SBV a -> Bool
smtComparable :: forall a. (SymVal a, HasKind a) => [Char] -> SBV a -> SBV a -> Bool
smtComparable [Char]
op SBV a
x SBV a
y
| SBV a -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV a
x Bool -> Bool -> Bool
&& SBV a -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (Kind -> Bool
forall a. HasKind a => a -> Bool
isSet Kind
k)
= Bool
True
| Bool
True
= case Kind
k of
Kind
KBool -> Bool
True
KBounded {} -> Bool
True
KUnbounded {} -> Bool
True
KReal {} -> Bool
True
KUserSort {} -> Bool
True
Kind
KFloat -> Bool
True
Kind
KDouble -> Bool
True
KRational {} -> Bool
True
KFP {} -> Bool
True
Kind
KChar -> Bool
True
Kind
KString -> Bool
True
KList {} -> Bool
nope
KSet {} -> Bool
nope
KTuple {} -> Bool
False
KMaybe {} -> Bool
False
KEither {} -> Bool
False
where k :: Kind
k = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
nope :: Bool
nope = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Data.SBV.OrdSymbolic: SMTLib does not support " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
op [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
instance EqSymbolic Bool where
Bool
x .== :: Bool -> Bool -> SBool
.== Bool
y = Bool -> SBool
fromBool (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y
instance EqSymbolic a => EqSymbolic [a] where
[] .== :: [a] -> [a] -> SBool
.== [] = SBool
sTrue
(a
x:[a]
xs) .== (a
y:[a]
ys) = a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
y SBool -> SBool -> SBool
.&& [a]
xs [a] -> [a] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== [a]
ys
[a]
_ .== [a]
_ = SBool
sFalse
instance OrdSymbolic a => OrdSymbolic [a] where
[] .< :: [a] -> [a] -> SBool
.< [] = SBool
sFalse
[] .< [a]
_ = SBool
sTrue
[a]
_ .< [] = SBool
sFalse
(a
x:[a]
xs) .< (a
y:[a]
ys) = a
x a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
y SBool -> SBool -> SBool
.|| (a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
y SBool -> SBool -> SBool
.&& [a]
xs [a] -> [a] -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< [a]
ys)
instance EqSymbolic a => EqSymbolic (Maybe a) where
Maybe a
Nothing .== :: Maybe a -> Maybe a -> SBool
.== Maybe a
Nothing = SBool
sTrue
Just a
a .== Just a
b = a
a a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
b
Maybe a
_ .== Maybe a
_ = SBool
sFalse
instance OrdSymbolic a => OrdSymbolic (Maybe a) where
Maybe a
Nothing .< :: Maybe a -> Maybe a -> SBool
.< Maybe a
Nothing = SBool
sFalse
Maybe a
Nothing .< Maybe a
_ = SBool
sTrue
Just a
_ .< Maybe a
Nothing = SBool
sFalse
Just a
a .< Just a
b = a
a a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
b
instance (EqSymbolic a, EqSymbolic b) => EqSymbolic (Either a b) where
Left a
a .== :: Either a b -> Either a b -> SBool
.== Left a
b = a
a a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
b
Right b
a .== Right b
b = b
a b -> b -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== b
b
Either a b
_ .== Either a b
_ = SBool
sFalse
instance (OrdSymbolic a, OrdSymbolic b) => OrdSymbolic (Either a b) where
Left a
a .< :: Either a b -> Either a b -> SBool
.< Left a
b = a
a a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
b
Left a
_ .< Right b
_ = SBool
sTrue
Right b
_ .< Left a
_ = SBool
sFalse
Right b
a .< Right b
b = b
a b -> b -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< b
b
instance (EqSymbolic a, EqSymbolic b) => EqSymbolic (a, b) where
(a
a0, b
b0) .== :: (a, b) -> (a, b) -> SBool
.== (a
a1, b
b1) = a
a0 a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
a1 SBool -> SBool -> SBool
.&& b
b0 b -> b -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== b
b1
instance (OrdSymbolic a, OrdSymbolic b) => OrdSymbolic (a, b) where
(a
a0, b
b0) .< :: (a, b) -> (a, b) -> SBool
.< (a
a1, b
b1) = a
a0 a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
a1 SBool -> SBool -> SBool
.|| (a
a0 a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
a1 SBool -> SBool -> SBool
.&& b
b0 b -> b -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< b
b1)
instance (EqSymbolic a, EqSymbolic b, EqSymbolic c) => EqSymbolic (a, b, c) where
(a
a0, b
b0, c
c0) .== :: (a, b, c) -> (a, b, c) -> SBool
.== (a
a1, b
b1, c
c1) = (a
a0, b
b0) (a, b) -> (a, b) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1) SBool -> SBool -> SBool
.&& c
c0 c -> c -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== c
c1
instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c) => OrdSymbolic (a, b, c) where
(a
a0, b
b0, c
c0) .< :: (a, b, c) -> (a, b, c) -> SBool
.< (a
a1, b
b1, c
c1) = (a
a0, b
b0) (a, b) -> (a, b) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1) SBool -> SBool -> SBool
.|| ((a
a0, b
b0) (a, b) -> (a, b) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1) SBool -> SBool -> SBool
.&& c
c0 c -> c -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< c
c1)
instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d) => EqSymbolic (a, b, c, d) where
(a
a0, b
b0, c
c0, d
d0) .== :: (a, b, c, d) -> (a, b, c, d) -> SBool
.== (a
a1, b
b1, c
c1, d
d1) = (a
a0, b
b0, c
c0) (a, b, c) -> (a, b, c) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1) SBool -> SBool -> SBool
.&& d
d0 d -> d -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== d
d1
instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d) => OrdSymbolic (a, b, c, d) where
(a
a0, b
b0, c
c0, d
d0) .< :: (a, b, c, d) -> (a, b, c, d) -> SBool
.< (a
a1, b
b1, c
c1, d
d1) = (a
a0, b
b0, c
c0) (a, b, c) -> (a, b, c) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1, c
c1) SBool -> SBool -> SBool
.|| ((a
a0, b
b0, c
c0) (a, b, c) -> (a, b, c) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1) SBool -> SBool -> SBool
.&& d
d0 d -> d -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< d
d1)
instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d, EqSymbolic e) => EqSymbolic (a, b, c, d, e) where
(a
a0, b
b0, c
c0, d
d0, e
e0) .== :: (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1) = (a
a0, b
b0, c
c0, d
d0) (a, b, c, d) -> (a, b, c, d) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1) SBool -> SBool -> SBool
.&& e
e0 e -> e -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== e
e1
instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e) => OrdSymbolic (a, b, c, d, e) where
(a
a0, b
b0, c
c0, d
d0, e
e0) .< :: (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
.< (a
a1, b
b1, c
c1, d
d1, e
e1) = (a
a0, b
b0, c
c0, d
d0) (a, b, c, d) -> (a, b, c, d) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1, c
c1, d
d1) SBool -> SBool -> SBool
.|| ((a
a0, b
b0, c
c0, d
d0) (a, b, c, d) -> (a, b, c, d) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1) SBool -> SBool -> SBool
.&& e
e0 e -> e -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< e
e1)
instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d, EqSymbolic e, EqSymbolic f) => EqSymbolic (a, b, c, d, e, f) where
(a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) .== :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) = (a
a0, b
b0, c
c0, d
d0, e
e0) (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1) SBool -> SBool -> SBool
.&& f
f0 f -> f -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== f
f1
instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e, OrdSymbolic f) => OrdSymbolic (a, b, c, d, e, f) where
(a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) .< :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
.< (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) = (a
a0, b
b0, c
c0, d
d0, e
e0) (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1, c
c1, d
d1, e
e1)
SBool -> SBool -> SBool
.|| ((a
a0, b
b0, c
c0, d
d0, e
e0) (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1) SBool -> SBool -> SBool
.&& f
f0 f -> f -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< f
f1)
instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d, EqSymbolic e, EqSymbolic f, EqSymbolic g) => EqSymbolic (a, b, c, d, e, f, g) where
(a
a0, b
b0, c
c0, d
d0, e
e0, f
f0, g
g0) .== :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1, g
g1) = (a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) SBool -> SBool -> SBool
.&& g
g0 g -> g -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== g
g1
instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e, OrdSymbolic f, OrdSymbolic g) => OrdSymbolic (a, b, c, d, e, f, g) where
(a
a0, b
b0, c
c0, d
d0, e
e0, f
f0, g
g0) .< :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> SBool
.< (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1, g
g1) = (a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1)
SBool -> SBool -> SBool
.|| ((a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) SBool -> SBool -> SBool
.&& g
g0 g -> g -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< g
g1)
class (SymVal a, Num a, Bits a, Integral a) => SIntegral a
instance SIntegral Word8
instance SIntegral Word16
instance SIntegral Word32
instance SIntegral Word64
instance SIntegral Int8
instance SIntegral Int16
instance SIntegral Int32
instance SIntegral Int64
instance SIntegral Integer
class (Ord a, SymVal a, Num a, Bits a) => SFiniteBits a where
sFiniteBitSize :: SBV a -> Int
lsb :: SBV a -> SBool
msb :: SBV a -> SBool
blastBE :: SBV a -> [SBool]
blastLE :: SBV a -> [SBool]
fromBitsBE :: [SBool] -> SBV a
fromBitsLE :: [SBool] -> SBV a
sTestBit :: SBV a -> Int -> SBool
:: SBV a -> [Int] -> [SBool]
sPopCount :: SBV a -> SWord8
setBitTo :: SBV a -> Int -> SBool -> SBV a
fullAdder :: SBV a -> SBV a -> (SBool, SBV a)
fullMultiplier :: SBV a -> SBV a -> (SBV a, SBV a)
sCountLeadingZeros :: SBV a -> SWord8
sCountTrailingZeros :: SBV a -> SWord8
{-# MINIMAL sFiniteBitSize #-}
lsb (SBV SVal
v) = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svTestBit SVal
v Int
0)
msb SBV a
x = SBV a -> Int -> SBool
forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x (SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
blastBE = [SBool] -> [SBool]
forall a. [a] -> [a]
reverse ([SBool] -> [SBool]) -> (SBV a -> [SBool]) -> SBV a -> [SBool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBV a -> [SBool]
forall a. SFiniteBits a => SBV a -> [SBool]
blastLE
blastLE SBV a
x = (Int -> SBool) -> [Int] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map (SBV a -> Int -> SBool
forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x) [Int
0 .. SBV a -> Int
forall a. HasKind a => a -> Int
intSizeOf SBV a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
fromBitsBE = [SBool] -> SBV a
forall a. SFiniteBits a => [SBool] -> SBV a
fromBitsLE ([SBool] -> SBV a) -> ([SBool] -> [SBool]) -> [SBool] -> SBV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SBool] -> [SBool]
forall a. [a] -> [a]
reverse
fromBitsLE [SBool]
bs
| [SBool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBool]
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
w
= [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.SFiniteBits.fromBitsLE/BE: Expected: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
w [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" bits, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show ([SBool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBool]
bs)
| Bool
True
= SBV a
result
where w :: Int
w = SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
result
result :: SBV a
result = SBV a -> Int -> [SBool] -> SBV a
forall {t}. (Mergeable t, Bits t) => t -> Int -> [SBool] -> t
go SBV a
0 Int
0 [SBool]
bs
go :: t -> Int -> [SBool] -> t
go !t
acc Int
_ [] = t
acc
go !t
acc !Int
i (SBool
x:[SBool]
xs) = t -> Int -> [SBool] -> t
go (SBool -> t -> t -> t
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
x (t -> Int -> t
forall a. Bits a => a -> Int -> a
setBit t
acc Int
i) t
acc) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [SBool]
xs
sTestBit (SBV SVal
x) Int
i = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svTestBit SVal
x Int
i)
sExtractBits SBV a
x = (Int -> SBool) -> [Int] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map (SBV a -> Int -> SBool
forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x)
sPopCount SBV a
x
| SBV a -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV a
x = SWord8 -> SBV a -> SWord8
forall {t} {t}. (Num t, Num t, Bits t) => t -> t -> t
go SWord8
0 SBV a
x
| Bool
True = [SWord8] -> SWord8
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [SBool -> SWord8 -> SWord8 -> SWord8
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
b SWord8
1 SWord8
0 | SBool
b <- SBV a -> [SBool]
forall a. SFiniteBits a => SBV a -> [SBool]
blastLE SBV a
x]
where
go :: t -> t -> t
go !t
c t
0 = t
c
go !t
c t
w = t -> t -> t
go (t
ct -> t -> t
forall a. Num a => a -> a -> a
+t
1) (t
w t -> t -> t
forall a. Bits a => a -> a -> a
.&. (t
wt -> t -> t
forall a. Num a => a -> a -> a
-t
1))
setBitTo SBV a
x Int
i SBool
b = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
b (SBV a -> Int -> SBV a
forall a. Bits a => a -> Int -> a
setBit SBV a
x Int
i) (SBV a -> Int -> SBV a
forall a. Bits a => a -> Int -> a
clearBit SBV a
x Int
i)
fullAdder SBV a
a SBV a
b
| SBV a -> Bool
forall a. Bits a => a -> Bool
isSigned SBV a
a = [Char] -> (SBool, SBV a)
forall a. HasCallStack => [Char] -> a
error [Char]
"fullAdder: only works on unsigned numbers"
| Bool
True = (SBV a
a SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.> SBV a
s SBool -> SBool -> SBool
.|| SBV a
b SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.> SBV a
s, SBV a
s)
where s :: SBV a
s = SBV a
a SBV a -> SBV a -> SBV a
forall a. Num a => a -> a -> a
+ SBV a
b
fullMultiplier SBV a
a SBV a
b
| SBV a -> Bool
forall a. Bits a => a -> Bool
isSigned SBV a
a = [Char] -> (SBV a, SBV a)
forall a. HasCallStack => [Char] -> a
error [Char]
"fullMultiplier: only works on unsigned numbers"
| Bool
True = (Int -> SBV a -> SBV a -> SBV a
go (SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
a) SBV a
0 SBV a
a, SBV a
aSBV a -> SBV a -> SBV a
forall a. Num a => a -> a -> a
*SBV a
b)
where go :: Int -> SBV a -> SBV a -> SBV a
go Int
0 SBV a
p SBV a
_ = SBV a
p
go Int
n SBV a
p SBV a
x = let (SBool
c, SBV a
p') = SBool -> (SBool, SBV a) -> (SBool, SBV a) -> (SBool, SBV a)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> SBool
forall a. SFiniteBits a => SBV a -> SBool
lsb SBV a
x) (SBV a -> SBV a -> (SBool, SBV a)
forall a. SFiniteBits a => SBV a -> SBV a -> (SBool, SBV a)
fullAdder SBV a
p SBV a
b) (SBool
sFalse, SBV a
p)
(SBool
o, SBV a
p'') = SBool -> SBV a -> (SBool, SBV a)
forall {a}. SFiniteBits a => SBool -> SBV a -> (SBool, SBV a)
shiftIn SBool
c SBV a
p'
(SBool
_, SBV a
x') = SBool -> SBV a -> (SBool, SBV a)
forall {a}. SFiniteBits a => SBool -> SBV a -> (SBool, SBV a)
shiftIn SBool
o SBV a
x
in Int -> SBV a -> SBV a -> SBV a
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) SBV a
p'' SBV a
x'
shiftIn :: SBool -> SBV a -> (SBool, SBV a)
shiftIn SBool
k SBV a
v = (SBV a -> SBool
forall a. SFiniteBits a => SBV a -> SBool
lsb SBV a
v, SBV a
mask SBV a -> SBV a -> SBV a
forall a. Bits a => a -> a -> a
.|. (SBV a
v SBV a -> Int -> SBV a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1))
where mask :: SBV a
mask = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
k (Int -> SBV a
forall a. Bits a => Int -> a
bit (SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) SBV a
0
sCountLeadingZeros SBV a
x = Int -> SWord8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m SWord8 -> SWord8 -> SWord8
forall a. Num a => a -> a -> a
- Int -> SWord8
go Int
m
where m :: Int
m = SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
go :: Int -> SWord8
go :: Int -> SWord8
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = SWord8
i8
| Bool
True = SBool -> SWord8 -> SWord8 -> SWord8
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> Int -> SBool
forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x Int
i) SWord8
i8 (Int -> SWord8
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
where i8 :: SWord8
i8 = Word8 -> SWord8
forall a. SymVal a => a -> SBV a
literal (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word8)
sCountTrailingZeros SBV a
x = Int -> SWord8
go Int
0
where m :: Int
m = SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
x
go :: Int -> SWord8
go :: Int -> SWord8
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m = SWord8
i8
| Bool
True = SBool -> SWord8 -> SWord8 -> SWord8
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> Int -> SBool
forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x Int
i) SWord8
i8 (Int -> SWord8
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
where i8 :: SWord8
i8 = Word8 -> SWord8
forall a. SymVal a => a -> SBV a
literal (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word8)
instance SFiniteBits Word8 where sFiniteBitSize :: SWord8 -> Int
sFiniteBitSize SWord8
_ = Int
8
instance SFiniteBits Word16 where sFiniteBitSize :: SWord16 -> Int
sFiniteBitSize SWord16
_ = Int
16
instance SFiniteBits Word32 where sFiniteBitSize :: SWord32 -> Int
sFiniteBitSize SWord32
_ = Int
32
instance SFiniteBits Word64 where sFiniteBitSize :: SWord64 -> Int
sFiniteBitSize SWord64
_ = Int
64
instance SFiniteBits Int8 where sFiniteBitSize :: SInt8 -> Int
sFiniteBitSize SInt8
_ = Int
8
instance SFiniteBits Int16 where sFiniteBitSize :: SInt16 -> Int
sFiniteBitSize SInt16
_ = Int
16
instance SFiniteBits Int32 where sFiniteBitSize :: SInt32 -> Int
sFiniteBitSize SInt32
_ = Int
32
instance SFiniteBits Int64 where sFiniteBitSize :: SInt64 -> Int
sFiniteBitSize SInt64
_ = Int
64
oneIf :: (Ord a, Num a, SymVal a) => SBool -> SBV a
oneIf :: forall a. (Ord a, Num a, SymVal a) => SBool -> SBV a
oneIf SBool
t = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
t SBV a
1 SBV a
0
liftPB :: String -> PBOp -> [SBool] -> SBool
liftPB :: [Char] -> PBOp -> [SBool] -> SBool
liftPB [Char]
w PBOp
o [SBool]
xs
| Just [Char]
e <- PBOp -> Maybe [Char]
check PBOp
o
= [Char] -> SBool
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBool) -> [Char] -> SBool
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
w [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e
| Bool
True
= SBool
result
where check :: PBOp -> Maybe [Char]
check (PB_AtMost Int
k) = Int -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k
check (PB_AtLeast Int
k) = Int -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k
check (PB_Exactly Int
k) = Int -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k
check (PB_Le [Int]
cs Int
k) = Int -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Int] -> Maybe [Char]
match [Int]
cs
check (PB_Ge [Int]
cs Int
k) = Int -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Int] -> Maybe [Char]
match [Int]
cs
check (PB_Eq [Int]
cs Int
k) = Int -> Maybe [Char]
forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Int] -> Maybe [Char]
match [Int]
cs
pos :: a -> Maybe [Char]
pos a
k
| a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"comparison value must be positive, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
k
| Bool
True = Maybe [Char]
forall a. Maybe a
Nothing
match :: [Int] -> Maybe [Char]
match [Int]
cs
| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) [Int]
cs = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"coefficients must be non-negative. Received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Int] -> [Char]
forall a. Show a => a -> [Char]
show [Int]
cs
| Int
lxs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
lcs = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just ([Char] -> Maybe [Char]) -> [Char] -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"coefficient length must match number of arguments. Received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
lcs, Int
lxs)
| Bool
True = Maybe [Char]
forall a. Maybe a
Nothing
where lxs :: Int
lxs = [SBool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBool]
xs
lcs :: Int
lcs = [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
cs
result :: SBool
result = SVal -> SBool
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
r :: State -> IO SV
r State
st = do [SV]
xsv <- (SBool -> IO SV) -> [SBool] -> IO [SV]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (State -> SBool -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st) [SBool]
xs
State -> Kind -> IO ()
registerKind State
st Kind
KUnbounded
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool (Op -> [SV] -> SBVExpr
SBVApp (PBOp -> Op
PseudoBoolean PBOp
o) [SV]
xsv)
pbAtMost :: [SBool] -> Int -> SBool
pbAtMost :: [SBool] -> Int -> SBool
pbAtMost [SBool]
xs Int
k
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> SBool
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBool) -> [Char] -> SBool
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbAtMost: Non-negative value required, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k
| (SBool -> Bool) -> [SBool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete [SBool]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((SBool -> Integer) -> [SBool] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int -> SBool -> Integer
pbToInteger [Char]
"pbAtMost" Int
1) [SBool]
xs) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
| Bool
True = [Char] -> PBOp -> [SBool] -> SBool
liftPB [Char]
"pbAtMost" (Int -> PBOp
PB_AtMost Int
k) [SBool]
xs
pbAtLeast :: [SBool] -> Int -> SBool
pbAtLeast :: [SBool] -> Int -> SBool
pbAtLeast [SBool]
xs Int
k
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> SBool
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBool) -> [Char] -> SBool
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbAtLeast: Non-negative value required, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k
| (SBool -> Bool) -> [SBool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete [SBool]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((SBool -> Integer) -> [SBool] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int -> SBool -> Integer
pbToInteger [Char]
"pbAtLeast" Int
1) [SBool]
xs) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
| Bool
True = [Char] -> PBOp -> [SBool] -> SBool
liftPB [Char]
"pbAtLeast" (Int -> PBOp
PB_AtLeast Int
k) [SBool]
xs
pbExactly :: [SBool] -> Int -> SBool
pbExactly :: [SBool] -> Int -> SBool
pbExactly [SBool]
xs Int
k
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> SBool
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBool) -> [Char] -> SBool
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbExactly: Non-negative value required, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k
| (SBool -> Bool) -> [SBool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete [SBool]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((SBool -> Integer) -> [SBool] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int -> SBool -> Integer
pbToInteger [Char]
"pbExactly" Int
1) [SBool]
xs) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
| Bool
True = [Char] -> PBOp -> [SBool] -> SBool
liftPB [Char]
"pbExactly" (Int -> PBOp
PB_Exactly Int
k) [SBool]
xs
pbLe :: [(Int, SBool)] -> Int -> SBool
pbLe :: [(Int, SBool)] -> Int -> SBool
pbLe [(Int, SBool)]
xs Int
k
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> SBool
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBool) -> [Char] -> SBool
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbLe: Non-negative value required, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k
| ((Int, SBool) -> Bool) -> [(Int, SBool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete (SBool -> Bool) -> ((Int, SBool) -> SBool) -> (Int, SBool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd) [(Int, SBool)]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [[Char] -> Int -> SBool -> Integer
pbToInteger [Char]
"pbLe" Int
c SBool
b | (Int
c, SBool
b) <- [(Int, SBool)]
xs] Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
| Bool
True = [Char] -> PBOp -> [SBool] -> SBool
liftPB [Char]
"pbLe" ([Int] -> Int -> PBOp
PB_Le (((Int, SBool) -> Int) -> [(Int, SBool)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> Int
forall a b. (a, b) -> a
fst [(Int, SBool)]
xs) Int
k) (((Int, SBool) -> SBool) -> [(Int, SBool)] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd [(Int, SBool)]
xs)
pbGe :: [(Int, SBool)] -> Int -> SBool
pbGe :: [(Int, SBool)] -> Int -> SBool
pbGe [(Int, SBool)]
xs Int
k
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> SBool
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBool) -> [Char] -> SBool
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbGe: Non-negative value required, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k
| ((Int, SBool) -> Bool) -> [(Int, SBool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete (SBool -> Bool) -> ((Int, SBool) -> SBool) -> (Int, SBool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd) [(Int, SBool)]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [[Char] -> Int -> SBool -> Integer
pbToInteger [Char]
"pbGe" Int
c SBool
b | (Int
c, SBool
b) <- [(Int, SBool)]
xs] Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
| Bool
True = [Char] -> PBOp -> [SBool] -> SBool
liftPB [Char]
"pbGe" ([Int] -> Int -> PBOp
PB_Ge (((Int, SBool) -> Int) -> [(Int, SBool)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> Int
forall a b. (a, b) -> a
fst [(Int, SBool)]
xs) Int
k) (((Int, SBool) -> SBool) -> [(Int, SBool)] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd [(Int, SBool)]
xs)
pbEq :: [(Int, SBool)] -> Int -> SBool
pbEq :: [(Int, SBool)] -> Int -> SBool
pbEq [(Int, SBool)]
xs Int
k
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> SBool
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBool) -> [Char] -> SBool
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbEq: Non-negative value required, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k
| ((Int, SBool) -> Bool) -> [(Int, SBool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete (SBool -> Bool) -> ((Int, SBool) -> SBool) -> (Int, SBool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd) [(Int, SBool)]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [[Char] -> Int -> SBool -> Integer
pbToInteger [Char]
"pbEq" Int
c SBool
b | (Int
c, SBool
b) <- [(Int, SBool)]
xs] Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
| Bool
True = [Char] -> PBOp -> [SBool] -> SBool
liftPB [Char]
"pbEq" ([Int] -> Int -> PBOp
PB_Eq (((Int, SBool) -> Int) -> [(Int, SBool)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> Int
forall a b. (a, b) -> a
fst [(Int, SBool)]
xs) Int
k) (((Int, SBool) -> SBool) -> [(Int, SBool)] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd [(Int, SBool)]
xs)
pbMutexed :: [SBool] -> SBool
pbMutexed :: [SBool] -> SBool
pbMutexed [SBool]
xs = [SBool] -> Int -> SBool
pbAtMost [SBool]
xs Int
1
pbStronglyMutexed :: [SBool] -> SBool
pbStronglyMutexed :: [SBool] -> SBool
pbStronglyMutexed [SBool]
xs = [SBool] -> Int -> SBool
pbExactly [SBool]
xs Int
1
pbToInteger :: String -> Int -> SBool -> Integer
pbToInteger :: [Char] -> Int -> SBool -> Integer
pbToInteger [Char]
w Int
c SBool
b
| Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error ([Char] -> Integer) -> [Char] -> Integer
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
w [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": Non-negative coefficient required, received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
c
| Just Bool
v <- SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
b = if Bool
v then Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c else Integer
0
| Bool
True = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error ([Char] -> Integer) -> [Char] -> Integer
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbToInteger: Received a symbolic boolean: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, SBool) -> [Char]
forall a. Show a => a -> [Char]
show (Int
c, SBool
b)
isConcreteZero :: SBV a -> Bool
isConcreteZero :: forall {a}. SBV a -> Bool
isConcreteZero (SBV (SVal Kind
_ (Left (CV Kind
_ (CInteger Integer
n))))) = Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
isConcreteZero (SBV (SVal Kind
KReal (Left (CV Kind
KReal (CAlgReal AlgReal
v))))) = AlgReal -> Bool
isExactRational AlgReal
v Bool -> Bool -> Bool
&& AlgReal
v AlgReal -> AlgReal -> Bool
forall a. Eq a => a -> a -> Bool
== AlgReal
0
isConcreteZero SBV a
_ = Bool
False
isConcreteOne :: SBV a -> Bool
isConcreteOne :: forall {a}. SBV a -> Bool
isConcreteOne (SBV (SVal Kind
_ (Left (CV Kind
_ (CInteger Integer
1))))) = Bool
True
isConcreteOne (SBV (SVal Kind
KReal (Left (CV Kind
KReal (CAlgReal AlgReal
v))))) = AlgReal -> Bool
isExactRational AlgReal
v Bool -> Bool -> Bool
&& AlgReal
v AlgReal -> AlgReal -> Bool
forall a. Eq a => a -> a -> Bool
== AlgReal
1
isConcreteOne SBV a
_ = Bool
False
instance (Ord a, Num a, SymVal a) => Num (SBV a) where
fromInteger :: Integer -> SBV a
fromInteger = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> (Integer -> a) -> Integer -> SBV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral
SBV SVal
x + :: SBV a -> SBV a -> SBV a
+ SBV SVal
y = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svPlus SVal
x SVal
y)
SBV SVal
x * :: SBV a -> SBV a -> SBV a
* SBV SVal
y = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svTimes SVal
x SVal
y)
SBV SVal
x - :: SBV a -> SBV a -> SBV a
- SBV SVal
y = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svMinus SVal
x SVal
y)
abs :: SBV a -> SBV a
abs (SBV SVal
x) = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal
svAbs SVal
x)
signum :: SBV a -> SBV a
signum SBV a
a
| SBV a -> Bool
forall a. HasKind a => a -> Bool
hasSign SBV a
a = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
a SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.> SBV a
z) SBV a
i
(SBV a -> SBV a) -> SBV a -> SBV a
forall a b. (a -> b) -> a -> b
$ SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
a SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< SBV a
z) (SBV a -> SBV a
forall a. Num a => a -> a
negate SBV a
i) SBV a
a
| Bool
True = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
a SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.> SBV a
z) SBV a
i SBV a
a
where z :: SBV a
z = Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
a) (Integer
0::Integer)
i :: SBV a
i = Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
a) (Integer
1::Integer)
negate :: SBV a -> SBV a
negate (SBV SVal
x) = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal
svUNeg SVal
x)
(.^) :: (Mergeable b, Num b, SIntegral e) => b -> SBV e -> b
b
b .^ :: forall b e. (Mergeable b, Num b, SIntegral e) => b -> SBV e -> b
.^ SBV e
e
| SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
e, Just (Integer
x :: Integer) <- SInteger -> Maybe Integer
forall a. SymVal a => SBV a -> Maybe a
unliteral (SBV e -> SInteger
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV e
e)
= if Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then let go :: a -> a -> a
go a
n a
v
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = a
1
| a -> Bool
forall a. Integral a => a -> Bool
even a
n = a -> a -> a
go (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) (a
v a -> a -> a
forall a. Num a => a -> a -> a
* a
v)
| Bool
True = a
v a -> a -> a
forall a. Num a => a -> a -> a
* a -> a -> a
go (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2) (a
v a -> a -> a
forall a. Num a => a -> a -> a
* a
v)
in Integer -> b -> b
forall {a} {a}. (Num a, Integral a) => a -> a -> a
go Integer
x b
b
else [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [Char]
"(.^): exponentiation: negative exponent: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
x
| Bool -> Bool
not (SBV e -> Bool
forall a. HasKind a => a -> Bool
isBounded SBV e
e) Bool -> Bool -> Bool
|| SBV e -> Bool
forall a. Bits a => a -> Bool
isSigned SBV e
e
= [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [Char]
"(.^): exponentiation only works with unsigned bounded symbolic exponents, kind: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (SBV e -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV e
e)
| Bool
True
=
let SBV SVal
expt = SBV e
e
expBit :: Int -> SBool
expBit Int
i = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svTestBit SVal
expt Int
i)
blasted :: [SBool]
blasted = (Int -> SBool) -> [Int] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map Int -> SBool
expBit [Int
0 .. SBV e -> Int
forall a. HasKind a => a -> Int
intSizeOf SBV e
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
in [b] -> b
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (SBool -> b -> b) -> [SBool] -> [b] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SBool
use b
n -> SBool -> b -> b -> b
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
use b
n b
1)
[SBool]
blasted
((b -> b) -> b -> [b]
forall a. (a -> a) -> a -> [a]
iterate (\b
x -> b
xb -> b -> b
forall a. Num a => a -> a -> a
*b
x) b
b)
instance (Ord a, SymVal a, Fractional a) => Fractional (SBV a) where
fromRational :: Rational -> SBV a
fromRational = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> (Rational -> a) -> Rational -> SBV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
SBV SVal
x / :: SBV a -> SBV a -> SBV a
/ sy :: SBV a
sy@(SBV SVal
y) | Bool
div0 = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
sy SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
0) SBV a
0 SBV a
res
| Bool
True = SBV a
res
where res :: SBV a
res = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svDivide SVal
x SVal
y)
div0 :: Bool
div0 = case SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
sy of
Kind
KFloat -> Bool
False
Kind
KDouble -> Bool
False
KFP{} -> Bool
False
Kind
KReal -> Bool
True
Kind
KRational -> Bool
True
k :: Kind
k@KBounded{} -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@Kind
KUnbounded -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@Kind
KBool -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@Kind
KString -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@Kind
KChar -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@KList{} -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@KSet{} -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@KUserSort{} -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@KTuple{} -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@KMaybe{} -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
k :: Kind
k@KEither{} -> [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show Kind
k
instance (Ord a, SymVal a, Fractional a, Floating a) => Floating (SBV a) where
pi :: SBV a
pi = Rational -> SBV a
forall a. Fractional a => Rational -> a
fromRational (Rational -> SBV a) -> (Double -> Rational) -> Double -> SBV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> SBV a) -> Double -> SBV a
forall a b. (a -> b) -> a -> b
$ (Double
forall a. Floating a => a
pi :: Double)
exp :: SBV a -> SBV a
exp = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"exp" a -> a
forall a. Floating a => a -> a
exp
log :: SBV a -> SBV a
log = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"log" a -> a
forall a. Floating a => a -> a
log
sqrt :: SBV a -> SBV a
sqrt = FPOp -> (a -> a) -> SBV a -> SBV a
forall a. SymVal a => FPOp -> (a -> a) -> SBV a -> SBV a
lift1F FPOp
FP_Sqrt a -> a
forall a. Floating a => a -> a
sqrt
sin :: SBV a -> SBV a
sin = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"sin" a -> a
forall a. Floating a => a -> a
sin
cos :: SBV a -> SBV a
cos = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"cos" a -> a
forall a. Floating a => a -> a
cos
tan :: SBV a -> SBV a
tan = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"tan" a -> a
forall a. Floating a => a -> a
tan
asin :: SBV a -> SBV a
asin = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"asin" a -> a
forall a. Floating a => a -> a
asin
acos :: SBV a -> SBV a
acos = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"acos" a -> a
forall a. Floating a => a -> a
acos
atan :: SBV a -> SBV a
atan = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"atan" a -> a
forall a. Floating a => a -> a
atan
sinh :: SBV a -> SBV a
sinh = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"sinh" a -> a
forall a. Floating a => a -> a
sinh
cosh :: SBV a -> SBV a
cosh = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"cosh" a -> a
forall a. Floating a => a -> a
cosh
tanh :: SBV a -> SBV a
tanh = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"tanh" a -> a
forall a. Floating a => a -> a
tanh
asinh :: SBV a -> SBV a
asinh = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"asinh" a -> a
forall a. Floating a => a -> a
asinh
acosh :: SBV a -> SBV a
acosh = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"acosh" a -> a
forall a. Floating a => a -> a
acosh
atanh :: SBV a -> SBV a
atanh = [Char] -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"atanh" a -> a
forall a. Floating a => a -> a
atanh
** :: SBV a -> SBV a -> SBV a
(**) = [Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS [Char]
"**" a -> a -> a
forall a. Floating a => a -> a -> a
(**)
logBase :: SBV a -> SBV a -> SBV a
logBase = [Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS [Char]
"logBase" a -> a -> a
forall a. Floating a => a -> a -> a
logBase
unsupported :: String -> a
unsupported :: forall a. [Char] -> a
unsupported [Char]
w = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"Data.SBV.FloatingPoint: Unsupported operation: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
w [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". Please request this as a feature!"
instance {-# OVERLAPPING #-} ValidFloat eb sb => Floating (SFloatingPoint eb sb) where
pi :: SFloatingPoint eb sb
pi
| Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
11 Bool -> Bool -> Bool
|| Int
si Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
53 = [Char] -> SFloatingPoint eb sb
forall a. [Char] -> a
unsupported ([Char] -> SFloatingPoint eb sb) -> [Char] -> SFloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ [Char]
"Floating.SFloatingPoint.pi (not-enough-precision for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
ei, Int
si) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
| Bool
True = FloatingPoint eb sb -> SFloatingPoint eb sb
forall a. SymVal a => a -> SBV a
literal (FloatingPoint eb sb -> SFloatingPoint eb sb)
-> FloatingPoint eb sb -> SFloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ FP -> FloatingPoint eb sb
forall (eb :: Nat) (sb :: Nat). FP -> FloatingPoint eb sb
FloatingPoint (FP -> FloatingPoint eb sb) -> FP -> FloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Rational -> FP
fpFromRational Int
ei Int
si (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double
forall a. Floating a => a
pi :: Double))
where ei :: Int
ei = Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @eb)
si :: Int
si = Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @sb)
exp :: SFloatingPoint eb sb -> SFloatingPoint eb sb
exp SFloatingPoint eb sb
i
| Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
11 Bool -> Bool -> Bool
|| Int
si Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
53 = [Char] -> SFloatingPoint eb sb
forall a. [Char] -> a
unsupported ([Char] -> SFloatingPoint eb sb) -> [Char] -> SFloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ [Char]
"Floating.SFloatingPoint.exp (not-enough-precision for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
ei, Int
si) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
| Bool
True = FloatingPoint eb sb -> SFloatingPoint eb sb
forall a. SymVal a => a -> SBV a
literal FloatingPoint eb sb
e SFloatingPoint eb sb
-> SFloatingPoint eb sb -> SFloatingPoint eb sb
forall a. Floating a => a -> a -> a
** SFloatingPoint eb sb
i
where ei :: Int
ei = Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @eb)
si :: Int
si = Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
forall {t :: Nat}. Proxy t
Proxy @sb)
e :: FloatingPoint eb sb
e = FP -> FloatingPoint eb sb
forall (eb :: Nat) (sb :: Nat). FP -> FloatingPoint eb sb
FloatingPoint (FP -> FloatingPoint eb sb) -> FP -> FloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Rational -> FP
fpFromRational Int
ei Int
si (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
exp Double
1 :: Double))
log :: SFloatingPoint eb sb -> SFloatingPoint eb sb
log = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"log" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
log
sqrt :: SFloatingPoint eb sb -> SFloatingPoint eb sb
sqrt = FPOp
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a. SymVal a => FPOp -> (a -> a) -> SBV a -> SBV a
lift1F FPOp
FP_Sqrt FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
sqrt
sin :: SFloatingPoint eb sb -> SFloatingPoint eb sb
sin = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"sin" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
sin
cos :: SFloatingPoint eb sb -> SFloatingPoint eb sb
cos = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"cos" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
cos
tan :: SFloatingPoint eb sb -> SFloatingPoint eb sb
tan = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"tan" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
tan
asin :: SFloatingPoint eb sb -> SFloatingPoint eb sb
asin = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"asin" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
asin
acos :: SFloatingPoint eb sb -> SFloatingPoint eb sb
acos = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"acos" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
acos
atan :: SFloatingPoint eb sb -> SFloatingPoint eb sb
atan = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"atan" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
atan
sinh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
sinh = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"sinh" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
sinh
cosh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
cosh = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"cosh" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
cosh
tanh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
tanh = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"tanh" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
tanh
asinh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
asinh = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"asinh" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
asinh
acosh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
acosh = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"acosh" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
acosh
atanh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
atanh = [Char]
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"atanh" FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
atanh
** :: SFloatingPoint eb sb
-> SFloatingPoint eb sb -> SFloatingPoint eb sb
(**) = [Char]
-> (FloatingPoint eb sb
-> FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS [Char]
"**" FloatingPoint eb sb -> FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a -> a
(**)
logBase :: SFloatingPoint eb sb
-> SFloatingPoint eb sb -> SFloatingPoint eb sb
logBase = [Char]
-> (FloatingPoint eb sb
-> FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS [Char]
"logBase" FloatingPoint eb sb -> FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a -> a
logBase
lift1F :: SymVal a => FPOp -> (a -> a) -> SBV a -> SBV a
lift1F :: forall a. SymVal a => FPOp -> (a -> a) -> SBV a -> SBV a
lift1F FPOp
w a -> a
op SBV a
a
| Just a
v <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
a
= a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> a -> SBV a
forall a b. (a -> b) -> a -> b
$ a -> a
op a
v
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
a
r :: State -> IO SV
r State
st = do SV
swa <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
a
SV
swm <- State -> SBV RoundingMode -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV RoundingMode
sRNE
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp (FPOp -> Op
IEEEFP FPOp
w) [SV
swm, SV
swa])
lift1FNS :: (SymVal a, Floating a) => String -> (a -> a) -> SBV a -> SBV a
lift1FNS :: forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
nm a -> a
f SBV a
sv
| Just a
v <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
sv = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> a -> SBV a
forall a b. (a -> b) -> a -> b
$ a -> a
f a
v
| Bool
True = [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": not supported for symbolic values of type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
sv)
lift2FNS :: (SymVal a, Floating a) => String -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS :: forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS [Char]
nm a -> a -> a
f SBV a
sv1 SBV a
sv2
| Just a
v1 <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
sv1
, Just a
v2 <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
sv2 = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> a -> SBV a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
f a
v1 a
v2
| Bool
True = [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": not supported for symbolic values of type " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
sv1)
instance {-# OVERLAPPING #-} Floating SReal where
pi :: SReal
pi = Rational -> SReal
forall a. Fractional a => Rational -> a
fromRational (Rational -> SReal) -> (Double -> Rational) -> Double -> SReal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> SReal) -> Double -> SReal
forall a b. (a -> b) -> a -> b
$ (Double
forall a. Floating a => a
pi :: Double)
exp :: SReal -> SReal
exp = NROp -> SReal -> SReal
lift1SReal NROp
NR_Exp
log :: SReal -> SReal
log = NROp -> SReal -> SReal
lift1SReal NROp
NR_Log
sqrt :: SReal -> SReal
sqrt = NROp -> SReal -> SReal
lift1SReal NROp
NR_Sqrt
sin :: SReal -> SReal
sin = NROp -> SReal -> SReal
lift1SReal NROp
NR_Sin
cos :: SReal -> SReal
cos = NROp -> SReal -> SReal
lift1SReal NROp
NR_Cos
tan :: SReal -> SReal
tan = NROp -> SReal -> SReal
lift1SReal NROp
NR_Tan
asin :: SReal -> SReal
asin = NROp -> SReal -> SReal
lift1SReal NROp
NR_ASin
acos :: SReal -> SReal
acos = NROp -> SReal -> SReal
lift1SReal NROp
NR_ACos
atan :: SReal -> SReal
atan = NROp -> SReal -> SReal
lift1SReal NROp
NR_ATan
sinh :: SReal -> SReal
sinh = NROp -> SReal -> SReal
lift1SReal NROp
NR_Sinh
cosh :: SReal -> SReal
cosh = NROp -> SReal -> SReal
lift1SReal NROp
NR_Cosh
tanh :: SReal -> SReal
tanh = NROp -> SReal -> SReal
lift1SReal NROp
NR_Tanh
asinh :: SReal -> SReal
asinh = [Char] -> SReal -> SReal
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.SBV.SReal: asinh is currently not supported. Please request this as a feature!"
acosh :: SReal -> SReal
acosh = [Char] -> SReal -> SReal
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.SBV.SReal: acosh is currently not supported. Please request this as a feature!"
atanh :: SReal -> SReal
atanh = [Char] -> SReal -> SReal
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.SBV.SReal: atanh is currently not supported. Please request this as a feature!"
** :: SReal -> SReal -> SReal
(**) = NROp -> SReal -> SReal -> SReal
lift2SReal NROp
NR_Pow
logBase :: SReal -> SReal -> SReal
logBase SReal
x SReal
y = SReal -> SReal
forall a. Floating a => a -> a
log SReal
y SReal -> SReal -> SReal
forall a. Fractional a => a -> a -> a
/ SReal -> SReal
forall a. Floating a => a -> a
log SReal
x
lift1SReal :: NROp -> SReal -> SReal
lift1SReal :: NROp -> SReal -> SReal
lift1SReal NROp
w SReal
a = SVal -> SReal
forall a. SVal -> SBV a
SBV (SVal -> SReal) -> SVal -> SReal
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = SReal -> Kind
forall a. HasKind a => a -> Kind
kindOf SReal
a
r :: State -> IO SV
r State
st = do SV
swa <- State -> SReal -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SReal
a
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp (NROp -> Op
NonLinear NROp
w) [SV
swa])
lift2SReal :: NROp -> SReal -> SReal -> SReal
lift2SReal :: NROp -> SReal -> SReal -> SReal
lift2SReal NROp
w SReal
a SReal
b = SVal -> SReal
forall a. SVal -> SBV a
SBV (SVal -> SReal) -> SVal -> SReal
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = SReal -> Kind
forall a. HasKind a => a -> Kind
kindOf SReal
a
r :: State -> IO SV
r State
st = do SV
swa <- State -> SReal -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SReal
a
SV
swb <- State -> SReal -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SReal
b
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp (NROp -> Op
NonLinear NROp
w) [SV
swa, SV
swb])
instance (Ord a, Num a, Bits a, SymVal a) => Bits (SBV a) where
SBV SVal
x .&. :: SBV a -> SBV a -> SBV a
.&. SBV SVal
y = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svAnd SVal
x SVal
y)
SBV SVal
x .|. :: SBV a -> SBV a -> SBV a
.|. SBV SVal
y = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svOr SVal
x SVal
y)
SBV SVal
x xor :: SBV a -> SBV a -> SBV a
`xor` SBV SVal
y = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svXOr SVal
x SVal
y)
complement :: SBV a -> SBV a
complement (SBV SVal
x) = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal
svNot SVal
x)
bitSize :: SBV a -> Int
bitSize SBV a
x = SBV a -> Int
forall a. HasKind a => a -> Int
intSizeOf SBV a
x
bitSizeMaybe :: SBV a -> Maybe Int
bitSizeMaybe SBV a
x = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SBV a -> Int
forall a. HasKind a => a -> Int
intSizeOf SBV a
x
isSigned :: SBV a -> Bool
isSigned SBV a
x = SBV a -> Bool
forall a. HasKind a => a -> Bool
hasSign SBV a
x
bit :: Int -> SBV a
bit Int
i = SBV a
1 SBV a -> Int -> SBV a
forall a. Bits a => a -> Int -> a
`shiftL` Int
i
setBit :: SBV a -> Int -> SBV a
setBit SBV a
x Int
i = SBV a
x SBV a -> SBV a -> SBV a
forall a. Bits a => a -> a -> a
.|. Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Int -> Integer
forall a. Bits a => Int -> a
bit Int
i :: Integer)
clearBit :: SBV a -> Int -> SBV a
clearBit SBV a
x Int
i = SBV a
x SBV a -> SBV a -> SBV a
forall a. Bits a => a -> a -> a
.&. Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer -> Integer
forall a. Bits a => a -> a
complement (Int -> Integer
forall a. Bits a => Int -> a
bit Int
i) :: Integer)
complementBit :: SBV a -> Int -> SBV a
complementBit SBV a
x Int
i = SBV a
x SBV a -> SBV a -> SBV a
forall a. Bits a => a -> a -> a
`xor` Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Int -> Integer
forall a. Bits a => Int -> a
bit Int
i :: Integer)
shiftL :: SBV a -> Int -> SBV a
shiftL (SBV SVal
x) Int
i = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svShl SVal
x Int
i)
shiftR :: SBV a -> Int -> SBV a
shiftR (SBV SVal
x) Int
i = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svShr SVal
x Int
i)
rotateL :: SBV a -> Int -> SBV a
rotateL (SBV SVal
x) Int
i = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svRol SVal
x Int
i)
rotateR :: SBV a -> Int -> SBV a
rotateR (SBV SVal
x) Int
i = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svRor SVal
x Int
i)
SBV a
x testBit :: SBV a -> Int -> Bool
`testBit` Int
i
| SBV (SVal Kind
_ (Left (CV Kind
_ (CInteger Integer
n)))) <- SBV a
x
= Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
n Int
i
| Bool
True
= [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error ([Char] -> Bool) -> [Char] -> Bool
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.testBit: Called on symbolic value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SBV a -> [Char]
forall a. Show a => a -> [Char]
show SBV a
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". Use sTestBit instead."
popCount :: SBV a -> Int
popCount SBV a
x
| SBV (SVal Kind
_ (Left (CV (KBounded Bool
_ Int
w) (CInteger Integer
n)))) <- SBV a
x
= Integer -> Int
forall a. Bits a => a -> Int
popCount (Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit Int
w Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
| Bool
True
= [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.popCount: Called on symbolic value: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SBV a -> [Char]
forall a. Show a => a -> [Char]
show SBV a
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". Use sPopCount instead."
sFromIntegral :: forall a b. (Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b, SymVal b) => SBV a -> SBV b
sFromIntegral :: forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV a
x
| Kind
kFrom Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
kTo
= SVal -> SBV b
forall a. SVal -> SBV a
SBV (SBV a -> SVal
forall a. SBV a -> SVal
unSBV SBV a
x)
| SBV a -> Bool
forall a. HasKind a => a -> Bool
isReal SBV a
x
= [Char] -> SBV b
forall a. HasCallStack => [Char] -> a
error [Char]
"SBV.sFromIntegral: Called on a real value"
| Just a
v <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x
= b -> SBV b
forall a. SymVal a => a -> SBV a
literal (a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v)
| Bool
True
= SBV b
result
where result :: SBV b
result = SVal -> SBV b
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
kTo (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
y)))
kFrom :: Kind
kFrom = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
kTo :: Kind
kTo = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
y :: State -> IO SV
y State
st = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
kTo (Op -> [SV] -> SBVExpr
SBVApp (Kind -> Kind -> Op
KindCast Kind
kFrom Kind
kTo) [SV
xsv])
liftViaSVal :: (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal :: forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
f (SBV SVal
a) (SBV SVal
b) = SVal -> SBV c
forall a. SVal -> SBV a
SBV (SVal -> SBV c) -> SVal -> SBV c
forall a b. (a -> b) -> a -> b
$ SVal -> SVal -> SVal
f SVal
a SVal
b
sShiftLeft :: (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sShiftLeft :: forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sShiftLeft = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svShiftLeft
sShiftRight :: (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sShiftRight :: forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sShiftRight = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svShiftRight
sSignedShiftArithRight:: (SFiniteBits a, SIntegral b) => SBV a -> SBV b -> SBV a
sSignedShiftArithRight :: forall a b. (SFiniteBits a, SIntegral b) => SBV a -> SBV b -> SBV a
sSignedShiftArithRight SBV a
x SBV b
i
| SBV b -> Bool
forall a. Bits a => a -> Bool
isSigned SBV b
i = [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error [Char]
"sSignedShiftArithRight: shift amount should be unsigned"
| SBV a -> Bool
forall a. Bits a => a -> Bool
isSigned SBV a
x = SBV a -> SBV b -> SBV a
forall {a} {b} {c}. SBV a -> SBV b -> SBV c
ssa SBV a
x SBV b
i
| Bool
True = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> SBool
forall a. SFiniteBits a => SBV a -> SBool
msb SBV a
x)
(SBV a -> SBV a
forall a. Bits a => a -> a
complement (SBV a -> SBV b -> SBV a
forall {a} {b} {c}. SBV a -> SBV b -> SBV c
ssa (SBV a -> SBV a
forall a. Bits a => a -> a
complement SBV a
x) SBV b
i))
(SBV a -> SBV b -> SBV a
forall {a} {b} {c}. SBV a -> SBV b -> SBV c
ssa SBV a
x SBV b
i)
where ssa :: SBV a -> SBV b -> SBV c
ssa = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svShiftRight
sRotateLeft :: (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sRotateLeft :: forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sRotateLeft = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svRotateLeft
sBarrelRotateLeft :: (SFiniteBits a, SFiniteBits b) => SBV a -> SBV b -> SBV a
sBarrelRotateLeft :: forall a b.
(SFiniteBits a, SFiniteBits b) =>
SBV a -> SBV b -> SBV a
sBarrelRotateLeft = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svBarrelRotateLeft
sRotateRight :: (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sRotateRight :: forall a b. (SIntegral a, SIntegral b) => SBV a -> SBV b -> SBV a
sRotateRight = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svRotateRight
sBarrelRotateRight :: (SFiniteBits a, SFiniteBits b) => SBV a -> SBV b -> SBV a
sBarrelRotateRight :: forall a b.
(SFiniteBits a, SFiniteBits b) =>
SBV a -> SBV b -> SBV a
sBarrelRotateRight = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svBarrelRotateRight
instance (Show a, Bounded a, Integral a, Num a, SymVal a) => Enum (SBV a) where
succ :: SBV a -> SBV a
succ SBV a
x
| a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a
forall a. Bounded a => a
maxBound :: a) = [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ [Char]
"Enum.succ{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SBV a -> [Char]
forall a. HasKind a => a -> [Char]
showType SBV a
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}: tried to take `succ' of maxBound"
| Bool
True = a -> SBV a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> SBV a) -> a -> SBV a
forall a b. (a -> b) -> a -> b
$ a
v a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
where v :: a
v = [Char] -> SBV a -> a
forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"succ" SBV a
x
pred :: SBV a -> SBV a
pred SBV a
x
| a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a
forall a. Bounded a => a
minBound :: a) = [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ [Char]
"Enum.pred{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SBV a -> [Char]
forall a. HasKind a => a -> [Char]
showType SBV a
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}: tried to take `pred' of minBound"
| Bool
True = a -> SBV a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> SBV a) -> a -> SBV a
forall a b. (a -> b) -> a -> b
$ a
v a -> a -> a
forall a. Num a => a -> a -> a
- a
1
where v :: a
v = [Char] -> SBV a -> a
forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"pred" SBV a
x
toEnum :: Int -> SBV a
toEnum Int
x
| Integer
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
minBound :: a) Bool -> Bool -> Bool
|| Integer
xi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a)
= [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ [Char]
"Enum.toEnum{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SBV a -> [Char]
forall a. HasKind a => a -> [Char]
showType SBV a
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is out-of-bounds " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (a, a) -> [Char]
forall a. Show a => a -> [Char]
show (a
forall a. Bounded a => a
minBound :: a, a
forall a. Bounded a => a
maxBound :: a)
| Bool
True
= SBV a
r
where xi :: Integer
xi :: Integer
xi = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
r :: SBV a
r :: SBV a
r = Int -> SBV a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
fromEnum :: SBV a -> Int
fromEnum SBV a
x
| Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
minBound :: Int) Bool -> Bool -> Bool
|| Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
forall a. Bounded a => a
maxBound :: Int)
= [Char] -> Int
forall a. HasCallStack => [Char] -> a
error ([Char] -> Int) -> [Char] -> Int
forall a b. (a -> b) -> a -> b
$ [Char]
"Enum.fromEnum{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SBV a -> [Char]
forall a. HasKind a => a -> [Char]
showType SBV a
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}: value " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
r [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" is outside of Int's bounds " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show (Int
forall a. Bounded a => a
minBound :: Int, Int
forall a. Bounded a => a
maxBound :: Int)
| Bool
True
= Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r
where r :: Integer
r :: Integer
r = [Char] -> SBV a -> Integer
forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"fromEnum" SBV a
x
enumFrom :: SBV a -> [SBV a]
enumFrom SBV a
x = (Integer -> SBV a) -> [Integer] -> [SBV a]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> SBV a
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer
xi .. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a)]
where xi :: Integer
xi :: Integer
xi = [Char] -> SBV a -> Integer
forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFrom" SBV a
x
enumFromThen :: SBV a -> SBV a -> [SBV a]
enumFromThen SBV a
x SBV a
y
| Integer
yi Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
xi = (Integer -> SBV a) -> [Integer] -> [SBV a]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> SBV a
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer
xi, Integer
yi .. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
maxBound :: a)]
| Bool
True = (Integer -> SBV a) -> [Integer] -> [SBV a]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> SBV a
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer
xi, Integer
yi .. a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
forall a. Bounded a => a
minBound :: a)]
where xi, yi :: Integer
xi :: Integer
xi = [Char] -> SBV a -> Integer
forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFromThen.x" SBV a
x
yi :: Integer
yi = [Char] -> SBV a -> Integer
forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFromThen.y" SBV a
y
enumFromThenTo :: SBV a -> SBV a -> SBV a -> [SBV a]
enumFromThenTo SBV a
x SBV a
y SBV a
z = (Integer -> SBV a) -> [Integer] -> [SBV a]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> SBV a
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer
xi, Integer
yi .. Integer
zi]
where xi, yi, zi :: Integer
xi :: Integer
xi = [Char] -> SBV a -> Integer
forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFromThenTo.x" SBV a
x
yi :: Integer
yi = [Char] -> SBV a -> Integer
forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFromThenTo.y" SBV a
y
zi :: Integer
zi = [Char] -> SBV a -> Integer
forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFromThenTo.z" SBV a
z
enumCvt :: (SymVal a, Integral a, Num b) => String -> SBV a -> b
enumCvt :: forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
w SBV a
x = case SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x of
Maybe a
Nothing -> [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [Char]
"Enum." [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
w [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"{" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SBV a -> [Char]
forall a. HasKind a => a -> [Char]
showType SBV a
x [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"}: Called on symbolic value " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SBV a -> [Char]
forall a. Show a => a -> [Char]
show SBV a
x
Just a
v -> a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v
class SDivisible a where
sQuotRem :: a -> a -> (a, a)
sDivMod :: a -> a -> (a, a)
sQuot :: a -> a -> a
sRem :: a -> a -> a
sDiv :: a -> a -> a
sMod :: a -> a -> a
{-# MINIMAL sQuotRem, sDivMod #-}
a
x `sQuot` a
y = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` a
y
a
x `sRem` a
y = (a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` a
y
a
x `sDiv` a
y = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall a. SDivisible a => a -> a -> (a, a)
`sDivMod` a
y
a
x `sMod` a
y = (a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall a. SDivisible a => a -> a -> (a, a)
`sDivMod` a
y
instance SDivisible Word64 where
sQuotRem :: Word64 -> Word64 -> (Word64, Word64)
sQuotRem Word64
x Word64
0 = (Word64
0, Word64
x)
sQuotRem Word64
x Word64
y = Word64
x Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
y
sDivMod :: Word64 -> Word64 -> (Word64, Word64)
sDivMod Word64
x Word64
0 = (Word64
0, Word64
x)
sDivMod Word64
x Word64
y = Word64
x Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word64
y
instance SDivisible Int64 where
sQuotRem :: Int64 -> Int64 -> (Int64, Int64)
sQuotRem Int64
x Int64
0 = (Int64
0, Int64
x)
sQuotRem Int64
x Int64
y = Int64
x Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
y
sDivMod :: Int64 -> Int64 -> (Int64, Int64)
sDivMod Int64
x Int64
0 = (Int64
0, Int64
x)
sDivMod Int64
x Int64
y = Int64
x Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
y
instance SDivisible Word32 where
sQuotRem :: Word32 -> Word32 -> (Word32, Word32)
sQuotRem Word32
x Word32
0 = (Word32
0, Word32
x)
sQuotRem Word32
x Word32
y = Word32
x Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word32
y
sDivMod :: Word32 -> Word32 -> (Word32, Word32)
sDivMod Word32
x Word32
0 = (Word32
0, Word32
x)
sDivMod Word32
x Word32
y = Word32
x Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word32
y
instance SDivisible Int32 where
sQuotRem :: Int32 -> Int32 -> (Int32, Int32)
sQuotRem Int32
x Int32
0 = (Int32
0, Int32
x)
sQuotRem Int32
x Int32
y = Int32
x Int32 -> Int32 -> (Int32, Int32)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int32
y
sDivMod :: Int32 -> Int32 -> (Int32, Int32)
sDivMod Int32
x Int32
0 = (Int32
0, Int32
x)
sDivMod Int32
x Int32
y = Int32
x Int32 -> Int32 -> (Int32, Int32)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int32
y
instance SDivisible Word16 where
sQuotRem :: Word16 -> Word16 -> (Word16, Word16)
sQuotRem Word16
x Word16
0 = (Word16
0, Word16
x)
sQuotRem Word16
x Word16
y = Word16
x Word16 -> Word16 -> (Word16, Word16)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word16
y
sDivMod :: Word16 -> Word16 -> (Word16, Word16)
sDivMod Word16
x Word16
0 = (Word16
0, Word16
x)
sDivMod Word16
x Word16
y = Word16
x Word16 -> Word16 -> (Word16, Word16)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word16
y
instance SDivisible Int16 where
sQuotRem :: Int16 -> Int16 -> (Int16, Int16)
sQuotRem Int16
x Int16
0 = (Int16
0, Int16
x)
sQuotRem Int16
x Int16
y = Int16
x Int16 -> Int16 -> (Int16, Int16)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int16
y
sDivMod :: Int16 -> Int16 -> (Int16, Int16)
sDivMod Int16
x Int16
0 = (Int16
0, Int16
x)
sDivMod Int16
x Int16
y = Int16
x Int16 -> Int16 -> (Int16, Int16)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int16
y
instance SDivisible Word8 where
sQuotRem :: Word8 -> Word8 -> (Word8, Word8)
sQuotRem Word8
x Word8
0 = (Word8
0, Word8
x)
sQuotRem Word8
x Word8
y = Word8
x Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
y
sDivMod :: Word8 -> Word8 -> (Word8, Word8)
sDivMod Word8
x Word8
0 = (Word8
0, Word8
x)
sDivMod Word8
x Word8
y = Word8
x Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word8
y
instance SDivisible Int8 where
sQuotRem :: Int8 -> Int8 -> (Int8, Int8)
sQuotRem Int8
x Int8
0 = (Int8
0, Int8
x)
sQuotRem Int8
x Int8
y = Int8
x Int8 -> Int8 -> (Int8, Int8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int8
y
sDivMod :: Int8 -> Int8 -> (Int8, Int8)
sDivMod Int8
x Int8
0 = (Int8
0, Int8
x)
sDivMod Int8
x Int8
y = Int8
x Int8 -> Int8 -> (Int8, Int8)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int8
y
instance SDivisible Integer where
sQuotRem :: Integer -> Integer -> (Integer, Integer)
sQuotRem Integer
x Integer
0 = (Integer
0, Integer
x)
sQuotRem Integer
x Integer
y = Integer
x Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
y
sDivMod :: Integer -> Integer -> (Integer, Integer)
sDivMod Integer
x Integer
0 = (Integer
0, Integer
x)
sDivMod Integer
x Integer
y = Integer
x Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
y
instance SDivisible CV where
sQuotRem :: CV -> CV -> (CV, CV)
sQuotRem CV
a CV
b
| CInteger Integer
x <- CV -> CVal
cvVal CV
a, CInteger Integer
y <- CV -> CVal
cvVal CV
b
= let (Integer
r1, Integer
r2) = Integer -> Integer -> (Integer, Integer)
forall a. SDivisible a => a -> a -> (a, a)
sQuotRem Integer
x Integer
y in (CV -> CV
normCV CV
a{ cvVal :: CVal
cvVal = Integer -> CVal
CInteger Integer
r1 }, CV -> CV
normCV CV
b{ cvVal :: CVal
cvVal = Integer -> CVal
CInteger Integer
r2 })
sQuotRem CV
a CV
b = [Char] -> (CV, CV)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (CV, CV)) -> [Char] -> (CV, CV)
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.sQuotRem: impossible, unexpected args received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (CV, CV) -> [Char]
forall a. Show a => a -> [Char]
show (CV
a, CV
b)
sDivMod :: CV -> CV -> (CV, CV)
sDivMod CV
a CV
b
| CInteger Integer
x <- CV -> CVal
cvVal CV
a, CInteger Integer
y <- CV -> CVal
cvVal CV
b
= let (Integer
r1, Integer
r2) = Integer -> Integer -> (Integer, Integer)
forall a. SDivisible a => a -> a -> (a, a)
sDivMod Integer
x Integer
y in (CV -> CV
normCV CV
a{ cvVal :: CVal
cvVal = Integer -> CVal
CInteger Integer
r1 }, CV -> CV
normCV CV
b{ cvVal :: CVal
cvVal = Integer -> CVal
CInteger Integer
r2 })
sDivMod CV
a CV
b = [Char] -> (CV, CV)
forall a. HasCallStack => [Char] -> a
error ([Char] -> (CV, CV)) -> [Char] -> (CV, CV)
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.sDivMod: impossible, unexpected args received: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (CV, CV) -> [Char]
forall a. Show a => a -> [Char]
show (CV
a, CV
b)
instance SDivisible SWord64 where
sQuotRem :: SWord64 -> SWord64 -> (SWord64, SWord64)
sQuotRem = SWord64 -> SWord64 -> (SWord64, SWord64)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
sDivMod :: SWord64 -> SWord64 -> (SWord64, SWord64)
sDivMod = SWord64 -> SWord64 -> (SWord64, SWord64)
forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod
instance SDivisible SInt64 where
sQuotRem :: SInt64 -> SInt64 -> (SInt64, SInt64)
sQuotRem = SInt64 -> SInt64 -> (SInt64, SInt64)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
sDivMod :: SInt64 -> SInt64 -> (SInt64, SInt64)
sDivMod = SInt64 -> SInt64 -> (SInt64, SInt64)
forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod
instance SDivisible SWord32 where
sQuotRem :: SWord32 -> SWord32 -> (SWord32, SWord32)
sQuotRem = SWord32 -> SWord32 -> (SWord32, SWord32)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
sDivMod :: SWord32 -> SWord32 -> (SWord32, SWord32)
sDivMod = SWord32 -> SWord32 -> (SWord32, SWord32)
forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod
instance SDivisible SInt32 where
sQuotRem :: SInt32 -> SInt32 -> (SInt32, SInt32)
sQuotRem = SInt32 -> SInt32 -> (SInt32, SInt32)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
sDivMod :: SInt32 -> SInt32 -> (SInt32, SInt32)
sDivMod = SInt32 -> SInt32 -> (SInt32, SInt32)
forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod
instance SDivisible SWord16 where
sQuotRem :: SWord16 -> SWord16 -> (SWord16, SWord16)
sQuotRem = SWord16 -> SWord16 -> (SWord16, SWord16)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
sDivMod :: SWord16 -> SWord16 -> (SWord16, SWord16)
sDivMod = SWord16 -> SWord16 -> (SWord16, SWord16)
forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod
instance SDivisible SInt16 where
sQuotRem :: SInt16 -> SInt16 -> (SInt16, SInt16)
sQuotRem = SInt16 -> SInt16 -> (SInt16, SInt16)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
sDivMod :: SInt16 -> SInt16 -> (SInt16, SInt16)
sDivMod = SInt16 -> SInt16 -> (SInt16, SInt16)
forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod
instance SDivisible SWord8 where
sQuotRem :: SWord8 -> SWord8 -> (SWord8, SWord8)
sQuotRem = SWord8 -> SWord8 -> (SWord8, SWord8)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
sDivMod :: SWord8 -> SWord8 -> (SWord8, SWord8)
sDivMod = SWord8 -> SWord8 -> (SWord8, SWord8)
forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod
instance SDivisible SInt8 where
sQuotRem :: SInt8 -> SInt8 -> (SInt8, SInt8)
sQuotRem = SInt8 -> SInt8 -> (SInt8, SInt8)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
sDivMod :: SInt8 -> SInt8 -> (SInt8, SInt8)
sDivMod = SInt8 -> SInt8 -> (SInt8, SInt8)
forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod
liftQRem :: (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem :: forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem SBV a
x SBV a
y
| SBV a -> Bool
forall {a}. SBV a -> Bool
isConcreteZero SBV a
x
= (SBV a
x, SBV a
x)
| SBV a -> Bool
forall {a}. SBV a -> Bool
isConcreteOne SBV a
y
= (SBV a
x, SBV a
z)
| Bool
True
= SBool -> (SBV a, SBV a) -> (SBV a, SBV a) -> (SBV a, SBV a)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
y SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
z) (SBV a
z, SBV a
x) (SBV a -> SBV a -> (SBV a, SBV a)
forall {a} {a} {a} {a}. SBV a -> SBV a -> (SBV a, SBV a)
qr SBV a
x SBV a
y)
where qr :: SBV a -> SBV a -> (SBV a, SBV a)
qr (SBV (SVal Kind
sgnsz (Left CV
a))) (SBV (SVal Kind
_ (Left CV
b))) = let (CV
q, CV
r) = CV -> CV -> (CV, CV)
forall a. SDivisible a => a -> a -> (a, a)
sQuotRem CV
a CV
b in (SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left CV
q)), SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left CV
r)))
qr a :: SBV a
a@(SBV (SVal Kind
sgnsz Either CV (Cached SV)
_)) SBV a
b = (SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache (Op -> State -> IO SV
mk Op
Quot)))), SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache (Op -> State -> IO SV
mk Op
Rem)))))
where mk :: Op -> State -> IO SV
mk Op
o State
st = do SV
sw1 <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
a
SV
sw2 <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
b
Op -> State -> Kind -> SV -> SV -> IO SV
mkSymOp Op
o State
st Kind
sgnsz SV
sw1 SV
sw2
z :: SBV a
z = Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer
0::Integer)
liftDMod :: (Ord a, SymVal a, Num a, SDivisible (SBV a)) => SBV a -> SBV a -> (SBV a, SBV a)
liftDMod :: forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod SBV a
x SBV a
y
| SBV a -> Bool
forall {a}. SBV a -> Bool
isConcreteZero SBV a
x
= (SBV a
x, SBV a
x)
| SBV a -> Bool
forall {a}. SBV a -> Bool
isConcreteOne SBV a
y
= (SBV a
x, SBV a
z)
| Bool
True
= SBool -> (SBV a, SBV a) -> (SBV a, SBV a) -> (SBV a, SBV a)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
y SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
z) (SBV a
z, SBV a
x) ((SBV a, SBV a) -> (SBV a, SBV a))
-> (SBV a, SBV a) -> (SBV a, SBV a)
forall a b. (a -> b) -> a -> b
$ SBool -> (SBV a, SBV a) -> (SBV a, SBV a) -> (SBV a, SBV a)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> SBV a
forall a. Num a => a -> a
signum SBV a
r SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV a
forall a. Num a => a -> a
negate (SBV a -> SBV a
forall a. Num a => a -> a
signum SBV a
y)) (SBV a
qSBV a -> SBV a -> SBV a
forall a. Num a => a -> a -> a
-SBV a
i, SBV a
rSBV a -> SBV a -> SBV a
forall a. Num a => a -> a -> a
+SBV a
y) (SBV a, SBV a)
qr
where qr :: (SBV a, SBV a)
qr@(SBV a
q, SBV a
r) = SBV a
x SBV a -> SBV a -> (SBV a, SBV a)
forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` SBV a
y
z :: SBV a
z = Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer
0::Integer)
i :: SBV a
i = Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer
1::Integer)
instance SDivisible SInteger where
sDivMod :: SInteger -> SInteger -> (SInteger, SInteger)
sDivMod = SInteger -> SInteger -> (SInteger, SInteger)
forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod
sQuotRem :: SInteger -> SInteger -> (SInteger, SInteger)
sQuotRem SInteger
x SInteger
y
| Bool -> Bool
not (SInteger -> Bool
forall a. SymVal a => SBV a -> Bool
isSymbolic SInteger
x Bool -> Bool -> Bool
|| SInteger -> Bool
forall a. SymVal a => SBV a -> Bool
isSymbolic SInteger
y)
= SInteger -> SInteger -> (SInteger, SInteger)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem SInteger
x SInteger
y
| Bool
True
= SBool
-> (SInteger, SInteger)
-> (SInteger, SInteger)
-> (SInteger, SInteger)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
y SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
0) (SInteger
0, SInteger
x) (SInteger
qESInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
+SInteger
i, SInteger
rESInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
-SInteger
iSInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
*SInteger
y)
where (SInteger
qE, SInteger
rE) = SInteger -> SInteger -> (SInteger, SInteger)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem SInteger
x SInteger
y
i :: SInteger
i = SBool -> SInteger -> SInteger -> SInteger
forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
x SInteger -> SInteger -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SInteger
0 SBool -> SBool -> SBool
.|| SInteger
rE SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
0) SInteger
0
(SInteger -> SInteger) -> SInteger -> SInteger
forall a b. (a -> b) -> a -> b
$ SBool -> SInteger -> SInteger -> SInteger
forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
y SInteger -> SInteger -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.> SInteger
0) SInteger
1 (-SInteger
1)
instance (SymVal a, Arbitrary a) => Arbitrary (SBV a) where
arbitrary :: Gen (SBV a)
arbitrary = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> Gen a -> Gen (SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Gen a
forall a. Arbitrary a => Gen a
arbitrary
class Mergeable a where
symbolicMerge :: Bool -> SBool -> a -> a -> a
select :: (Ord b, SymVal b, Num b) => [a] -> a -> SBV b -> a
select [a]
xs a
err SBV b
ind
| SBV b -> Bool
forall a. HasKind a => a -> Bool
isReal SBV b
ind = [Char] -> a
forall a. [Char] -> a
bad [Char]
"real"
| SBV b -> Bool
forall a. HasKind a => a -> Bool
isFloat SBV b
ind = [Char] -> a
forall a. [Char] -> a
bad [Char]
"float"
| SBV b -> Bool
forall a. HasKind a => a -> Bool
isDouble SBV b
ind = [Char] -> a
forall a. [Char] -> a
bad [Char]
"double"
| SBV b -> Bool
forall a. HasKind a => a -> Bool
hasSign SBV b
ind = SBool -> a -> a -> a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV b
ind SBV b -> SBV b -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< SBV b
0) a
err ([a] -> SBV b -> a -> a
forall {a} {t}.
(Num a, Mergeable t, EqSymbolic a) =>
[t] -> a -> t -> t
walk [a]
xs SBV b
ind a
err)
| Bool
True = [a] -> SBV b -> a -> a
forall {a} {t}.
(Num a, Mergeable t, EqSymbolic a) =>
[t] -> a -> t -> t
walk [a]
xs SBV b
ind a
err
where bad :: [Char] -> a
bad [Char]
w = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.select: unsupported " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
w [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" valued select/index expression"
walk :: [t] -> a -> t -> t
walk [] a
_ t
acc = t
acc
walk (t
e:[t]
es) a
i t
acc = [t] -> a -> t -> t
walk [t]
es (a
ia -> a -> a
forall a. Num a => a -> a -> a
-a
1) (SBool -> t -> t -> t
forall a. Mergeable a => SBool -> a -> a -> a
ite (a
i a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
0) t
e t
acc)
default symbolicMerge :: (G.Generic a, GMergeable (G.Rep a)) => Bool -> SBool -> a -> a -> a
symbolicMerge = Bool -> SBool -> a -> a -> a
forall a.
(Generic a, GMergeable (Rep a)) =>
Bool -> SBool -> a -> a -> a
symbolicMergeDefault
ite :: Mergeable a => SBool -> a -> a -> a
ite :: forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
t a
a a
b
| Just Bool
r <- SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
t = if Bool
r then a
a else a
b
| Bool
True = Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
True SBool
t a
a a
b
iteLazy :: Mergeable a => SBool -> a -> a -> a
iteLazy :: forall a. Mergeable a => SBool -> a -> a -> a
iteLazy SBool
t a
a a
b
| Just Bool
r <- SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
t = if Bool
r then a
a else a
b
| Bool
True = Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
False SBool
t a
a a
b
sAssert :: HasKind a => Maybe CallStack -> String -> SBool -> SBV a -> SBV a
sAssert :: forall a.
HasKind a =>
Maybe CallStack -> [Char] -> SBool -> SBV a -> SBV a
sAssert Maybe CallStack
cs [Char]
msg SBool
cond SBV a
x
| Just Bool
mustHold <- SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
cond
= if Bool
mustHold
then SBV a
x
else [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ SafeResult -> [Char]
forall a. Show a => a -> [Char]
show (SafeResult -> [Char]) -> SafeResult -> [Char]
forall a b. (a -> b) -> a -> b
$ (Maybe [Char], [Char], SMTResult) -> SafeResult
SafeResult (([([Char], SrcLoc)] -> [Char]
locInfo ([([Char], SrcLoc)] -> [Char])
-> (CallStack -> [([Char], SrcLoc)]) -> CallStack -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [([Char], SrcLoc)]
getCallStack) (CallStack -> [Char]) -> Maybe CallStack -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe CallStack
cs, [Char]
msg, SMTConfig -> SMTModel -> SMTResult
Satisfiable SMTConfig
defaultSMTCfg ([([Char], GeneralizedCV)]
-> Maybe [((Quantifier, NamedSymVar), Maybe CV)]
-> [([Char], CV)]
-> [([Char], (SBVType, ([([CV], CV)], CV)))]
-> SMTModel
SMTModel [] Maybe [((Quantifier, NamedSymVar), Maybe CV)]
forall a. Maybe a
Nothing [] []))
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
r :: State -> IO SV
r State
st = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
let pc :: SBool
pc = State -> SBool
getPathCondition State
st
mustNeverHappen :: SBool
mustNeverHappen = SBool
pc SBool -> SBool -> SBool
.&& SBool -> SBool
sNot SBool
cond
SV
cnd <- State -> SBool -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBool
mustNeverHappen
State -> Maybe CallStack -> [Char] -> SV -> IO ()
addAssertion State
st Maybe CallStack
cs [Char]
msg SV
cnd
SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
xsv
locInfo :: [([Char], SrcLoc)] -> [Char]
locInfo [([Char], SrcLoc)]
ps = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
",\n " ((([Char], SrcLoc) -> [Char]) -> [([Char], SrcLoc)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], SrcLoc) -> [Char]
loc [([Char], SrcLoc)]
ps)
where loc :: ([Char], SrcLoc) -> [Char]
loc ([Char]
f, SrcLoc
sl) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [SrcLoc -> [Char]
srcLocFile SrcLoc
sl, [Char]
":", Int -> [Char]
forall a. Show a => a -> [Char]
show (SrcLoc -> Int
srcLocStartLine SrcLoc
sl), [Char]
":", Int -> [Char]
forall a. Show a => a -> [Char]
show (SrcLoc -> Int
srcLocStartCol SrcLoc
sl), [Char]
":", [Char]
f]
symbolicMergeWithKind :: Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMergeWithKind :: forall a. Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMergeWithKind Kind
k Bool
force (SBV SVal
t) (SBV SVal
a) (SBV SVal
b) = SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Bool -> SVal -> SVal -> SVal -> SVal
svSymbolicMerge Kind
k Bool
force SVal
t SVal
a SVal
b)
instance SymVal a => Mergeable (SBV a) where
symbolicMerge :: Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMerge Bool
force SBool
t SBV a
x SBV a
y
| Bool
force = Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
forall a. Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMergeWithKind (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) Bool
True SBool
t SBV a
x SBV a
y
| Bool
True = Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
forall a. Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMergeWithKind (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) Bool
False SBool
t SBV a
x SBV a
y
select :: forall b.
(Ord b, SymVal b, Num b) =>
[SBV a] -> SBV a -> SBV b -> SBV a
select [SBV a]
xs SBV a
err SBV b
ind
| SBV (SVal Kind
_ (Left CV
c)) <- SBV b
ind = case CV -> CVal
cvVal CV
c of
CInteger Integer
i -> if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= [SBV a] -> Integer
forall i a. Num i => [a] -> i
genericLength [SBV a]
xs
then SBV a
err
else [SBV a]
xs [SBV a] -> Integer -> SBV a
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
i
CVal
_ -> [Char] -> SBV a
forall a. HasCallStack => [Char] -> a
error ([Char] -> SBV a) -> [Char] -> SBV a
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.select: unsupported " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (SBV b -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV b
ind) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" valued select/index expression"
select [SBV a]
xsOrig SBV a
err SBV b
ind = [SBV a]
xs [SBV a] -> SBV a -> SBV a
`seq` SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
kElt (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
where kInd :: Kind
kInd = SBV b -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV b
ind
kElt :: Kind
kElt = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
err
xs :: [SBV a]
xs = case SBV b -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV b
ind of
KBounded Bool
False Int
i -> Integer -> [SBV a] -> [SBV a]
forall i a. Integral i => i -> [a] -> [a]
genericTake ((Integer
2::Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Integer)) [SBV a]
xsOrig
KBounded Bool
True Int
i -> Integer -> [SBV a] -> [SBV a]
forall i a. Integral i => i -> [a] -> [a]
genericTake ((Integer
2::Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: Integer)) [SBV a]
xsOrig
Kind
KUnbounded -> [SBV a]
xsOrig
Kind
_ -> [Char] -> [SBV a]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [SBV a]) -> [Char] -> [SBV a]
forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.select: unsupported " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Kind -> [Char]
forall a. Show a => a -> [Char]
show (SBV b -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV b
ind) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" valued select/index expression"
r :: State -> IO SV
r State
st = do [SV]
sws <- (SBV a -> IO SV) -> [SBV a] -> IO [SV]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st) [SBV a]
xs
SV
swe <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
err
if (SV -> Bool) -> [SV] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SV -> SV -> Bool
forall a. Eq a => a -> a -> Bool
== SV
swe) [SV]
sws
then SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
swe
else do Int
idx <- State -> Kind -> Kind -> [SV] -> IO Int
getTableIndex State
st Kind
kInd Kind
kElt [SV]
sws
SV
swi <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
ind
let len :: Int
len = [SBV a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBV a]
xs
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
kElt (Op -> [SV] -> SBVExpr
SBVApp ((Int, Kind, Kind, Int) -> SV -> SV -> Op
LkUp (Int
idx, Kind
kInd, Kind
kElt, Int
len) SV
swi SV
swe) [])
instance Mergeable () where
symbolicMerge :: Bool -> SBool -> () -> () -> ()
symbolicMerge Bool
_ SBool
_ ()
_ ()
_ = ()
select :: forall b. (Ord b, SymVal b, Num b) => [()] -> () -> SBV b -> ()
select [()]
_ ()
_ SBV b
_ = ()
cannotMerge :: String -> String -> String -> a
cannotMerge :: forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
typ [Char]
why [Char]
hint = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [ [Char]
""
, [Char]
"*** Data.SBV.Mergeable: Cannot merge instances of " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
typ [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"."
, [Char]
"*** While trying to do a symbolic if-then-else with incompatible branch results."
, [Char]
"***"
, [Char]
"*** " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
why
, [Char]
"*** "
, [Char]
"*** Hint: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
hint
]
instance Mergeable a => Mergeable [a] where
symbolicMerge :: Bool -> SBool -> [a] -> [a] -> [a]
symbolicMerge Bool
f SBool
t [a]
xs [a]
ys
| Int
lxs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lys = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t) [a]
xs [a]
ys
| Bool
True = [Char] -> [Char] -> [Char] -> [a]
forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
"lists"
([Char]
"Branches produce different sizes: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lxs [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" vs " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
lys [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". Must have the same length.")
[Char]
"Use the 'SList' type (and Data.SBV.List routines) to model fully symbolic lists."
where (Int
lxs, Int
lys) = ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys)
instance Mergeable a => Mergeable (ZipList a) where
symbolicMerge :: Bool -> SBool -> ZipList a -> ZipList a -> ZipList a
symbolicMerge Bool
force SBool
test (ZipList [a]
xs) (ZipList [a]
ys)
= [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList (Bool -> SBool -> [a] -> [a] -> [a]
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
force SBool
test [a]
xs [a]
ys)
instance Mergeable a => Mergeable (Maybe a) where
symbolicMerge :: Bool -> SBool -> Maybe a -> Maybe a -> Maybe a
symbolicMerge Bool
_ SBool
_ Maybe a
Nothing Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
symbolicMerge Bool
f SBool
t (Just a
a) (Just a
b) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
a a
b
symbolicMerge Bool
_ SBool
_ Maybe a
a Maybe a
b = [Char] -> [Char] -> [Char] -> Maybe a
forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
"'Maybe' values"
([Char]
"Branches produce different constructors: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char], [Char]) -> [Char]
forall a. Show a => a -> [Char]
show (Maybe a -> [Char]
forall {a}. Maybe a -> [Char]
k Maybe a
a, Maybe a -> [Char]
forall {a}. Maybe a -> [Char]
k Maybe a
b))
[Char]
"Instead of an option type, try using a valid bit to indicate when a result is valid."
where k :: Maybe a -> [Char]
k Maybe a
Nothing = [Char]
"Nothing"
k Maybe a
_ = [Char]
"Just"
instance (Mergeable a, Mergeable b) => Mergeable (Either a b) where
symbolicMerge :: Bool -> SBool -> Either a b -> Either a b -> Either a b
symbolicMerge Bool
f SBool
t (Left a
a) (Left a
b) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
a a
b
symbolicMerge Bool
f SBool
t (Right b
a) (Right b
b) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> b -> Either a b
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
a b
b
symbolicMerge Bool
_ SBool
_ Either a b
a Either a b
b = [Char] -> [Char] -> [Char] -> Either a b
forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
"'Either' values"
([Char]
"Branches produce different constructors: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char], [Char]) -> [Char]
forall a. Show a => a -> [Char]
show (Either a b -> [Char]
forall {a} {b}. Either a b -> [Char]
k Either a b
a, Either a b -> [Char]
forall {a} {b}. Either a b -> [Char]
k Either a b
b))
[Char]
"Consider using a product type by a tag instead."
where k :: Either a b -> [Char]
k (Left a
_) = [Char]
"Left"
k (Right b
_) = [Char]
"Right"
instance (Ix a, Mergeable b) => Mergeable (Array a b) where
symbolicMerge :: Bool -> SBool -> Array a b -> Array a b -> Array a b
symbolicMerge Bool
f SBool
t Array a b
a Array a b
b
| (a, a)
ba (a, a) -> (a, a) -> Bool
forall a. Eq a => a -> a -> Bool
== (a, a)
bb = (a, a) -> [b] -> Array a b
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (a, a)
ba ((b -> b -> b) -> [b] -> [b] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t) (Array a b -> [b]
forall i e. Array i e -> [e]
elems Array a b
a) (Array a b -> [b]
forall i e. Array i e -> [e]
elems Array a b
b))
| Bool
True = [Char] -> [Char] -> [Char] -> Array a b
forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
"'Array' values"
([Char]
"Branches produce different ranges: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> [Char]
forall a. Show a => a -> [Char]
show ((a, a) -> Int
k (a, a)
ba, (a, a) -> Int
k (a, a)
bb))
[Char]
"Consider using SBV's native 'SArray' abstraction."
where [(a, a)
ba, (a, a)
bb] = (Array a b -> (a, a)) -> [Array a b] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map Array a b -> (a, a)
forall i e. Array i e -> (i, i)
bounds [Array a b
a, Array a b
b]
k :: (a, a) -> Int
k = (a, a) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize
instance Mergeable b => Mergeable (a -> b) where
symbolicMerge :: Bool -> SBool -> (a -> b) -> (a -> b) -> a -> b
symbolicMerge Bool
f SBool
t a -> b
g a -> b
h a
x = Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t (a -> b
g a
x) (a -> b
h a
x)
instance (Mergeable a, Mergeable b) => Mergeable (a, b) where
symbolicMerge :: Bool -> SBool -> (a, b) -> (a, b) -> (a, b)
symbolicMerge Bool
f SBool
t (a
i0, b
i1) (a
j0, b
j1) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
, Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
)
select :: forall b.
(Ord b, SymVal b, Num b) =>
[(a, b)] -> (a, b) -> SBV b -> (a, b)
select [(a, b)]
xs (a
err1, b
err2) SBV b
ind = ( [a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
, [b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
)
where ([a]
as, [b]
bs) = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
xs
instance (Mergeable a, Mergeable b, Mergeable c) => Mergeable (a, b, c) where
symbolicMerge :: Bool -> SBool -> (a, b, c) -> (a, b, c) -> (a, b, c)
symbolicMerge Bool
f SBool
t (a
i0, b
i1, c
i2) (a
j0, b
j1, c
j2) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
, Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
, Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
)
select :: forall b.
(Ord b, SymVal b, Num b) =>
[(a, b, c)] -> (a, b, c) -> SBV b -> (a, b, c)
select [(a, b, c)]
xs (a
err1, b
err2, c
err3) SBV b
ind = ( [a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
, [b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
, [c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
)
where ([a]
as, [b]
bs, [c]
cs) = [(a, b, c)] -> ([a], [b], [c])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(a, b, c)]
xs
instance (Mergeable a, Mergeable b, Mergeable c, Mergeable d) => Mergeable (a, b, c, d) where
symbolicMerge :: Bool -> SBool -> (a, b, c, d) -> (a, b, c, d) -> (a, b, c, d)
symbolicMerge Bool
f SBool
t (a
i0, b
i1, c
i2, d
i3) (a
j0, b
j1, c
j2, d
j3) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
, Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
, Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
, Bool -> SBool -> d -> d -> d
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
)
select :: forall b.
(Ord b, SymVal b, Num b) =>
[(a, b, c, d)] -> (a, b, c, d) -> SBV b -> (a, b, c, d)
select [(a, b, c, d)]
xs (a
err1, b
err2, c
err3, d
err4) SBV b
ind = ( [a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
, [b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
, [c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
, [d] -> d -> SBV b -> d
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
)
where ([a]
as, [b]
bs, [c]
cs, [d]
ds) = [(a, b, c, d)] -> ([a], [b], [c], [d])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [(a, b, c, d)]
xs
instance (Mergeable a, Mergeable b, Mergeable c, Mergeable d, Mergeable e) => Mergeable (a, b, c, d, e) where
symbolicMerge :: Bool
-> SBool -> (a, b, c, d, e) -> (a, b, c, d, e) -> (a, b, c, d, e)
symbolicMerge Bool
f SBool
t (a
i0, b
i1, c
i2, d
i3, e
i4) (a
j0, b
j1, c
j2, d
j3, e
j4) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
, Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
, Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
, Bool -> SBool -> d -> d -> d
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
, Bool -> SBool -> e -> e -> e
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t e
i4 e
j4
)
select :: forall b.
(Ord b, SymVal b, Num b) =>
[(a, b, c, d, e)] -> (a, b, c, d, e) -> SBV b -> (a, b, c, d, e)
select [(a, b, c, d, e)]
xs (a
err1, b
err2, c
err3, d
err4, e
err5) SBV b
ind = ( [a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
, [b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
, [c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
, [d] -> d -> SBV b -> d
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
, [e] -> e -> SBV b -> e
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [e]
es e
err5 SBV b
ind
)
where ([a]
as, [b]
bs, [c]
cs, [d]
ds, [e]
es) = [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
forall a b c d e. [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
unzip5 [(a, b, c, d, e)]
xs
instance (Mergeable a, Mergeable b, Mergeable c, Mergeable d, Mergeable e, Mergeable f) => Mergeable (a, b, c, d, e, f) where
symbolicMerge :: Bool
-> SBool
-> (a, b, c, d, e, f)
-> (a, b, c, d, e, f)
-> (a, b, c, d, e, f)
symbolicMerge Bool
f SBool
t (a
i0, b
i1, c
i2, d
i3, e
i4, f
i5) (a
j0, b
j1, c
j2, d
j3, e
j4, f
j5) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
, Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
, Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
, Bool -> SBool -> d -> d -> d
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
, Bool -> SBool -> e -> e -> e
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t e
i4 e
j4
, Bool -> SBool -> f -> f -> f
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t f
i5 f
j5
)
select :: forall b.
(Ord b, SymVal b, Num b) =>
[(a, b, c, d, e, f)]
-> (a, b, c, d, e, f) -> SBV b -> (a, b, c, d, e, f)
select [(a, b, c, d, e, f)]
xs (a
err1, b
err2, c
err3, d
err4, e
err5, f
err6) SBV b
ind = ( [a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
, [b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
, [c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
, [d] -> d -> SBV b -> d
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
, [e] -> e -> SBV b -> e
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [e]
es e
err5 SBV b
ind
, [f] -> f -> SBV b -> f
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [f]
fs f
err6 SBV b
ind
)
where ([a]
as, [b]
bs, [c]
cs, [d]
ds, [e]
es, [f]
fs) = [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])
forall a b c d e f.
[(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])
unzip6 [(a, b, c, d, e, f)]
xs
instance (Mergeable a, Mergeable b, Mergeable c, Mergeable d, Mergeable e, Mergeable f, Mergeable g) => Mergeable (a, b, c, d, e, f, g) where
symbolicMerge :: Bool
-> SBool
-> (a, b, c, d, e, f, g)
-> (a, b, c, d, e, f, g)
-> (a, b, c, d, e, f, g)
symbolicMerge Bool
f SBool
t (a
i0, b
i1, c
i2, d
i3, e
i4, f
i5, g
i6) (a
j0, b
j1, c
j2, d
j3, e
j4, f
j5, g
j6) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
, Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
, Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
, Bool -> SBool -> d -> d -> d
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
, Bool -> SBool -> e -> e -> e
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t e
i4 e
j4
, Bool -> SBool -> f -> f -> f
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t f
i5 f
j5
, Bool -> SBool -> g -> g -> g
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t g
i6 g
j6
)
select :: forall b.
(Ord b, SymVal b, Num b) =>
[(a, b, c, d, e, f, g)]
-> (a, b, c, d, e, f, g) -> SBV b -> (a, b, c, d, e, f, g)
select [(a, b, c, d, e, f, g)]
xs (a
err1, b
err2, c
err3, d
err4, e
err5, f
err6, g
err7) SBV b
ind = ( [a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
, [b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
, [c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
, [d] -> d -> SBV b -> d
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
, [e] -> e -> SBV b -> e
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [e]
es e
err5 SBV b
ind
, [f] -> f -> SBV b -> f
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [f]
fs f
err6 SBV b
ind
, [g] -> g -> SBV b -> g
forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [g]
gs g
err7 SBV b
ind
)
where ([a]
as, [b]
bs, [c]
cs, [d]
ds, [e]
es, [f]
fs, [g]
gs) = [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])
forall a b c d e f g.
[(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])
unzip7 [(a, b, c, d, e, f, g)]
xs
symbolicMergeDefault :: (G.Generic a, GMergeable (G.Rep a)) => Bool -> SBool -> a -> a -> a
symbolicMergeDefault :: forall a.
(Generic a, GMergeable (Rep a)) =>
Bool -> SBool -> a -> a -> a
symbolicMergeDefault Bool
force SBool
t a
x a
y = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
G.to (Rep a Any -> a) -> Rep a Any -> a
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> Rep a Any -> Rep a Any -> Rep a Any
forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
G.from a
x) (a -> Rep a Any
forall a x. Generic a => a -> Rep a x
G.from a
y)
class GMergeable f where
symbolicMerge' :: Bool -> SBool -> f a -> f a -> f a
instance GMergeable U1 where
symbolicMerge' :: forall a. Bool -> SBool -> U1 a -> U1 a -> U1 a
symbolicMerge' Bool
_ SBool
_ U1 a
_ U1 a
_ = U1 a
forall k (p :: k). U1 p
U1
instance (Mergeable c) => GMergeable (K1 i c) where
symbolicMerge' :: forall a. Bool -> SBool -> K1 i c a -> K1 i c a -> K1 i c a
symbolicMerge' Bool
force SBool
t (K1 c
x) (K1 c
y) = c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 (c -> K1 i c a) -> c -> K1 i c a
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
force SBool
t c
x c
y
instance (GMergeable f) => GMergeable (M1 i c f) where
symbolicMerge' :: forall a. Bool -> SBool -> M1 i c f a -> M1 i c f a -> M1 i c f a
symbolicMerge' Bool
force SBool
t (M1 f a
x) (M1 f a
y) = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i c f a) -> f a -> M1 i c f a
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> f a -> f a -> f a
forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t f a
x f a
y
instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where
symbolicMerge' :: forall a.
Bool -> SBool -> (:*:) f g a -> (:*:) f g a -> (:*:) f g a
symbolicMerge' Bool
force SBool
t (f a
x1 :*: g a
y1) (f a
x2 :*: g a
y2) = Bool -> SBool -> f a -> f a -> f a
forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t f a
x1 f a
x2 f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Bool -> SBool -> g a -> g a -> g a
forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t g a
y1 g a
y2
instance (SymVal a, Bounded a) => Bounded (SBV a) where
minBound :: SBV a
minBound = a -> SBV a
forall a. SymVal a => a -> SBV a
literal a
forall a. Bounded a => a
minBound
maxBound :: SBV a
maxBound = a -> SBV a
forall a. SymVal a => a -> SBV a
literal a
forall a. Bounded a => a
maxBound
instance EqSymbolic (SArray a b) where
SArray SArr
a .== :: SArray a b -> SArray a b -> SBool
.== SArray SArr
b = SVal -> SBool
forall a. SVal -> SBV a
SBV (SArr
a SArr -> SArr -> SVal
`eqSArr` SArr
b)
instance SymVal b => Mergeable (SArray a b) where
symbolicMerge :: Bool -> SBool -> SArray a b -> SArray a b -> SArray a b
symbolicMerge Bool
_ = SBool -> SArray a b -> SArray a b -> SArray a b
forall (array :: * -> * -> *) b a.
(SymArray array, SymVal b) =>
SBool -> array a b -> array a b -> array a b
mergeArrays
class Uninterpreted a where
uninterpret :: String -> a
cgUninterpret :: String -> [String] -> a -> a
sbvUninterpret :: Maybe ([String], a) -> String -> a
sym :: String -> a
{-# MINIMAL sbvUninterpret #-}
uninterpret = Maybe ([[Char]], a) -> [Char] -> a
forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret Maybe ([[Char]], a)
forall a. Maybe a
Nothing
cgUninterpret [Char]
nm [[Char]]
code a
v = Maybe ([[Char]], a) -> [Char] -> a
forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (([[Char]], a) -> Maybe ([[Char]], a)
forall a. a -> Maybe a
Just ([[Char]]
code, a
v)) [Char]
nm
sym = [Char] -> a
forall a. Uninterpreted a => [Char] -> a
uninterpret
instance HasKind a => Uninterpreted (SBV a) where
sbvUninterpret :: Maybe ([[Char]], SBV a) -> [Char] -> SBV a
sbvUninterpret Maybe ([[Char]], SBV a)
mbCgData [Char]
nm
| Just ([[Char]]
_, SBV a
v) <- Maybe ([[Char]], SBV a)
mbCgData = SBV a
v
| Bool
True = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
case (Bool
isSMT, Maybe ([[Char]], SBV a)
mbCgData) of
(Bool
True, Just ([[Char]]
_, SBV a
v)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
v
(Bool, Maybe ([[Char]], SBV a))
_ -> do State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm ([Kind] -> SBVType
SBVType [Kind
ka]) (([[Char]], SBV a) -> [[Char]]
forall a b. (a, b) -> a
fst (([[Char]], SBV a) -> [[Char]])
-> Maybe ([[Char]], SBV a) -> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], SBV a)
mbCgData)
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) []
instance (SymVal b, HasKind a) => Uninterpreted (SBV b -> SBV a) where
sbvUninterpret :: Maybe ([[Char]], SBV b -> SBV a) -> [Char] -> SBV b -> SBV a
sbvUninterpret Maybe ([[Char]], SBV b -> SBV a)
mbCgData [Char]
nm = SBV b -> SBV a
f
where f :: SBV b -> SBV a
f SBV b
arg0
| Just ([[Char]]
_, SBV b -> SBV a
v) <- Maybe ([[Char]], SBV b -> SBV a)
mbCgData, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg0
= SBV b -> SBV a
v SBV b
arg0
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
case (Bool
isSMT, Maybe ([[Char]], SBV b -> SBV a)
mbCgData) of
(Bool
True, Just ([[Char]]
_, SBV b -> SBV a
v)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV b -> SBV a
v SBV b
arg0)
(Bool, Maybe ([[Char]], SBV b -> SBV a))
_ -> do State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm ([Kind] -> SBVType
SBVType [Kind
kb, Kind
ka]) (([[Char]], SBV b -> SBV a) -> [[Char]]
forall a b. (a, b) -> a
fst (([[Char]], SBV b -> SBV a) -> [[Char]])
-> Maybe ([[Char]], SBV b -> SBV a) -> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], SBV b -> SBV a)
mbCgData)
SV
sw0 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg0
(SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0]
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0]
instance (SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV c -> SBV b -> SBV a) where
sbvUninterpret :: Maybe ([[Char]], SBV c -> SBV b -> SBV a)
-> [Char] -> SBV c -> SBV b -> SBV a
sbvUninterpret Maybe ([[Char]], SBV c -> SBV b -> SBV a)
mbCgData [Char]
nm = SBV c -> SBV b -> SBV a
f
where f :: SBV c -> SBV b -> SBV a
f SBV c
arg0 SBV b
arg1
| Just ([[Char]]
_, SBV c -> SBV b -> SBV a
v) <- Maybe ([[Char]], SBV c -> SBV b -> SBV a)
mbCgData, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg0, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg1
= SBV c -> SBV b -> SBV a
v SBV c
arg0 SBV b
arg1
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
case (Bool
isSMT, Maybe ([[Char]], SBV c -> SBV b -> SBV a)
mbCgData) of
(Bool
True, Just ([[Char]]
_, SBV c -> SBV b -> SBV a
v)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV c -> SBV b -> SBV a
v SBV c
arg0 SBV b
arg1)
(Bool, Maybe ([[Char]], SBV c -> SBV b -> SBV a))
_ -> do State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm ([Kind] -> SBVType
SBVType [Kind
kc, Kind
kb, Kind
ka]) (([[Char]], SBV c -> SBV b -> SBV a) -> [[Char]]
forall a b. (a, b) -> a
fst (([[Char]], SBV c -> SBV b -> SBV a) -> [[Char]])
-> Maybe ([[Char]], SBV c -> SBV b -> SBV a) -> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], SBV c -> SBV b -> SBV a)
mbCgData)
SV
sw0 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg0
SV
sw1 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg1
(SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1]
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0, SV
sw1]
instance (SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV d -> SBV c -> SBV b -> SBV a) where
sbvUninterpret :: Maybe ([[Char]], SBV d -> SBV c -> SBV b -> SBV a)
-> [Char] -> SBV d -> SBV c -> SBV b -> SBV a
sbvUninterpret Maybe ([[Char]], SBV d -> SBV c -> SBV b -> SBV a)
mbCgData [Char]
nm = SBV d -> SBV c -> SBV b -> SBV a
f
where f :: SBV d -> SBV c -> SBV b -> SBV a
f SBV d
arg0 SBV c
arg1 SBV b
arg2
| Just ([[Char]]
_, SBV d -> SBV c -> SBV b -> SBV a
v) <- Maybe ([[Char]], SBV d -> SBV c -> SBV b -> SBV a)
mbCgData, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg0, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg1, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg2
= SBV d -> SBV c -> SBV b -> SBV a
v SBV d
arg0 SBV c
arg1 SBV b
arg2
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
case (Bool
isSMT, Maybe ([[Char]], SBV d -> SBV c -> SBV b -> SBV a)
mbCgData) of
(Bool
True, Just ([[Char]]
_, SBV d -> SBV c -> SBV b -> SBV a
v)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV d -> SBV c -> SBV b -> SBV a
v SBV d
arg0 SBV c
arg1 SBV b
arg2)
(Bool, Maybe ([[Char]], SBV d -> SBV c -> SBV b -> SBV a))
_ -> do State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm ([Kind] -> SBVType
SBVType [Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (([[Char]], SBV d -> SBV c -> SBV b -> SBV a) -> [[Char]]
forall a b. (a, b) -> a
fst (([[Char]], SBV d -> SBV c -> SBV b -> SBV a) -> [[Char]])
-> Maybe ([[Char]], SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], SBV d -> SBV c -> SBV b -> SBV a)
mbCgData)
SV
sw0 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg0
SV
sw1 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg1
SV
sw2 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg2
(SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2]
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0, SV
sw1, SV
sw2]
instance (SymVal e, SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
sbvUninterpret :: Maybe ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [Char] -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
sbvUninterpret Maybe ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData [Char]
nm = SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f
where f :: SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f SBV e
arg0 SBV d
arg1 SBV c
arg2 SBV b
arg3
| Just ([[Char]]
_, SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v) <- Maybe ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg0, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg1, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg2, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg3
= SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV e
arg0 SBV d
arg1 SBV c
arg2 SBV b
arg3
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
case (Bool
isSMT, Maybe ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData) of
(Bool
True, Just ([[Char]]
_, SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV e
arg0 SBV d
arg1 SBV c
arg2 SBV b
arg3)
(Bool, Maybe ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
_ -> do State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm ([Kind] -> SBVType
SBVType [Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a) -> [[Char]]
forall a b. (a, b) -> a
fst (([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a) -> [[Char]])
-> Maybe ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData)
SV
sw0 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg0
SV
sw1 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg1
SV
sw2 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg2
SV
sw3 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg3
(SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3]
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0, SV
sw1, SV
sw2, SV
sw3]
instance (SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
sbvUninterpret :: Maybe
([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [Char] -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
sbvUninterpret Maybe
([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData [Char]
nm = SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f
where f :: SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f SBV f
arg0 SBV e
arg1 SBV d
arg2 SBV c
arg3 SBV b
arg4
| Just ([[Char]]
_, SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v) <- Maybe
([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg0, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg1, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg2, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg3, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg4
= SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV f
arg0 SBV e
arg1 SBV d
arg2 SBV c
arg3 SBV b
arg4
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
case (Bool
isSMT, Maybe
([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData) of
(Bool
True, Just ([[Char]]
_, SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV f
arg0 SBV e
arg1 SBV d
arg2 SBV c
arg3 SBV b
arg4)
(Bool,
Maybe
([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
_ -> do State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm ([Kind] -> SBVType
SBVType [Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [[Char]]
forall a b. (a, b) -> a
fst (([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [[Char]])
-> Maybe
([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe
([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData)
SV
sw0 <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg0
SV
sw1 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg1
SV
sw2 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg2
SV
sw3 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg3
SV
sw4 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg4
(SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4]
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4]
instance (SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
sbvUninterpret :: Maybe
([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [Char]
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvUninterpret Maybe
([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData [Char]
nm = SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f
where f :: SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f SBV g
arg0 SBV f
arg1 SBV e
arg2 SBV d
arg3 SBV c
arg4 SBV b
arg5
| Just ([[Char]]
_, SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v) <- Maybe
([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData, SBV g -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg0, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg1, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg2, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg3, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg4, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg5
= SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV g
arg0 SBV f
arg1 SBV e
arg2 SBV d
arg3 SBV c
arg4 SBV b
arg5
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
kg :: Kind
kg = Proxy g -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g)
result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
case (Bool
isSMT, Maybe
([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData) of
(Bool
True, Just ([[Char]]
_, SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV g
arg0 SBV f
arg1 SBV e
arg2 SBV d
arg3 SBV c
arg4 SBV b
arg5)
(Bool,
Maybe
([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
_ -> do State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm ([Kind] -> SBVType
SBVType [Kind
kg, Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [[Char]]
forall a b. (a, b) -> a
fst (([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [[Char]])
-> Maybe
([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe
([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData)
SV
sw0 <- State -> SBV g -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg0
SV
sw1 <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg1
SV
sw2 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg2
SV
sw3 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg3
SV
sw4 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg4
SV
sw5 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg5
(SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5]
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5]
instance (SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)
=> Uninterpreted (SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
sbvUninterpret :: Maybe
([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [Char]
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvUninterpret Maybe
([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData [Char]
nm = SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f
where f :: SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f SBV h
arg0 SBV g
arg1 SBV f
arg2 SBV e
arg3 SBV d
arg4 SBV c
arg5 SBV b
arg6
| Just ([[Char]]
_, SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v) <- Maybe
([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData, SBV h -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV h
arg0, SBV g -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg1, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg2, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg3, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg4, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg5, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg6
= SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV h
arg0 SBV g
arg1 SBV f
arg2 SBV e
arg3 SBV d
arg4 SBV c
arg5 SBV b
arg6
| Bool
True
= SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
kg :: Kind
kg = Proxy g -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g)
kh :: Kind
kh = Proxy h -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h)
result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
case (Bool
isSMT, Maybe
([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData) of
(Bool
True, Just ([[Char]]
_, SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV h
arg0 SBV g
arg1 SBV f
arg2 SBV e
arg3 SBV d
arg4 SBV c
arg5 SBV b
arg6)
(Bool,
Maybe
([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
_ -> do State -> [Char] -> SBVType -> Maybe [[Char]] -> IO ()
newUninterpreted State
st [Char]
nm ([Kind] -> SBVType
SBVType [Kind
kh, Kind
kg, Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [[Char]]
forall a b. (a, b) -> a
fst (([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [[Char]])
-> Maybe
([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe
([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
mbCgData)
SV
sw0 <- State -> SBV h -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV h
arg0
SV
sw1 <- State -> SBV g -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg1
SV
sw2 <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg2
SV
sw3 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg3
SV
sw4 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg4
SV
sw5 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg5
SV
sw6 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg6
(SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6]
State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6]
instance (SymVal c, SymVal b, HasKind a) => Uninterpreted ((SBV c, SBV b) -> SBV a) where
sbvUninterpret :: Maybe ([[Char]], (SBV c, SBV b) -> SBV a)
-> [Char] -> (SBV c, SBV b) -> SBV a
sbvUninterpret Maybe ([[Char]], (SBV c, SBV b) -> SBV a)
mbCgData [Char]
nm = let f :: SBV c -> SBV b -> SBV a
f = Maybe ([[Char]], SBV c -> SBV b -> SBV a)
-> [Char] -> SBV c -> SBV b -> SBV a
forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (([[Char]], (SBV c, SBV b) -> SBV a)
-> ([[Char]], SBV c -> SBV b -> SBV a)
forall {a} {a} {b} {c}. (a, (a, b) -> c) -> (a, a -> b -> c)
uc2 (([[Char]], (SBV c, SBV b) -> SBV a)
-> ([[Char]], SBV c -> SBV b -> SBV a))
-> Maybe ([[Char]], (SBV c, SBV b) -> SBV a)
-> Maybe ([[Char]], SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], (SBV c, SBV b) -> SBV a)
mbCgData) [Char]
nm in (SBV c -> SBV b -> SBV a) -> (SBV c, SBV b) -> SBV a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SBV c -> SBV b -> SBV a
f
where uc2 :: (a, (a, b) -> c) -> (a, a -> b -> c)
uc2 (a
cs, (a, b) -> c
fn) = (a
cs, ((a, b) -> c) -> a -> b -> c
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> c
fn)
instance (SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted ((SBV d, SBV c, SBV b) -> SBV a) where
sbvUninterpret :: Maybe ([[Char]], (SBV d, SBV c, SBV b) -> SBV a)
-> [Char] -> (SBV d, SBV c, SBV b) -> SBV a
sbvUninterpret Maybe ([[Char]], (SBV d, SBV c, SBV b) -> SBV a)
mbCgData [Char]
nm = let f :: SBV d -> SBV c -> SBV b -> SBV a
f = Maybe ([[Char]], SBV d -> SBV c -> SBV b -> SBV a)
-> [Char] -> SBV d -> SBV c -> SBV b -> SBV a
forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (([[Char]], (SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]], SBV d -> SBV c -> SBV b -> SBV a)
forall {a} {a} {b} {c} {t}.
(a, (a, b, c) -> t) -> (a, a -> b -> c -> t)
uc3 (([[Char]], (SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]], SBV d -> SBV c -> SBV b -> SBV a))
-> Maybe ([[Char]], (SBV d, SBV c, SBV b) -> SBV a)
-> Maybe ([[Char]], SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], (SBV d, SBV c, SBV b) -> SBV a)
mbCgData) [Char]
nm in \(SBV d
arg0, SBV c
arg1, SBV b
arg2) -> SBV d -> SBV c -> SBV b -> SBV a
f SBV d
arg0 SBV c
arg1 SBV b
arg2
where uc3 :: (a, (a, b, c) -> t) -> (a, a -> b -> c -> t)
uc3 (a
cs, (a, b, c) -> t
fn) = (a
cs, \a
a b
b c
c -> (a, b, c) -> t
fn (a
a, b
b, c
c))
instance (SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)
=> Uninterpreted ((SBV e, SBV d, SBV c, SBV b) -> SBV a) where
sbvUninterpret :: Maybe ([[Char]], (SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> [Char] -> (SBV e, SBV d, SBV c, SBV b) -> SBV a
sbvUninterpret Maybe ([[Char]], (SBV e, SBV d, SBV c, SBV b) -> SBV a)
mbCgData [Char]
nm = let f :: SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f = Maybe ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [Char] -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (([[Char]], (SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall {a} {a} {b} {c} {d} {t}.
(a, (a, b, c, d) -> t) -> (a, a -> b -> c -> d -> t)
uc4 (([[Char]], (SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
-> Maybe ([[Char]], (SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Maybe ([[Char]], SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], (SBV e, SBV d, SBV c, SBV b) -> SBV a)
mbCgData) [Char]
nm in \(SBV e
arg0, SBV d
arg1, SBV c
arg2, SBV b
arg3) -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f SBV e
arg0 SBV d
arg1 SBV c
arg2 SBV b
arg3
where uc4 :: (a, (a, b, c, d) -> t) -> (a, a -> b -> c -> d -> t)
uc4 (a
cs, (a, b, c, d) -> t
fn) = (a
cs, \a
a b
b c
c d
d -> (a, b, c, d) -> t
fn (a
a, b
b, c
c, d
d))
instance (SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)
=> Uninterpreted ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
sbvUninterpret :: Maybe ([[Char]], (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> [Char] -> (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
sbvUninterpret Maybe ([[Char]], (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
mbCgData [Char]
nm = let f :: SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f = Maybe
([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [Char] -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (([[Char]], (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall {a} {a} {b} {c} {d} {e} {t}.
(a, (a, b, c, d, e) -> t) -> (a, a -> b -> c -> d -> e -> t)
uc5 (([[Char]], (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
-> Maybe ([[Char]], (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Maybe
([[Char]], SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
mbCgData) [Char]
nm in \(SBV f
arg0, SBV e
arg1, SBV d
arg2, SBV c
arg3, SBV b
arg4) -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f SBV f
arg0 SBV e
arg1 SBV d
arg2 SBV c
arg3 SBV b
arg4
where uc5 :: (a, (a, b, c, d, e) -> t) -> (a, a -> b -> c -> d -> e -> t)
uc5 (a
cs, (a, b, c, d, e) -> t
fn) = (a
cs, \a
a b
b c
c d
d e
e -> (a, b, c, d, e) -> t
fn (a
a, b
b, c
c, d
d, e
e))
instance (SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)
=> Uninterpreted ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
sbvUninterpret :: Maybe
([[Char]], (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> [Char] -> (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
sbvUninterpret Maybe
([[Char]], (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
mbCgData [Char]
nm = let f :: SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f = Maybe
([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [Char]
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (([[Char]], (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall {a} {a} {b} {c} {d} {e} {f} {t}.
(a, (a, b, c, d, e, f) -> t)
-> (a, a -> b -> c -> d -> e -> f -> t)
uc6 (([[Char]], (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
-> Maybe
([[Char]], (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Maybe
([[Char]],
SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe
([[Char]], (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
mbCgData) [Char]
nm in \(SBV g
arg0, SBV f
arg1, SBV e
arg2, SBV d
arg3, SBV c
arg4, SBV b
arg5) -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f SBV g
arg0 SBV f
arg1 SBV e
arg2 SBV d
arg3 SBV c
arg4 SBV b
arg5
where uc6 :: (a, (a, b, c, d, e, f) -> t)
-> (a, a -> b -> c -> d -> e -> f -> t)
uc6 (a
cs, (a, b, c, d, e, f) -> t
fn) = (a
cs, \a
a b
b c
c d
d e
e f
f -> (a, b, c, d, e, f) -> t
fn (a
a, b
b, c
c, d
d, e
e, f
f))
instance (SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)
=> Uninterpreted ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
sbvUninterpret :: Maybe
([[Char]],
(SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> [Char]
-> (SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
sbvUninterpret Maybe
([[Char]],
(SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
mbCgData [Char]
nm = let f :: SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f = Maybe
([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> [Char]
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (([[Char]],
(SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall {a} {a} {b} {c} {d} {e} {f} {g} {t}.
(a, (a, b, c, d, e, f, g) -> t)
-> (a, a -> b -> c -> d -> e -> f -> g -> t)
uc7 (([[Char]],
(SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> ([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
-> Maybe
([[Char]],
(SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Maybe
([[Char]],
SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe
([[Char]],
(SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
mbCgData) [Char]
nm in \(SBV h
arg0, SBV g
arg1, SBV f
arg2, SBV e
arg3, SBV d
arg4, SBV c
arg5, SBV b
arg6) -> SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f SBV h
arg0 SBV g
arg1 SBV f
arg2 SBV e
arg3 SBV d
arg4 SBV c
arg5 SBV b
arg6
where uc7 :: (a, (a, b, c, d, e, f, g) -> t)
-> (a, a -> b -> c -> d -> e -> f -> g -> t)
uc7 (a
cs, (a, b, c, d, e, f, g) -> t
fn) = (a
cs, \a
a b
b c
c d
d e
e f
f g
g -> (a, b, c, d, e, f, g) -> t
fn (a
a, b
b, c
c, d
d, e
e, f
f, g
g))
instance MonadIO m => SolverContext (SymbolicT m) where
constrain :: SBool -> SymbolicT m ()
constrain (SBV SVal
c) = Bool -> [([Char], [Char])] -> SVal -> SymbolicT m ()
forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [([Char], [Char])] -> SVal -> m ()
imposeConstraint Bool
False [] SVal
c
softConstrain :: SBool -> SymbolicT m ()
softConstrain (SBV SVal
c) = Bool -> [([Char], [Char])] -> SVal -> SymbolicT m ()
forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [([Char], [Char])] -> SVal -> m ()
imposeConstraint Bool
True [] SVal
c
namedConstraint :: [Char] -> SBool -> SymbolicT m ()
namedConstraint [Char]
nm (SBV SVal
c) = Bool -> [([Char], [Char])] -> SVal -> SymbolicT m ()
forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [([Char], [Char])] -> SVal -> m ()
imposeConstraint Bool
False [([Char]
":named", [Char]
nm)] SVal
c
constrainWithAttribute :: [([Char], [Char])] -> SBool -> SymbolicT m ()
constrainWithAttribute [([Char], [Char])]
atts (SBV SVal
c) = Bool -> [([Char], [Char])] -> SVal -> SymbolicT m ()
forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [([Char], [Char])] -> SVal -> m ()
imposeConstraint Bool
False [([Char], [Char])]
atts SVal
c
addAxiom :: [Char] -> [[Char]] -> SymbolicT m ()
addAxiom = [Char] -> [[Char]] -> SymbolicT m ()
forall (m :: * -> *).
(SolverContext m, MonadIO m) =>
[Char] -> [[Char]] -> m ()
addSymAxiom
contextState :: SymbolicT m State
contextState = SymbolicT m State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
setOption :: SMTOption -> SymbolicT m ()
setOption SMTOption
o = SMTOption -> SymbolicT m ()
forall (m :: * -> *). MonadSymbolic m => SMTOption -> m ()
addNewSMTOption SMTOption
o
addSymAxiom :: (SolverContext m, MonadIO m) => String -> [String] -> m ()
addSymAxiom :: forall (m :: * -> *).
(SolverContext m, MonadIO m) =>
[Char] -> [[Char]] -> m ()
addSymAxiom [Char]
nm [[Char]]
ax = do
State
st <- m State
forall (m :: * -> *). SolverContext m => m State
contextState
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ State
-> (State -> IORef [([Char], [[Char]])])
-> ([([Char], [[Char]])] -> [([Char], [[Char]])])
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [([Char], [[Char]])]
raxioms (([Char]
nm, [[Char]]
ax) ([Char], [[Char]]) -> [([Char], [[Char]])] -> [([Char], [[Char]])]
forall a. a -> [a] -> [a]
:) (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
assertWithPenalty :: MonadSymbolic m => String -> SBool -> Penalty -> m ()
assertWithPenalty :: forall (m :: * -> *).
MonadSymbolic m =>
[Char] -> SBool -> Penalty -> m ()
assertWithPenalty [Char]
nm SBool
o Penalty
p = Objective SVal -> m ()
forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal (Objective SVal -> m ()) -> Objective SVal -> m ()
forall a b. (a -> b) -> a -> b
$ SBool -> SVal
forall a. SBV a -> SVal
unSBV (SBool -> SVal) -> Objective SBool -> Objective SVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> SBool -> Penalty -> Objective SBool
forall a. [Char] -> a -> Penalty -> Objective a
AssertWithPenalty [Char]
nm SBool
o Penalty
p
class Metric a where
type MetricSpace a :: Type
type MetricSpace a = a
toMetricSpace :: SBV a -> SBV (MetricSpace a)
fromMetricSpace :: SBV (MetricSpace a) -> SBV a
msMinimize :: (MonadSymbolic m, SolverContext m) => String -> SBV a -> m ()
msMinimize [Char]
nm SBV a
o = Objective SVal -> m ()
forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal (Objective SVal -> m ()) -> Objective SVal -> m ()
forall a b. (a -> b) -> a -> b
$ SBV (MetricSpace a) -> SVal
forall a. SBV a -> SVal
unSBV (SBV (MetricSpace a) -> SVal)
-> Objective (SBV (MetricSpace a)) -> Objective SVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> SBV (MetricSpace a) -> Objective (SBV (MetricSpace a))
forall a. [Char] -> a -> Objective a
Minimize [Char]
nm (SBV a -> SBV (MetricSpace a)
forall a. Metric a => SBV a -> SBV (MetricSpace a)
toMetricSpace SBV a
o)
msMaximize :: (MonadSymbolic m, SolverContext m) => String -> SBV a -> m ()
msMaximize [Char]
nm SBV a
o = Objective SVal -> m ()
forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal (Objective SVal -> m ()) -> Objective SVal -> m ()
forall a b. (a -> b) -> a -> b
$ SBV (MetricSpace a) -> SVal
forall a. SBV a -> SVal
unSBV (SBV (MetricSpace a) -> SVal)
-> Objective (SBV (MetricSpace a)) -> Objective SVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> SBV (MetricSpace a) -> Objective (SBV (MetricSpace a))
forall a. [Char] -> a -> Objective a
Maximize [Char]
nm (SBV a -> SBV (MetricSpace a)
forall a. Metric a => SBV a -> SBV (MetricSpace a)
toMetricSpace SBV a
o)
default toMetricSpace :: (a ~ MetricSpace a) => SBV a -> SBV (MetricSpace a)
toMetricSpace = SBV a -> SBV (MetricSpace a)
forall a. a -> a
id
default fromMetricSpace :: (a ~ MetricSpace a) => SBV (MetricSpace a) -> SBV a
fromMetricSpace = SBV (MetricSpace a) -> SBV a
forall a. a -> a
id
instance Metric Bool where
type MetricSpace Bool = Word8
toMetricSpace :: SBool -> SBV (MetricSpace Bool)
toMetricSpace SBool
t = SBool -> SWord8 -> SWord8 -> SWord8
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
t SWord8
1 SWord8
0
fromMetricSpace :: SBV (MetricSpace Bool) -> SBool
fromMetricSpace SBV (MetricSpace Bool)
w = SWord8
SBV (MetricSpace Bool)
w SWord8 -> SWord8 -> SBool
forall a. EqSymbolic a => a -> a -> SBool
./= SWord8
0
minimize :: (Metric a, MonadSymbolic m, SolverContext m) => String -> SBV a -> m ()
minimize :: forall a (m :: * -> *).
(Metric a, MonadSymbolic m, SolverContext m) =>
[Char] -> SBV a -> m ()
minimize = [Char] -> SBV a -> m ()
forall a (m :: * -> *).
(Metric a, MonadSymbolic m, SolverContext m) =>
[Char] -> SBV a -> m ()
msMinimize
maximize :: (Metric a, MonadSymbolic m, SolverContext m) => String -> SBV a -> m ()
maximize :: forall a (m :: * -> *).
(Metric a, MonadSymbolic m, SolverContext m) =>
[Char] -> SBV a -> m ()
maximize = [Char] -> SBV a -> m ()
forall a (m :: * -> *).
(Metric a, MonadSymbolic m, SolverContext m) =>
[Char] -> SBV a -> m ()
msMaximize
instance Metric Word8
instance Metric Word16
instance Metric Word32
instance Metric Word64
instance Metric Integer
instance Metric AlgReal
instance Metric Int8 where
type MetricSpace Int8 = Word8
toMetricSpace :: SInt8 -> SBV (MetricSpace Int8)
toMetricSpace SInt8
x = SInt8 -> SWord8
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SInt8
x SWord8 -> SWord8 -> SWord8
forall a. Num a => a -> a -> a
+ SWord8
128
fromMetricSpace :: SBV (MetricSpace Int8) -> SInt8
fromMetricSpace SBV (MetricSpace Int8)
x = SWord8 -> SInt8
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord8
SBV (MetricSpace Int8)
x SInt8 -> SInt8 -> SInt8
forall a. Num a => a -> a -> a
- SInt8
128
instance Metric Int16 where
type MetricSpace Int16 = Word16
toMetricSpace :: SInt16 -> SBV (MetricSpace Int16)
toMetricSpace SInt16
x = SInt16 -> SWord16
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SInt16
x SWord16 -> SWord16 -> SWord16
forall a. Num a => a -> a -> a
+ SWord16
32768
fromMetricSpace :: SBV (MetricSpace Int16) -> SInt16
fromMetricSpace SBV (MetricSpace Int16)
x = SWord16 -> SInt16
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord16
SBV (MetricSpace Int16)
x SInt16 -> SInt16 -> SInt16
forall a. Num a => a -> a -> a
- SInt16
32768
instance Metric Int32 where
type MetricSpace Int32 = Word32
toMetricSpace :: SInt32 -> SBV (MetricSpace Int32)
toMetricSpace SInt32
x = SInt32 -> SWord32
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SInt32
x SWord32 -> SWord32 -> SWord32
forall a. Num a => a -> a -> a
+ SWord32
2147483648
fromMetricSpace :: SBV (MetricSpace Int32) -> SInt32
fromMetricSpace SBV (MetricSpace Int32)
x = SWord32 -> SInt32
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord32
SBV (MetricSpace Int32)
x SInt32 -> SInt32 -> SInt32
forall a. Num a => a -> a -> a
- SInt32
2147483648
instance Metric Int64 where
type MetricSpace Int64 = Word64
toMetricSpace :: SInt64 -> SBV (MetricSpace Int64)
toMetricSpace SInt64
x = SInt64 -> SWord64
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SInt64
x SWord64 -> SWord64 -> SWord64
forall a. Num a => a -> a -> a
+ SWord64
9223372036854775808
fromMetricSpace :: SBV (MetricSpace Int64) -> SInt64
fromMetricSpace SBV (MetricSpace Int64)
x = SWord64 -> SInt64
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
SymVal b) =>
SBV a -> SBV b
sFromIntegral SWord64
SBV (MetricSpace Int64)
x SInt64 -> SInt64 -> SInt64
forall a. Num a => a -> a -> a
- SInt64
9223372036854775808
instance Testable SBool where
property :: SBool -> Property
property (SBV (SVal Kind
_ (Left CV
b))) = Bool -> Property
forall prop. Testable prop => prop -> Property
property (CV -> Bool
cvToBool CV
b)
property SBool
_ = [Char] -> Property
forall a. HasCallStack => [Char] -> a
error [Char]
"Quick-check: Constant folding produced a symbolic value! Perhaps used a non-reducible expression? Please report!"
instance Testable (Symbolic SBool) where
property :: Symbolic SBool -> Property
property Symbolic SBool
prop = PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
QC.monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$ do (Bool
cond, Bool
r, [([Char], CV)]
modelVals) <- IO (Bool, Bool, [([Char], CV)])
-> PropertyM IO (Bool, Bool, [([Char], CV)])
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QC.run IO (Bool, Bool, [([Char], CV)])
test
Bool -> PropertyM IO ()
forall (m :: * -> *). Monad m => Bool -> PropertyM m ()
QC.pre Bool
cond
Bool -> PropertyM IO () -> PropertyM IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
r Bool -> Bool -> Bool
|| [([Char], CV)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], CV)]
modelVals) (PropertyM IO () -> PropertyM IO ())
-> PropertyM IO () -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$ (Property -> Property) -> PropertyM IO ()
forall (m :: * -> *).
Monad m =>
(Property -> Property) -> PropertyM m ()
QC.monitor ([Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
QC.counterexample ([([Char], CV)] -> [Char]
complain [([Char], CV)]
modelVals))
Bool -> PropertyM IO ()
forall (m :: * -> *). Monad m => Bool -> PropertyM m ()
QC.assert Bool
r
where test :: IO (Bool, Bool, [([Char], CV)])
test = do (SBool
r, Result{resTraces :: Result -> [([Char], CV)]
resTraces=[([Char], CV)]
tvals, resObservables :: Result -> [([Char], CV -> Bool, SV)]
resObservables=[([Char], CV -> Bool, SV)]
ovals, resConsts :: Result -> (CnstMap, [(SV, CV)])
resConsts=(CnstMap
_, [(SV, CV)]
cs), resConstraints :: Result -> Seq (Bool, [([Char], [Char])], SV)
resConstraints=Seq (Bool, [([Char], [Char])], SV)
cstrs, resUIConsts :: Result -> [([Char], SBVType)]
resUIConsts=[([Char], SBVType)]
unints}) <- SBVRunMode -> Symbolic SBool -> IO (SBool, Result)
forall (m :: * -> *) a.
MonadIO m =>
SBVRunMode -> SymbolicT m a -> m (a, Result)
runSymbolic (Maybe (Bool, [((Quantifier, NamedSymVar), Maybe CV)]) -> SBVRunMode
Concrete Maybe (Bool, [((Quantifier, NamedSymVar), Maybe CV)])
forall a. Maybe a
Nothing) Symbolic SBool
prop
let cval :: SV -> CV
cval = CV -> Maybe CV -> CV
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> CV
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot quick-check in the presence of uninterpeted constants!") (Maybe CV -> CV) -> (SV -> Maybe CV) -> SV -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SV -> [(SV, CV)] -> Maybe CV
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(SV, CV)]
cs)
cond :: Bool
cond = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [CV -> Bool
cvToBool (SV -> CV
cval SV
v) | (Bool
False, [([Char], [Char])]
_, SV
v) <- Seq (Bool, [([Char], [Char])], SV)
-> [(Bool, [([Char], [Char])], SV)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq (Bool, [([Char], [Char])], SV)
cstrs]
getObservable :: ([Char], CV -> Bool, SV) -> Maybe ([Char], CV)
getObservable ([Char]
nm, CV -> Bool
f, SV
v) = case SV
v SV -> [(SV, CV)] -> Maybe CV
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(SV, CV)]
cs of
Just CV
cv -> if CV -> Bool
f CV
cv then ([Char], CV) -> Maybe ([Char], CV)
forall a. a -> Maybe a
Just ([Char]
nm, CV
cv) else Maybe ([Char], CV)
forall a. Maybe a
Nothing
Maybe CV
Nothing -> [Char] -> Maybe ([Char], CV)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Maybe ([Char], CV)) -> [Char] -> Maybe ([Char], CV)
forall a b. (a -> b) -> a -> b
$ [Char]
"Quick-check: Observable " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nm [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" did not reduce to a constant!"
case (([Char], SBVType) -> [Char]) -> [([Char], SBVType)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], SBVType) -> [Char]
forall a b. (a, b) -> a
fst [([Char], SBVType)]
unints of
[] -> case SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
r of
Maybe Bool
Nothing -> [Char] -> IO (Bool, Bool, [([Char], CV)])
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (Bool, Bool, [([Char], CV)]))
-> [Char] -> IO (Bool, Bool, [([Char], CV)])
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n" [ [Char]
"Quick-check: Calls to 'observe' not supported in quick-check mode. Please use 'sObserve' for full support."
, [Char]
" (If you haven't used 'observe', please report this as a bug!)"
]
Just Bool
b -> (Bool, Bool, [([Char], CV)]) -> IO (Bool, Bool, [([Char], CV)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
cond, Bool
b, [([Char], CV)]
tvals [([Char], CV)] -> [([Char], CV)] -> [([Char], CV)]
forall a. [a] -> [a] -> [a]
++ (([Char], CV -> Bool, SV) -> Maybe ([Char], CV))
-> [([Char], CV -> Bool, SV)] -> [([Char], CV)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Char], CV -> Bool, SV) -> Maybe ([Char], CV)
getObservable [([Char], CV -> Bool, SV)]
ovals)
[[Char]]
us -> [Char] -> IO (Bool, Bool, [([Char], CV)])
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (Bool, Bool, [([Char], CV)]))
-> [Char] -> IO (Bool, Bool, [([Char], CV)])
forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot quick-check in the presence of uninterpreted constants: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
us
complain :: [([Char], CV)] -> [Char]
complain [([Char], CV)]
qcInfo = SMTConfig -> SMTModel -> [Char]
showModel SMTConfig
defaultSMTCfg ([([Char], GeneralizedCV)]
-> Maybe [((Quantifier, NamedSymVar), Maybe CV)]
-> [([Char], CV)]
-> [([Char], (SBVType, ([([CV], CV)], CV)))]
-> SMTModel
SMTModel [] Maybe [((Quantifier, NamedSymVar), Maybe CV)]
forall a. Maybe a
Nothing [([Char], CV)]
qcInfo [])
sbvQuickCheck :: Symbolic SBool -> IO Bool
sbvQuickCheck :: Symbolic SBool -> IO Bool
sbvQuickCheck Symbolic SBool
prop = Result -> Bool
QC.isSuccess (Result -> Bool) -> IO Result -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Symbolic SBool -> IO Result
forall prop. Testable prop => prop -> IO Result
QC.quickCheckResult Symbolic SBool
prop
instance Testable (Symbolic SVal) where
property :: Symbolic SVal -> Property
property Symbolic SVal
m = Symbolic SBool -> Property
forall prop. Testable prop => prop -> Property
property (Symbolic SBool -> Property) -> Symbolic SBool -> Property
forall a b. (a -> b) -> a -> b
$ do SVal
s <- Symbolic SVal
m
Bool -> Symbolic () -> Symbolic ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SVal -> Kind
forall a. HasKind a => a -> Kind
kindOf SVal
s Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
/= Kind
KBool) (Symbolic () -> Symbolic ()) -> Symbolic () -> Symbolic ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Symbolic ()
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot quickcheck non-boolean value"
SBool -> Symbolic SBool
forall (m :: * -> *) a. Monad m => a -> m a
return (SVal -> SBool
forall a. SVal -> SBV a
SBV SVal
s :: SBool)
slet :: forall a b. (HasKind a, HasKind b) => SBV a -> (SBV a -> SBV b) -> SBV b
slet :: forall a b.
(HasKind a, HasKind b) =>
SBV a -> (SBV a -> SBV b) -> SBV b
slet SBV a
x SBV a -> SBV b
f = SVal -> SBV b
forall a. SVal -> SBV a
SBV (SVal -> SBV b) -> SVal -> SBV b
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
where k :: Kind
k = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall {t}. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
r :: State -> IO SV
r State
st = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
let xsbv :: SBV a
xsbv = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache (IO SV -> State -> IO SV
forall a b. a -> b -> a
const (SV -> IO SV
forall (m :: * -> *) a. Monad m => a -> m a
return SV
xsv))))
res :: SBV b
res = SBV a -> SBV b
f SBV a
xsbv
State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
res
infix 4 ===
class Equality a where
(===) :: a -> a -> IO ThmResult
instance {-# OVERLAPPABLE #-} (SymVal a, EqSymbolic z) => Equality (SBV a -> z) where
SBV a -> z
k === :: (SBV a -> z) -> (SBV a -> z) -> IO ThmResult
=== SBV a -> z
l = (SBV a -> SBool) -> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBool) -> IO ThmResult)
-> (SBV a -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a -> SBV a -> z
k SBV a
a z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> z
l SBV a
a
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, EqSymbolic z) => Equality (SBV a -> SBV b -> z) where
SBV a -> SBV b -> z
k === :: (SBV a -> SBV b -> z) -> (SBV a -> SBV b -> z) -> IO ThmResult
=== SBV a -> SBV b -> z
l = (SBV a -> SBV b -> SBool) -> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b -> SBV a -> SBV b -> z
k SBV a
a SBV b
b z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> z
l SBV a
a SBV b
b
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, EqSymbolic z) => Equality ((SBV a, SBV b) -> z) where
(SBV a, SBV b) -> z
k === :: ((SBV a, SBV b) -> z) -> ((SBV a, SBV b) -> z) -> IO ThmResult
=== (SBV a, SBV b) -> z
l = (SBV a -> SBV b -> SBool) -> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b -> (SBV a, SBV b) -> z
k (SBV a
a, SBV b
b) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b) -> z
l (SBV a
a, SBV b
b)
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> z) where
SBV a -> SBV b -> SBV c -> z
k === :: (SBV a -> SBV b -> SBV c -> z)
-> (SBV a -> SBV b -> SBV c -> z) -> IO ThmResult
=== SBV a -> SBV b -> SBV c -> z
l = (SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c -> SBV a -> SBV b -> SBV c -> z
k SBV a
a SBV b
b SBV c
c z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> z
l SBV a
a SBV b
b SBV c
c
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c) -> z) where
(SBV a, SBV b, SBV c) -> z
k === :: ((SBV a, SBV b, SBV c) -> z)
-> ((SBV a, SBV b, SBV c) -> z) -> IO ThmResult
=== (SBV a, SBV b, SBV c) -> z
l = (SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c -> (SBV a, SBV b, SBV c) -> z
k (SBV a
a, SBV b
b, SBV c
c) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c) -> z
l (SBV a
a, SBV b
b, SBV c
c)
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> z) where
SBV a -> SBV b -> SBV c -> SBV d -> z
k === :: (SBV a -> SBV b -> SBV c -> SBV d -> z)
-> (SBV a -> SBV b -> SBV c -> SBV d -> z) -> IO ThmResult
=== SBV a -> SBV b -> SBV c -> SBV d -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d -> SBV a -> SBV b -> SBV c -> SBV d -> z
k SBV a
a SBV b
b SBV c
c SBV d
d z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> SBV d -> z
l SBV a
a SBV b
b SBV c
c SBV d
d
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d) -> z) where
(SBV a, SBV b, SBV c, SBV d) -> z
k === :: ((SBV a, SBV b, SBV c, SBV d) -> z)
-> ((SBV a, SBV b, SBV c, SBV d) -> z) -> IO ThmResult
=== (SBV a, SBV b, SBV c, SBV d) -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d -> (SBV a, SBV b, SBV c, SBV d) -> z
k (SBV a
a, SBV b
b, SBV c
c, SBV d
d) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c, SBV d) -> z
l (SBV a
a, SBV b
b, SBV c
c, SBV d
d)
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z) where
SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z
k === :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z) -> IO ThmResult
=== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e -> SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z
k SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z
l SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d, SBV e) -> z) where
(SBV a, SBV b, SBV c, SBV d, SBV e) -> z
k === :: ((SBV a, SBV b, SBV c, SBV d, SBV e) -> z)
-> ((SBV a, SBV b, SBV c, SBV d, SBV e) -> z) -> IO ThmResult
=== (SBV a, SBV b, SBV c, SBV d, SBV e) -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e -> (SBV a, SBV b, SBV c, SBV d, SBV e) -> z
k (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c, SBV d, SBV e) -> z
l (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e)
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z) where
SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z
k === :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z)
-> IO ThmResult
=== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f -> SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z
k SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z
l SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f
instance {-# OVERLAPPABLE #-}
(SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z) where
(SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z
k === :: ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z)
-> ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z)
-> IO ThmResult
=== (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f -> (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z
k (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e, SBV f
f) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z
l (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e, SBV f
f)
instance {-# OVERLAPPABLE #-}
(SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z) where
SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z
k === :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z)
-> (SBV a
-> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z)
-> IO ThmResult
=== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z
l = (SBV a
-> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a
-> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult)
-> (SBV a
-> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f SBV g
g -> SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z
k SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f SBV g
g z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z
l SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f SBV g
g
instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z) where
(SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z
k === :: ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z)
-> ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z)
-> IO ThmResult
=== (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z
l = (SBV a
-> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove ((SBV a
-> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult)
-> (SBV a
-> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f SBV g
g -> (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z
k (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e, SBV f
f, SBV g
g) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z
l (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e, SBV f
f, SBV g
g)
{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
{-# ANN module ("HLint: ignore Eta reduce" :: String) #-}