-----------------------------------------------------------------------------
-- |
-- Module    : Data.SBV.Core.Model
-- Copyright : (c) Levent Erkok
-- License   : BSD3
-- Maintainer: erkokl@gmail.com
-- Stability : experimental
--
-- Instance declarations for our symbolic world
-----------------------------------------------------------------------------

{-# 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 -Wno-incomplete-uni-patterns #-}

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_, sbvForall, sbvForall_, sbvExists, sbvExists_
  , 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)
import Data.SBV.Utils.Numeric (fpIsEqualObjectH)

-- Symbolic-Word class instances

-- | Generate a finite symbolic bitvector, named
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 = forall a (m :: * -> *).
MonadSymbolic m =>
VarContext -> Kind -> Maybe [Char] -> m (SBV a)
mkSymSBV VarContext
q Kind
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

-- | Generate a finite symbolic bitvector, unnamed
genVar_ :: MonadSymbolic m => VarContext -> Kind -> m (SBV a)
genVar_ :: forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> m (SBV a)
genVar_ VarContext
q Kind
k = forall a (m :: * -> *).
MonadSymbolic m =>
VarContext -> Kind -> Maybe [Char] -> m (SBV a)
mkSymSBV VarContext
q Kind
k forall a. Maybe a
Nothing

-- | Generate a finite constant bitvector
genLiteral :: Integral a => Kind -> a -> SBV b
genLiteral :: forall a b. Integral a => Kind -> a -> SBV b
genLiteral Kind
k = forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
k

-- | Convert a constant to an integral value
genFromCV :: Integral a => CV -> a
genFromCV :: forall a. Integral a => CV -> a
genFromCV (CV Kind
_ (CInteger Integer
x)) = forall a. Num a => Integer -> a
fromInteger Integer
x
genFromCV CV
c                   = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"genFromCV: Unsupported non-integral value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CV
c

-- | Generalization of 'Data.SBV.genMkSymVar'
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  = forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> m (SBV a)
genVar_ VarContext
mbq Kind
k
genMkSymVar Kind
k VarContext
mbq (Just [Char]
s) = 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 = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KBool
  literal :: Bool -> SBool
literal  = forall a. SVal -> SBV a
SBV 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 = 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  = forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
False Int
8)
  fromCV :: CV -> Word8
fromCV   = forall a. Integral a => CV -> a
genFromCV

instance SymVal Int8 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInt8
mkSymVal = 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  = forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
True Int
8)
  fromCV :: CV -> Int8
fromCV   = forall a. Integral a => CV -> a
genFromCV

instance SymVal Word16 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SWord16
mkSymVal = 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  = forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
False Int
16)
  fromCV :: CV -> Word16
fromCV   = forall a. Integral a => CV -> a
genFromCV

instance SymVal Int16 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInt16
mkSymVal = 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  = forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
True Int
16)
  fromCV :: CV -> Int16
fromCV   = forall a. Integral a => CV -> a
genFromCV

instance SymVal Word32 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SWord32
mkSymVal = 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  = forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
False Int
32)
  fromCV :: CV -> Word32
fromCV   = forall a. Integral a => CV -> a
genFromCV

instance SymVal Int32 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInt32
mkSymVal = 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  = forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
True Int
32)
  fromCV :: CV -> Int32
fromCV   = forall a. Integral a => CV -> a
genFromCV

instance SymVal Word64 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SWord64
mkSymVal = 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  = forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
False Int
64)
  fromCV :: CV -> Word64
fromCV   = forall a. Integral a => CV -> a
genFromCV

instance SymVal Int64 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInt64
mkSymVal = 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  = forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
True Int
64)
  fromCV :: CV -> Int64
fromCV   = forall a. Integral a => CV -> a
genFromCV

instance SymVal Integer where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SInteger
mkSymVal = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KUnbounded
  literal :: Integer -> SInteger
literal  = forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KUnbounded forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
KUnbounded
  fromCV :: CV -> Integer
fromCV   = forall a. Integral a => CV -> a
genFromCV

instance SymVal Rational where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV Rational)
mkSymVal                    = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KRational
  literal :: Rational -> SBV Rational
literal                     = forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KRational  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KRational 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                    = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.Rational: Unexpected non-rational value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CV
c

instance SymVal AlgReal where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m SReal
mkSymVal                   = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KReal
  literal :: AlgReal -> SReal
literal                    = forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KReal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KReal 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                   = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.AlgReal: Unexpected non-real value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CV
c

  -- AlgReal needs its own definition of isConcretely
  -- to make sure we avoid using unimplementable Haskell functions
  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                 = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KFloat
  literal :: Float -> SBV Float
literal                  = forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KFloat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KFloat 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                 = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.Float: Unexpected non-float value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CV
c

  -- For Float, we conservatively return 'False' for isConcretely. The reason is that
  -- this function is used for optimizations when only one of the argument is concrete,
  -- and in the presence of NaN's it would be incorrect to do any optimization
  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                  = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KDouble
  literal :: Double -> SBV Double
literal                   = forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KDouble forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KDouble 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                  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.Double: Unexpected non-double value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CV
c

  -- For Double, we conservatively return 'False' for isConcretely. The reason is that
  -- this function is used for optimizations when only one of the argument is concrete,
  -- and in the presence of NaN's it would be incorrect to do any optimization
  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                = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KChar
  literal :: Char -> SBV Char
literal Char
c               = forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KChar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KChar 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                = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.String: Unexpected non-char value: " forall a. [a] -> [a] -> [a]
++ 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] forall a. HasCallStack => a
undefined = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar Kind
KString
    | Bool
True                     = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Kind -> Kind
KList (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)))

  literal :: [a] -> SBV [a]
literal [a]
as
    | forall a. Typeable a => a -> Bool
isKString @[a] forall a. HasCallStack => a
undefined = case forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (forall a. Typeable a => a -> Dynamic
toDyn [a]
as) of
                                   Just [Char]
s  -> forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> CVal
CString forall a b. (a -> b) -> a -> b
$ [Char]
s
                                   Maybe [Char]
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"SString: Cannot construct literal string!"
    | Bool
True                     = let k :: Kind
k = Kind -> Kind
KList (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a))
                                 in forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k forall a b. (a -> b) -> a -> b
$ [CVal] -> CVal
CList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. SymVal a => a -> CVal
toCV [a]
as

  fromCV :: CV -> [a]
fromCV (CV Kind
_ (CString [Char]
a)) = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"SString: Cannot extract a literal string!")
                                        (forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (forall a. Typeable a => a -> Dynamic
toDyn [Char]
a))
  fromCV (CV Kind
_ (CList [CVal]
a))   = forall a. SymVal a => CV -> a
fromCV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CVal]
a
  fromCV CV
c                  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCV: Unexpected non-list value: " forall a. [a] -> [a] -> [a]
++ 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 (forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
Proxy @eb)) (forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). 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                   = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (Int -> Int -> Kind
KFP (forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
Proxy @eb)) (forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
Proxy @sb)))
  literal :: FloatingPoint eb sb -> SBV (FloatingPoint eb sb)
literal (FloatingPoint FP
r)  = let k :: Kind
k = Int -> Int -> Kind
KFP (forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
Proxy @eb)) (forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
Proxy @sb))
                               in forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left 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))     = forall (eb :: Nat) (sb :: Nat). FP -> FloatingPoint eb sb
FloatingPoint FP
r
  fromCV  CV
c                  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.FPR: Unexpected non-arbitrary-precision value: " forall a. [a] -> [a] -> [a]
++ 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 forall a. SymVal a => a -> SBV a
literal a
a of
           SBV (SVal Kind
_ (Left CV
cv)) -> CV -> CVal
cvVal CV
cv
           SBV a
_                      -> 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 forall a. Eq a => a -> a -> Bool
== Int
lcs Bool -> Bool -> Bool
&& Int
lks forall a. Eq a => a -> a -> Bool
== Int
i
  = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k forall a b. (a -> b) -> a -> b
$ [CVal] -> CVal
CTuple [CVal]
cs
  | Bool
True
  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.mkCVTup: Impossible happened. Malformed tuple received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
i, Kind
k)
   where lks :: Int
lks = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
ks
         lcs :: Int
lcs = forall (t :: * -> *) a. Foldable t => t a -> Int
length [CVal]
cs
mkCVTup Int
i Kind
k [CVal]
_
  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.mkCVTup: Impossible happened. Non-tuple received: " forall a. [a] -> [a] -> [a]
++ 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 forall a. Eq a => a -> a -> Bool
== Int
lcs Bool -> Bool -> Bool
&& Int
lks forall a. Eq a => a -> a -> Bool
== Int
i
   = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Kind -> CVal -> CV
CV [Kind]
ks [CVal]
cs
   | Bool
True
   = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCTup: Impossible happened. Malformed tuple received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
i, CV
inp)
   where lks :: Int
lks = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
ks
         lcs :: Int
lcs = forall (t :: * -> *) a. Foldable t => t a -> Int
length [CVal]
cs
fromCVTup Int
i CV
inp = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCVTup: Impossible happened. Non-tuple received: " forall a. [a] -> [a] -> [a]
++ 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 = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (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 forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left  (forall a. SymVal a => a -> CVal
toCV a
a)
    | Right b
b <- Either a b
s = Either CVal CVal -> SBV (Either a b)
mk forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (forall a. SymVal a => a -> CVal
toCV b
b)
    where k :: Kind
k  = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(Either a b))

          mk :: Either CVal CVal -> SBV (Either a b)
mk = forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
k 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)))  = forall a b. a -> Either a b
Left  forall a b. (a -> b) -> a -> b
$ forall a. SymVal a => CV -> a
fromCV 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))) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. SymVal a => CV -> a
fromCV forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k2 CVal
c
  fromCV CV
bad                                   = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCV (Either): Malformed either received: " forall a. [a] -> [a] -> [a]
++ 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 = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (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 forall a. Maybe a
Nothing
    | Just  a
a <- Maybe a
s = Maybe CVal -> SBV (Maybe a)
mk forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (forall a. SymVal a => a -> CVal
toCV a
a)
    where k :: Kind
k = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(Maybe a))

          mk :: Maybe CVal -> SBV (Maybe a)
mk = forall a. SVal -> SBV a
SBV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
k 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))  = forall a. Maybe a
Nothing
  fromCV (CV (KMaybe Kind
k) (CMaybe (Just CVal
x))) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. SymVal a => CV -> a
fromCV forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k CVal
x
  fromCV CV
bad                               = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCV (Maybe): Malformed sum received: " forall a. [a] -> [a] -> [a]
++ 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 = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(RCSet a)))

  literal :: RCSet a -> SBV (RCSet a)
literal RCSet a
eur = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k forall a b. (a -> b) -> a -> b
$ RCSet CVal -> CVal
CSet forall a b. (a -> b) -> a -> b
$ Set CVal -> RCSet CVal
dir forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map 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    -> (forall a. Set a -> RCSet a
RegularSet,    Set a
x)
                      ComplementSet Set a
x -> (forall a. Set a -> RCSet a
ComplementSet, Set a
x)
          k :: Kind
k        = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(RCSet a))

  fromCV :: CV -> RCSet a
fromCV (CV (KSet Kind
a) (CSet (RegularSet    Set CVal
s))) = forall a. Set a -> RCSet a
RegularSet    forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall a. SymVal a => CV -> a
fromCV 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))) = forall a. Set a -> RCSet a
ComplementSet forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (forall a. SymVal a => CV -> a
fromCV forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
a) Set CVal
s
  fromCV CV
bad                                    = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SymVal.fromCV (Set): Malformed set received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show CV
bad

-- | SymVal for 0-tuple (i.e., unit)
instance SymVal () where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV ())
mkSymVal   = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar ([Kind] -> Kind
KTuple [])
  literal :: () -> SBV ()
literal () = forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
0   (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @())) []
  fromCV :: CV -> ()
fromCV CV
cv  = Int -> CV -> [CV]
fromCVTup Int
0 CV
cv seq :: forall a b. a -> b -> b
`seq` ()

-- | SymVal for 2-tuples
instance (SymVal a, SymVal b) => SymVal (a, b) where
   mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe [Char] -> m (SBV (a, b))
mkSymVal         = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(a, b)))
   literal :: (a, b) -> SBV (a, b)
literal (a
v1, b
v2) = forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
2   (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(a, b))) [forall a. SymVal a => a -> CVal
toCV a
v1, 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 (forall a. SymVal a => CV -> a
fromCV CV
v1, forall a. SymVal a => CV -> a
fromCV CV
v2)

-- | SymVal for 3-tuples
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             = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (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) = forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
3   (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(a, b, c))) [forall a. SymVal a => a -> CVal
toCV a
v1, forall a. SymVal a => a -> CVal
toCV b
v2, 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 (forall a. SymVal a => CV -> a
fromCV CV
v1, forall a. SymVal a => CV -> a
fromCV CV
v2, forall a. SymVal a => CV -> a
fromCV CV
v3)

-- | SymVal for 4-tuples
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                 = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (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) = forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
4   (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d))) [forall a. SymVal a => a -> CVal
toCV a
v1, forall a. SymVal a => a -> CVal
toCV b
v2, forall a. SymVal a => a -> CVal
toCV c
v3, 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 (forall a. SymVal a => CV -> a
fromCV CV
v1, forall a. SymVal a => CV -> a
fromCV CV
v2, forall a. SymVal a => CV -> a
fromCV CV
v3, forall a. SymVal a => CV -> a
fromCV CV
v4)

-- | SymVal for 5-tuples
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                     = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (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) = forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
5   (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e))) [forall a. SymVal a => a -> CVal
toCV a
v1, forall a. SymVal a => a -> CVal
toCV b
v2, forall a. SymVal a => a -> CVal
toCV c
v3, forall a. SymVal a => a -> CVal
toCV d
v4, 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 (forall a. SymVal a => CV -> a
fromCV CV
v1, forall a. SymVal a => CV -> a
fromCV CV
v2, forall a. SymVal a => CV -> a
fromCV CV
v3, forall a. SymVal a => CV -> a
fromCV CV
v4, forall a. SymVal a => CV -> a
fromCV CV
v5)

-- | SymVal for 6-tuples
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                         = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (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) = forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
6   (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e, f))) [forall a. SymVal a => a -> CVal
toCV a
v1, forall a. SymVal a => a -> CVal
toCV b
v2, forall a. SymVal a => a -> CVal
toCV c
v3, forall a. SymVal a => a -> CVal
toCV d
v4, forall a. SymVal a => a -> CVal
toCV e
v5, 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 (forall a. SymVal a => CV -> a
fromCV CV
v1, forall a. SymVal a => CV -> a
fromCV CV
v2, forall a. SymVal a => CV -> a
fromCV CV
v3, forall a. SymVal a => CV -> a
fromCV CV
v4, forall a. SymVal a => CV -> a
fromCV CV
v5, forall a. SymVal a => CV -> a
fromCV CV
v6)

-- | SymVal for 7-tuples
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                             = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (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) = forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
7   (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e, f, g))) [forall a. SymVal a => a -> CVal
toCV a
v1, forall a. SymVal a => a -> CVal
toCV b
v2, forall a. SymVal a => a -> CVal
toCV c
v3, forall a. SymVal a => a -> CVal
toCV d
v4, forall a. SymVal a => a -> CVal
toCV e
v5, forall a. SymVal a => a -> CVal
toCV f
v6, 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 (forall a. SymVal a => CV -> a
fromCV CV
v1, forall a. SymVal a => CV -> a
fromCV CV
v2, forall a. SymVal a => CV -> a
fromCV CV
v3, forall a. SymVal a => CV -> a
fromCV CV
v4, forall a. SymVal a => CV -> a
fromCV CV
v5, forall a. SymVal a => CV -> a
fromCV CV
v6, forall a. SymVal a => CV -> a
fromCV CV
v7)

-- | SymVal for 8-tuples
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                                 = forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe [Char] -> m (SBV a)
genMkSymVar (forall a. HasKind a => a -> Kind
kindOf (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) = forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
8   (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e, f, g, h))) [forall a. SymVal a => a -> CVal
toCV a
v1, forall a. SymVal a => a -> CVal
toCV b
v2, forall a. SymVal a => a -> CVal
toCV c
v3, forall a. SymVal a => a -> CVal
toCV d
v4, forall a. SymVal a => a -> CVal
toCV e
v5, forall a. SymVal a => a -> CVal
toCV f
v6, forall a. SymVal a => a -> CVal
toCV g
v7, 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 (forall a. SymVal a => CV -> a
fromCV CV
v1, forall a. SymVal a => CV -> a
fromCV CV
v2, forall a. SymVal a => CV -> a
fromCV CV
v3, forall a. SymVal a => CV -> a
fromCV CV
v4, forall a. SymVal a => CV -> a
fromCV CV
v5, forall a. SymVal a => CV -> a
fromCV CV
v6, forall a. SymVal a => CV -> a
fromCV CV
v7, forall a. SymVal a => CV -> a
fromCV CV
v8)

instance IsString SString where
  fromString :: [Char] -> SString
fromString = forall a. SymVal a => a -> SBV a
literal

------------------------------------------------------------------------------------
-- * Smart constructors for creating symbolic values. These are not strictly
-- necessary, as they are mere aliases for 'symbolic' and 'symbolics', but
-- they nonetheless make programming easier.
------------------------------------------------------------------------------------

-- | Generalization of 'Data.SBV.sBool'
sBool :: MonadSymbolic m => String -> m SBool
sBool :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SBool
sBool = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sBool_'
sBool_ :: MonadSymbolic m => m SBool
sBool_ :: forall (m :: * -> *). MonadSymbolic m => m SBool
sBool_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sBools'
sBools :: MonadSymbolic m => [String] -> m [SBool]
sBools :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SBool]
sBools = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sWord8'
sWord8 :: MonadSymbolic m => String -> m SWord8
sWord8 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SWord8
sWord8 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sWord8_'
sWord8_ :: MonadSymbolic m => m SWord8
sWord8_ :: forall (m :: * -> *). MonadSymbolic m => m SWord8
sWord8_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sWord8s'
sWord8s :: MonadSymbolic m => [String] -> m [SWord8]
sWord8s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SWord8]
sWord8s = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sWord16'
sWord16 :: MonadSymbolic m => String -> m SWord16
sWord16 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SWord16
sWord16 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sWord16_'
sWord16_ :: MonadSymbolic m => m SWord16
sWord16_ :: forall (m :: * -> *). MonadSymbolic m => m SWord16
sWord16_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sWord16s'
sWord16s :: MonadSymbolic m => [String] -> m [SWord16]
sWord16s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SWord16]
sWord16s = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sWord32'
sWord32 :: MonadSymbolic m => String -> m SWord32
sWord32 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SWord32
sWord32 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sWord32_'
sWord32_ :: MonadSymbolic m => m SWord32
sWord32_ :: forall (m :: * -> *). MonadSymbolic m => m SWord32
sWord32_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sWord32s'
sWord32s :: MonadSymbolic m => [String] -> m [SWord32]
sWord32s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SWord32]
sWord32s = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sWord64'
sWord64 :: MonadSymbolic m => String -> m SWord64
sWord64 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SWord64
sWord64 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sWord64_'
sWord64_ :: MonadSymbolic m => m SWord64
sWord64_ :: forall (m :: * -> *). MonadSymbolic m => m SWord64
sWord64_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sWord64s'
sWord64s :: MonadSymbolic m => [String] -> m [SWord64]
sWord64s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SWord64]
sWord64s = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sInt8'
sInt8 :: MonadSymbolic m => String -> m SInt8
sInt8 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInt8
sInt8 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sInt8_'
sInt8_ :: MonadSymbolic m => m SInt8
sInt8_ :: forall (m :: * -> *). MonadSymbolic m => m SInt8
sInt8_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sInt8s'
sInt8s :: MonadSymbolic m => [String] -> m [SInt8]
sInt8s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInt8]
sInt8s = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sInt16'
sInt16 :: MonadSymbolic m => String -> m SInt16
sInt16 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInt16
sInt16 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sInt16_'
sInt16_ :: MonadSymbolic m => m SInt16
sInt16_ :: forall (m :: * -> *). MonadSymbolic m => m SInt16
sInt16_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sInt16s'
sInt16s :: MonadSymbolic m => [String] -> m [SInt16]
sInt16s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInt16]
sInt16s = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sInt32'
sInt32 :: MonadSymbolic m => String -> m SInt32
sInt32 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInt32
sInt32 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sInt32_'
sInt32_ :: MonadSymbolic m => m SInt32
sInt32_ :: forall (m :: * -> *). MonadSymbolic m => m SInt32
sInt32_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sInt32s'
sInt32s :: MonadSymbolic m => [String] -> m [SInt32]
sInt32s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInt32]
sInt32s = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sInt64'
sInt64 :: MonadSymbolic m => String -> m SInt64
sInt64 :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInt64
sInt64 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sInt64_'
sInt64_ :: MonadSymbolic m => m SInt64
sInt64_ :: forall (m :: * -> *). MonadSymbolic m => m SInt64
sInt64_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sInt64s'
sInt64s :: MonadSymbolic m => [String] -> m [SInt64]
sInt64s :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInt64]
sInt64s = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sInteger'
sInteger:: MonadSymbolic m => String -> m SInteger
sInteger :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SInteger
sInteger = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sInteger_'
sInteger_:: MonadSymbolic m => m SInteger
sInteger_ :: forall (m :: * -> *). MonadSymbolic m => m SInteger
sInteger_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sIntegers'
sIntegers :: MonadSymbolic m => [String] -> m [SInteger]
sIntegers :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SInteger]
sIntegers = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sReal'
sReal:: MonadSymbolic m => String -> m SReal
sReal :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SReal
sReal = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sReal_'
sReal_:: MonadSymbolic m => m SReal
sReal_ :: forall (m :: * -> *). MonadSymbolic m => m SReal
sReal_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sReals'
sReals :: MonadSymbolic m => [String] -> m [SReal]
sReals :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SReal]
sReals = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sFloat'
sFloat :: MonadSymbolic m => String -> m SFloat
sFloat :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m (SBV Float)
sFloat = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sFloat_'
sFloat_ :: MonadSymbolic m => m SFloat
sFloat_ :: forall (m :: * -> *). MonadSymbolic m => m (SBV Float)
sFloat_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sFloats'
sFloats :: MonadSymbolic m => [String] -> m [SFloat]
sFloats :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SBV Float]
sFloats = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sDouble'
sDouble :: MonadSymbolic m => String -> m SDouble
sDouble :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m (SBV Double)
sDouble = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sDouble_'
sDouble_ :: MonadSymbolic m => m SDouble
sDouble_ :: forall (m :: * -> *). MonadSymbolic m => m (SBV Double)
sDouble_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sDoubles'
sDoubles :: MonadSymbolic m => [String] -> m [SDouble]
sDoubles :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SBV Double]
sDoubles = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sFPHalf'
sFPHalf :: String -> Symbolic SFPHalf
sFPHalf :: [Char] -> Symbolic SFPHalf
sFPHalf = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sFPHalf_'
sFPHalf_ :: Symbolic SFPHalf
sFPHalf_ :: Symbolic SFPHalf
sFPHalf_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sFPHalfs'
sFPHalfs :: [String] -> Symbolic [SFPHalf]
sFPHalfs :: [[Char]] -> Symbolic [SFPHalf]
sFPHalfs = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sFPBFloat'
sFPBFloat :: String -> Symbolic SFPBFloat
sFPBFloat :: [Char] -> Symbolic SFPBFloat
sFPBFloat = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sFPBFloat_'
sFPBFloat_ :: Symbolic SFPBFloat
sFPBFloat_ :: Symbolic SFPBFloat
sFPBFloat_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sFPBFloats'
sFPBFloats :: [String] -> Symbolic [SFPBFloat]
sFPBFloats :: [[Char]] -> Symbolic [SFPBFloat]
sFPBFloats = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sFPSingle'
sFPSingle :: String -> Symbolic SFPSingle
sFPSingle :: [Char] -> Symbolic SFPSingle
sFPSingle = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sFPSingle_'
sFPSingle_ :: Symbolic SFPSingle
sFPSingle_ :: Symbolic SFPSingle
sFPSingle_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sFPSingles'
sFPSingles :: [String] -> Symbolic [SFPSingle]
sFPSingles :: [[Char]] -> Symbolic [SFPSingle]
sFPSingles = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sFPDouble'
sFPDouble :: String -> Symbolic SFPDouble
sFPDouble :: [Char] -> Symbolic SFPDouble
sFPDouble = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sFPDouble_'
sFPDouble_ :: Symbolic SFPDouble
sFPDouble_ :: Symbolic SFPDouble
sFPDouble_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sFPDoubles'
sFPDoubles :: [String] -> Symbolic [SFPDouble]
sFPDoubles :: [[Char]] -> Symbolic [SFPDouble]
sFPDoubles = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sFPQuad'
sFPQuad :: String -> Symbolic SFPQuad
sFPQuad :: [Char] -> Symbolic SFPQuad
sFPQuad = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sFPQuad_'
sFPQuad_ :: Symbolic SFPQuad
sFPQuad_ :: Symbolic SFPQuad
sFPQuad_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sFPQuads'
sFPQuads :: [String] -> Symbolic [SFPQuad]
sFPQuads :: [[Char]] -> Symbolic [SFPQuad]
sFPQuads = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sFloatingPoint'
sFloatingPoint :: ValidFloat eb sb => String -> Symbolic (SFloatingPoint eb sb)
sFloatingPoint :: forall (eb :: Nat) (sb :: Nat).
ValidFloat eb sb =>
[Char] -> Symbolic (SFloatingPoint eb sb)
sFloatingPoint = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sFloatingPoint_'
sFloatingPoint_ :: ValidFloat eb sb => Symbolic (SFloatingPoint eb sb)
sFloatingPoint_ :: forall (eb :: Nat) (sb :: Nat).
ValidFloat eb sb =>
Symbolic (SFloatingPoint eb sb)
sFloatingPoint_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sFloatingPoints'
sFloatingPoints :: ValidFloat eb sb => [String] -> Symbolic [SFloatingPoint eb sb]
sFloatingPoints :: forall (eb :: Nat) (sb :: Nat).
ValidFloat eb sb =>
[[Char]] -> Symbolic [SFloatingPoint eb sb]
sFloatingPoints = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sChar'
sChar :: MonadSymbolic m => String -> m SChar
sChar :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m (SBV Char)
sChar = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sChar_'
sChar_ :: MonadSymbolic m => m SChar
sChar_ :: forall (m :: * -> *). MonadSymbolic m => m (SBV Char)
sChar_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sChars'
sChars :: MonadSymbolic m => [String] -> m [SChar]
sChars :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SBV Char]
sChars = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sString'
sString :: MonadSymbolic m => String -> m SString
sString :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m SString
sString = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sString_'
sString_ :: MonadSymbolic m => m SString
sString_ :: forall (m :: * -> *). MonadSymbolic m => m SString
sString_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sStrings'
sStrings :: MonadSymbolic m => [String] -> m [SString]
sStrings :: forall (m :: * -> *). MonadSymbolic m => [[Char]] -> m [SString]
sStrings = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sList'
sList :: (SymVal a, MonadSymbolic m) => String -> m (SList a)
sList :: forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SList a)
sList = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sList_'
sList_ :: (SymVal a, MonadSymbolic m) => m (SList a)
sList_ :: forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SList a)
sList_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sLists'
sLists :: (SymVal a, MonadSymbolic m) => [String] -> m [SList a]
sLists :: forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SList a]
sLists = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Identify tuple like things. Note that there are no methods, just instances to control type inference
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)

-- | Generalization of 'Data.SBV.sTuple'
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 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sTuple_'
sTuple_ :: (SymTuple tup, SymVal tup, MonadSymbolic m) => m (SBV tup)
sTuple_ :: forall tup (m :: * -> *).
(SymTuple tup, SymVal tup, MonadSymbolic m) =>
m (SBV tup)
sTuple_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sTuples'
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 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sRational'
sRational :: MonadSymbolic m => String -> m SRational
sRational :: forall (m :: * -> *). MonadSymbolic m => [Char] -> m (SBV Rational)
sRational = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sRational_'
sRational_ :: MonadSymbolic m => m SRational
sRational_ :: forall (m :: * -> *). MonadSymbolic m => m (SBV Rational)
sRational_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sRationals'
sRationals :: MonadSymbolic m => [String] -> m [SRational]
sRationals :: forall (m :: * -> *).
MonadSymbolic m =>
[[Char]] -> m [SBV Rational]
sRationals = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sEither'
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 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sEither_'
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_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sEithers'
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 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sMaybe'
sMaybe :: (SymVal a, MonadSymbolic m) => String -> m (SMaybe a)
sMaybe :: forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SMaybe a)
sMaybe = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sMaybe_'
sMaybe_ :: (SymVal a, MonadSymbolic m) => m (SMaybe a)
sMaybe_ :: forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SMaybe a)
sMaybe_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sMaybes'
sMaybes :: (SymVal a, MonadSymbolic m) => [String] -> m [SMaybe a]
sMaybes :: forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SMaybe a]
sMaybes = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.sSet'
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 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[Char] -> m (SBV a)
symbolic

-- | Generalization of 'Data.SBV.sMaybe_'
sSet_ :: (Ord a, SymVal a, MonadSymbolic m) => m (SSet a)
sSet_ :: forall a (m :: * -> *).
(Ord a, SymVal a, MonadSymbolic m) =>
m (SSet a)
sSet_ = forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
free_

-- | Generalization of 'Data.SBV.sMaybes'
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 = forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[[Char]] -> m [SBV a]
symbolics

-- | Generalization of 'Data.SBV.solve'
solve :: MonadSymbolic m => [SBool] -> m SBool
solve :: forall (m :: * -> *). MonadSymbolic m => [SBool] -> m SBool
solve = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SBool] -> SBool
sAnd

-- | Convert an SReal to an SInteger. That is, it computes the
-- largest integer @n@ that satisfies @sIntegerToSReal n <= r@
-- essentially giving us the @floor@.
--
-- For instance, @1.3@ will be @1@, but @-1.3@ will be @-2@.
sRealToSInteger :: SReal -> SInteger
sRealToSInteger :: SReal -> SInteger
sRealToSInteger SReal
x
  | Just AlgReal
i <- forall a. SymVal a => SBV a -> Maybe a
unliteral SReal
x, AlgReal -> Bool
isExactRational AlgReal
i
  = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Real a => a -> Rational
toRational AlgReal
i)
  | Bool
True
  = forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KUnbounded (forall a b. b -> Either a b
Right (forall a. (State -> IO a) -> Cached a
cache State -> IO SV
y)))
  where y :: State -> IO SV
y State
st = do SV
xsv <- 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: Label the result of an expression. This is essentially a no-op, but useful as it generates a comment in the generated C/SMT-Lib code.
-- Note that if the argument is a constant, then the label is dropped completely, per the usual constant folding strategy. Compare this to 'observe'
-- which is good for printing counter-examples.
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
_ <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x = SBV a
x
   | Bool
True                  = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k    = forall a. HasKind a => a -> Kind
kindOf SBV a
x
        r :: State -> IO SV
r State
st = do SV
xsv <- 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])


-- | Check if an observable name is good.
checkObservableName :: String -> Maybe String
checkObservableName :: [Char] -> Maybe [Char]
checkObservableName [Char]
lbl
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
lbl
  = forall a. a -> Maybe a
Just [Char]
"SBV.observe: Bad empty name!"
  | forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
lbl forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]]
smtLibReservedNames
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.observe: The name chosen is reserved, please change it!: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
lbl
  | [Char]
"s" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
lbl Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit (forall a. Int -> [a] -> [a]
drop Int
1 [Char]
lbl)
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.observe: Names of the form sXXX are internal to SBV, please use a different name: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Char]
lbl
  | Bool
True
  = forall a. Maybe a
Nothing

-- | Observe the value of an expression, if the given condition holds.  Such values are useful in model construction, as they are printed part of a satisfying model, or a
-- counter-example. The same works for quick-check as well. Useful when we want to see intermediate values, or expected/obtained
-- pairs in a particular run. Note that an observed expression is always symbolic, i.e., it won't be constant folded. Compare this to 'label'
-- which is used for putting a label in the generated SMTLib-C code.
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
  = forall a. HasCallStack => [Char] -> a
error [Char]
bad
  | Bool
True
  = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k = forall a. HasKind a => a -> Kind
kindOf SBV a
x
        r :: State -> IO SV
r State
st = do SV
xsv <- 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SymVal a => CV -> a
fromCV) SV
xsv
                  forall (m :: * -> *) a. Monad m => a -> m a
return SV
xsv

-- | Observe the value of an expression, unconditionally. See 'observeIf' for a generalized version.
observe :: SymVal a => String -> SBV a -> SBV a
observe :: forall a. SymVal a => [Char] -> SBV a -> SBV a
observe = forall a. SymVal a => (a -> Bool) -> [Char] -> SBV a -> SBV a
observeIf (forall a b. a -> b -> a
const Bool
True)

-- | A variant of observe that you can use at the top-level. This is useful with quick-check, for instance.
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
  = forall a. HasCallStack => [Char] -> a
error [Char]
bad
  | Bool
True
  = do State
st <- forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
       forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do SV
xsv <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
                   State -> [Char] -> (CV -> Bool) -> SV -> IO ()
recordObservable State
st [Char]
m (forall a b. a -> b -> a
const Bool
True) SV
xsv

-- | Symbolic Equality. Note that we can't use Haskell's 'Eq' class since Haskell insists on returning Bool
-- Comparing symbolic values will necessarily return a symbolic value.
infix 4 .==, ./=, .===, ./==
class EqSymbolic a where
  -- | Symbolic equality.
  (.==) :: a -> a -> SBool
  -- | Symbolic inequality.
  (./=) :: a -> a -> SBool
  -- | Strong equality. On floats ('SFloat'/'SDouble'), strong equality is object equality; that
  -- is @NaN == NaN@ holds, but @+0 == -0@ doesn't. On other types, (.===) is simply (.==).
  -- Note that (.==) is the /right/ notion of equality for floats per IEEE754 specs, since by
  -- definition @+0 == -0@ and @NaN@ equals no other value including itself. But occasionally
  -- we want to be stronger and state @NaN@ equals @NaN@ and @+0@ and @-0@ are different from
  -- each other. In a context where your type is concrete, simply use `Data.SBV.fpIsEqualObject`. But in
  -- a polymorphic context, use the strong equality instead.
  --
  -- NB. If you do not care about or work with floats, simply use (.==) and (./=).
  (.===) :: a -> a -> SBool
  -- | Negation of strong equality. Equaivalent to negation of (.===) on all types.
  (./==) :: a -> a -> SBool

  -- | Returns (symbolic) 'sTrue' if all the elements of the given list are different.
  distinct :: [a] -> SBool

  -- | Returns (symbolic) `sTrue` if all the elements of the given list are different. The second
  -- list contains exceptions, i.e., if an element belongs to that set, it will be considered
  -- distinct regardless of repetition.
  distinctExcept :: [a] -> [a] -> SBool

  -- | Returns (symbolic) 'sTrue' if all the elements of the given list are the same.
  allEqual :: [a] -> SBool

  -- | Symbolic membership test.
  sElem    :: a -> [a] -> SBool

  -- | Symbolic negated membership test.
  sNotElem :: a -> [a] -> SBool

  {-# MINIMAL (.==) #-}

  a
x ./=  a
y = SBool -> SBool
sNot (a
x forall a. EqSymbolic a => a -> a -> SBool
.==  a
y)
  a
x .=== a
y = a
x forall a. EqSymbolic a => a -> a -> SBool
.== a
y
  a
x ./== a
y = SBool -> SBool
sNot (a
x forall a. EqSymbolic a => a -> a -> SBool
.=== a
y)

  allEqual []     = SBool
sTrue
  allEqual (a
x:[a]
xs) = forall a. (a -> SBool) -> [a] -> SBool
sAll (a
x forall a. EqSymbolic a => a -> a -> SBool
.==) [a]
xs

  -- Default implementation of distinct. Note that we override
  -- this method for the base types to generate better code.
  distinct []     = SBool
sTrue
  distinct (a
x:[a]
xs) = forall a. (a -> SBool) -> [a] -> SBool
sAll (a
x forall a. EqSymbolic a => a -> a -> SBool
./=) [a]
xs SBool -> SBool -> SBool
.&& forall a. EqSymbolic a => [a] -> SBool
distinct [a]
xs

  -- Default implementation of distinctExcept. Note that we override
  -- this method for the base types to generate better code.
  distinctExcept [a]
es [a]
ignored = [a] -> SBool
go [a]
es
    where isIgnored :: a -> SBool
isIgnored = (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
.|| forall a. (a -> SBool) -> [a] -> SBool
sAll (\a
y -> a -> SBool
isIgnored a
y SBool -> SBool -> SBool
.|| a
x 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 = forall a. (a -> SBool) -> [a] -> SBool
sAny (forall a. EqSymbolic a => a -> a -> SBool
.== a
x) [a]
xs
  a
x `sNotElem` [a]
xs = SBool -> SBool
sNot (a
x forall a. EqSymbolic a => a -> [a] -> SBool
`sElem` [a]
xs)

-- | Symbolic Comparisons. Similar to 'Eq', we cannot implement Haskell's 'Ord' class
-- since there is no way to return an 'Ordering' value from a symbolic comparison.
-- Furthermore, 'OrdSymbolic' requires 'Mergeable' to implement if-then-else, for the
-- benefit of implementing symbolic versions of 'max' and 'min' functions.
infix 4 .<, .<=, .>, .>=
class (Mergeable a, EqSymbolic a) => OrdSymbolic a where
  -- | Symbolic less than.
  (.<)  :: a -> a -> SBool
  -- | Symbolic less than or equal to.
  (.<=) :: a -> a -> SBool
  -- | Symbolic greater than.
  (.>)  :: a -> a -> SBool
  -- | Symbolic greater than or equal to.
  (.>=) :: a -> a -> SBool
  -- | Symbolic minimum.
  smin  :: a -> a -> a
  -- | Symbolic maximum.
  smax  :: a -> a -> a
  -- | Is the value within the allowed /inclusive/ range?
  inRange    :: a -> (a, a) -> SBool

  {-# MINIMAL (.<) #-}

  a
a .<= a
b    = a
a forall a. OrdSymbolic a => a -> a -> SBool
.< a
b SBool -> SBool -> SBool
.|| a
a forall a. EqSymbolic a => a -> a -> SBool
.== a
b
  a
a .>  a
b    = a
b forall a. OrdSymbolic a => a -> a -> SBool
.<  a
a
  a
a .>= a
b    = a
b forall a. OrdSymbolic a => a -> a -> SBool
.<= a
a

  a
a `smin` a
b = forall a. Mergeable a => SBool -> a -> a -> a
ite (a
a forall a. OrdSymbolic a => a -> a -> SBool
.<= a
b) a
a a
b
  a
a `smax` a
b = forall a. Mergeable a => SBool -> a -> a -> a
ite (a
a forall a. OrdSymbolic a => a -> a -> SBool
.<= a
b) a
b a
a

  inRange a
x (a
y, a
z) = a
x forall a. OrdSymbolic a => a -> a -> SBool
.>= a
y SBool -> SBool -> SBool
.&& a
x forall a. OrdSymbolic a => a -> a -> SBool
.<= a
z


{- We can't have a generic instance of the form:

instance Eq a => EqSymbolic a where
  x .== y = if x == y then true else sFalse

even if we're willing to allow Flexible/undecidable instances..
This is because if we allow this it would imply EqSymbolic (SBV a);
since (SBV a) has to be Eq as it must be a Num. But this wouldn't be
the right choice obviously; as the Eq instance is bogus for SBV
for natural reasons..
-}

-- It is tempting to put in an @Eq a@ superclass here. But doing so
-- is complicated, as it requires all underlying types to have equality,
-- which is at best shaky for algebraic reals and sets. So, leave it out.
instance EqSymbolic (SBV a) where
  SBV SVal
x .== :: SBV a -> SBV a -> SBool
.== SBV SVal
y = 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 = 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 = forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svStrongEqual SVal
x SVal
y)

  -- Custom version of distinct that generates better code for base types
  distinct :: [SBV a] -> SBool
distinct []                                             = SBool
sTrue
  distinct [SBV a
_]                                            = SBool
sTrue
  distinct [SBV a]
xs | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {a}. SBV a -> Bool
isConc [SBV a]
xs                             = 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  = forall a. SVal -> SBV a
SBV 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  = forall a. SVal -> SBV a
SBV 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 = 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 = forall a. SVal -> SBV a
SBV SVal
a
              | forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBV a]
xs forall a. Ord a => a -> a -> Bool
> Int
2 Bool -> Bool -> Bool
&& forall {a}. SBV a -> Bool
isBool (forall a. [a] -> a
head [SBV a]
xs)         = SBool
sFalse
              | Bool
True                                      = forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (forall a b. b -> Either a b
Right (forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
    where r :: State -> IO SV
r State
st = do [SV]
xsv <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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)

          -- We call this in case all are concrete, which will
          -- reduce to a constant and generate no code at all!
          -- Note that this is essentially the same as the default
          -- definition, which unfortunately we can no longer call!
          checkDiff :: [a] -> SBool
checkDiff []     = SBool
sTrue
          checkDiff (a
a:[a]
as) = forall a. (a -> SBool) -> [a] -> SBool
sAll (a
a forall a. EqSymbolic a => a -> a -> SBool
./=) [a]
as SBool -> SBool -> SBool
.&& [a] -> SBool
checkDiff [a]
as

          -- Sigh, we can't use isConcrete since that requires SymVal
          -- constraint that we don't have here. (To support SBools.)
          isConc :: SBV a -> Bool
isConc (SBV (SVal Kind
_ (Left CV
_))) = Bool
True
          isConc SBV a
_                       = Bool
False

          -- Likewise here; need to go lower.
          SVal Kind
k1 (Left CV
c1) is :: SVal -> SVal -> Bool
`is` SVal Kind
k2 (Left CV
c2) = (Kind
k1, CV
c1) 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

  -- Custom version of distinctExcept that generates better code for base types
  -- We essentially keep track of an array and count cardinalities as we walk along.
  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
     | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {a}. SBV a -> Bool
isConc ([SBV a]
es forall a. [a] -> [a] -> [a]
++ [SBV a]
ignored)
    = forall a. EqSymbolic a => [a] -> SBool
distinct (forall a. (a -> Bool) -> [a] -> [a]
filter SBV a -> Bool
ignoreConc [SBV a]
es)
    | Bool
True
    = forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (forall a b. b -> Either a b
Right (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 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
_                          -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"distinctExcept: Impossible happened, concrete sElem failed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show ([SBV a]
es, [SBV a]
ignored, SBV a
x)

          ek :: Kind
ek = case forall a. [a] -> a
head [SBV a]
es of  -- Head is safe here as we're guaranteed to have a non-empty es by pattern matching above. (Actually, there'll be at least two elements)
                 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 <- forall a b. SArr -> SArray a b
SArray 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_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
i) (forall a. a -> Maybe a
Just (forall a. SBV a -> SVal
unSBV SInteger
zero))

                    let incr :: SBV a -> SArray a Integer -> SInteger
incr SBV a
x SArray a Integer
table = forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
x forall a. EqSymbolic a => a -> [a] -> SBool
`sElem` [SBV a]
ignored) SInteger
zero (SInteger
1 forall a. Num a => a -> a -> a
+ 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\SArray a Integer
table SBV a
x -> 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

                    forall a. State -> SBV a -> IO SV
sbvToSV State
st forall a b. (a -> b) -> a -> b
$ forall a. (a -> SBool) -> [a] -> SBool
sAll (\SBV a
e -> forall (array :: * -> * -> *) a b.
SymArray array =>
array a b -> SBV a -> SBV b
readArray SArray a Integer
finalArray SBV a
e forall a. OrdSymbolic a => a -> a -> SBool
.<= SInteger
1) [SBV a]
es

          -- Sigh, we can't use isConcrete since that requires SymVal
          -- constraint that we don't have here. (To support SBools.)
          isConc :: SBV a -> Bool
isConc (SBV (SVal Kind
_ (Left CV
_))) = Bool
True
          isConc SBV a
_                       = Bool
False

-- | If comparison is over something SMTLib can handle, just translate it. Otherwise desugar.
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) | forall a. (SymVal a, HasKind a) => [Char] -> SBV a -> SBV a -> Bool
smtComparable [Char]
"<"   SBV a
a SBV a
b = forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svLessThan SVal
x SVal
y)
                          | Bool
True                    = 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) | forall a. (SymVal a, HasKind a) => [Char] -> SBV a -> SBV a -> Bool
smtComparable [Char]
".<=" SBV a
a SBV a
b = forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svLessEq SVal
x SVal
y)
                          | Bool
True                    = SBV a
a forall a. OrdSymbolic a => a -> a -> SBool
.< SBV a
b SBool -> SBool -> SBool
.|| SBV a
a 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) | forall a. (SymVal a, HasKind a) => [Char] -> SBV a -> SBV a -> Bool
smtComparable [Char]
">"   SBV a
a SBV a
b = forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svGreaterThan SVal
x SVal
y)
                          | Bool
True                    = SBV a
b 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) | forall a. (SymVal a, HasKind a) => [Char] -> SBV a -> SBV a -> Bool
smtComparable [Char]
">="  SBV a
a SBV a
b = forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svGreaterEq SVal
x SVal
y)
                          | Bool
True                    = SBV a
b forall a. OrdSymbolic a => a -> a -> SBool
.<= SBV a
a

-- Is this a type that's comparable by underlying translation to SMTLib?
-- Note that we allow concrete versions to go through unless the type is a set, as there's really no reason not to.
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
  | forall a. SymVal a => SBV a -> Bool
isConcrete SBV a
x Bool -> Bool -> Bool
&& forall a. SymVal a => SBV a -> Bool
isConcrete SBV a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (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     -- Unfortunately, no way for us to desugar this
      KSet       {} -> Bool
nope     -- Ditto here..
      KTuple     {} -> Bool
False
      KMaybe     {} -> Bool
False
      KEither    {} -> Bool
False
 where k :: Kind
k    = forall a. HasKind a => a -> Kind
kindOf SBV a
x
       nope :: Bool
nope = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Data.SBV.OrdSymbolic: SMTLib does not support " forall a. [a] -> [a] -> [a]
++ [Char]
op forall a. [a] -> [a] -> [a]
++ [Char]
" for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k

-- Bool
instance EqSymbolic Bool where
  Bool
x .== :: Bool -> Bool -> SBool
.== Bool
y = Bool -> SBool
fromBool forall a b. (a -> b) -> a -> b
$ Bool
x forall a. Eq a => a -> a -> Bool
== Bool
y

-- Lists
instance EqSymbolic a => EqSymbolic [a] where
  []     .== :: [a] -> [a] -> SBool
.== []     = SBool
sTrue
  (a
x:[a]
xs) .== (a
y:[a]
ys) = a
x forall a. EqSymbolic a => a -> a -> SBool
.== a
y SBool -> SBool -> SBool
.&& [a]
xs 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 forall a. OrdSymbolic a => a -> a -> SBool
.< a
y SBool -> SBool -> SBool
.|| (a
x forall a. EqSymbolic a => a -> a -> SBool
.== a
y SBool -> SBool -> SBool
.&& [a]
xs forall a. OrdSymbolic a => a -> a -> SBool
.< [a]
ys)

-- Maybe
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 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 forall a. OrdSymbolic a => a -> a -> SBool
.< a
b

-- Either
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 forall a. EqSymbolic a => a -> a -> SBool
.== a
b
  Right b
a .== Right b
b = b
a 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 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 forall a. OrdSymbolic a => a -> a -> SBool
.< b
b

-- 2-Tuple
instance (EqSymbolic a, EqSymbolic b) => EqSymbolic (a, b) where
  (a
a0, b
b0) .== :: (a, b) -> (a, b) -> SBool
.== (a
a1, b
b1) = a
a0 forall a. EqSymbolic a => a -> a -> SBool
.== a
a1 SBool -> SBool -> SBool
.&& b
b0 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 forall a. OrdSymbolic a => a -> a -> SBool
.< a
a1 SBool -> SBool -> SBool
.|| (a
a0 forall a. EqSymbolic a => a -> a -> SBool
.== a
a1 SBool -> SBool -> SBool
.&& b
b0 forall a. OrdSymbolic a => a -> a -> SBool
.< b
b1)

-- 3-Tuple
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) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1) SBool -> SBool -> SBool
.&& c
c0 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) forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1) SBool -> SBool -> SBool
.|| ((a
a0, b
b0) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1) SBool -> SBool -> SBool
.&& c
c0 forall a. OrdSymbolic a => a -> a -> SBool
.< c
c1)

-- 4-Tuple
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) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1) SBool -> SBool -> SBool
.&& d
d0 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) forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1, c
c1) SBool -> SBool -> SBool
.|| ((a
a0, b
b0, c
c0) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1) SBool -> SBool -> SBool
.&& d
d0 forall a. OrdSymbolic a => a -> a -> SBool
.< d
d1)

-- 5-Tuple
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) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1) SBool -> SBool -> SBool
.&& e
e0 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) 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) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1) SBool -> SBool -> SBool
.&& e
e0 forall a. OrdSymbolic a => a -> a -> SBool
.< e
e1)

-- 6-Tuple
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) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1) SBool -> SBool -> SBool
.&& f
f0 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) 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) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1) SBool -> SBool -> SBool
.&& f
f0 forall a. OrdSymbolic a => a -> a -> SBool
.< f
f1)

-- 7-Tuple
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) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) SBool -> SBool -> SBool
.&& g
g0 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) 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) forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) SBool -> SBool -> SBool
.&& g
g0 forall a. OrdSymbolic a => a -> a -> SBool
.< g
g1)

-- | Regular expressions can be compared for equality. Note that we diverge here from the equality
-- in the concrete sense; i.e., the Eq instance does not match the symbolic case. This is a bit unfortunate,
-- but unavoidable with the current design of how we "distinguish" operators. Hopefully shouldn't be a big deal,
-- though one should be careful.
instance EqSymbolic RegExp where
  RegExp
r1 .== :: RegExp -> RegExp -> SBool
.== RegExp
r2 = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
    where r :: State -> IO SV
r State
st = State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (RegExOp -> Op
RegExOp (RegExp -> RegExp -> RegExOp
RegExEq RegExp
r1 RegExp
r2))  []

  RegExp
r1 ./= :: RegExp -> RegExp -> SBool
./= RegExp
r2 = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
    where r :: State -> IO SV
r State
st = State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (RegExOp -> Op
RegExOp (RegExp -> RegExp -> RegExOp
RegExNEq RegExp
r1 RegExp
r2)) []

-- | Symbolic Numbers. This is a simple class that simply incorporates all number like
-- base types together, simplifying writing polymorphic type-signatures that work for all
-- symbolic numbers, such as 'SWord8', 'SInt8' etc. For instance, we can write a generic
-- list-minimum function as follows:
--
-- @
--    mm :: SIntegral a => [SBV a] -> SBV a
--    mm = foldr1 (\a b -> ite (a .<= b) a b)
-- @
--
-- It is similar to the standard 'Integral' class, except ranging over symbolic instances.
class (SymVal a, Num a, Bits a, Integral a) => SIntegral a

-- 'SIntegral' Instances, skips Real/Float/Bool
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

-- | Finite bit-length symbolic values. Essentially the same as 'SIntegral', but further leaves out 'Integer'. Loosely
-- based on Haskell's @FiniteBits@ class, but with more methods defined and structured differently to fit into the
-- symbolic world view. Minimal complete definition: 'sFiniteBitSize'.
class (Ord a, SymVal a, Num a, Bits a) => SFiniteBits a where
    -- | Bit size.
    sFiniteBitSize      :: SBV a -> Int
    -- | Least significant bit of a word, always stored at index 0.
    lsb                 :: SBV a -> SBool
    -- | Most significant bit of a word, always stored at the last position.
    msb                 :: SBV a -> SBool
    -- | Big-endian blasting of a word into its bits.
    blastBE             :: SBV a -> [SBool]
    -- | Little-endian blasting of a word into its bits.
    blastLE             :: SBV a -> [SBool]
    -- | Reconstruct from given bits, given in little-endian.
    fromBitsBE          :: [SBool] -> SBV a
    -- | Reconstruct from given bits, given in little-endian.
    fromBitsLE          :: [SBool] -> SBV a
    -- | Replacement for 'testBit', returning 'SBool' instead of 'Bool'.
    sTestBit            :: SBV a -> Int -> SBool
    -- | Variant of 'sTestBit', where we want to extract multiple bit positions.
    sExtractBits        :: SBV a -> [Int] -> [SBool]
    -- | Variant of 'popCount', returning a symbolic value.
    sPopCount           :: SBV a -> SWord8
    -- | A combo of 'setBit' and 'clearBit', when the bit to be set is symbolic.
    setBitTo            :: SBV a -> Int -> SBool -> SBV a
    -- | Full adder, returns carry-out from the addition. Only for unsigned quantities.
    fullAdder           :: SBV a -> SBV a -> (SBool, SBV a)
    -- | Full multiplier, returns both high and low-order bits. Only for unsigned quantities.
    fullMultiplier      :: SBV a -> SBV a -> (SBV a, SBV a)
    -- | Count leading zeros in a word, big-endian interpretation.
    sCountLeadingZeros  :: SBV a -> SWord8
    -- | Count trailing zeros in a word, big-endian interpretation.
    sCountTrailingZeros :: SBV a -> SWord8

    {-# MINIMAL sFiniteBitSize #-}

    -- Default implementations
    lsb (SBV SVal
v) = forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svTestBit SVal
v Int
0)
    msb SBV a
x       = forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x (forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
x forall a. Num a => a -> a -> a
- Int
1)

    blastBE   = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. SFiniteBits a => SBV a -> [SBool]
blastLE
    blastLE SBV a
x = forall a b. (a -> b) -> [a] -> [b]
map (forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x) [Int
0 .. forall a. HasKind a => a -> Int
intSizeOf SBV a
x forall a. Num a => a -> a -> a
- Int
1]

    fromBitsBE = forall a. SFiniteBits a => [SBool] -> SBV a
fromBitsLE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
    fromBitsLE [SBool]
bs
       | forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBool]
bs forall a. Eq a => a -> a -> Bool
/= Int
w
       = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.SFiniteBits.fromBitsLE/BE: Expected: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
w forall a. [a] -> [a] -> [a]
++ [Char]
" bits, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBool]
bs)
       | Bool
True
       = SBV a
result
       where w :: Int
w = forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
result
             result :: SBV a
result = 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 (forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
x (forall a. Bits a => a -> Int -> a
setBit t
acc Int
i) t
acc) (Int
iforall a. Num a => a -> a -> a
+Int
1) [SBool]
xs

    sTestBit (SBV SVal
x) Int
i = forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svTestBit SVal
x Int
i)
    sExtractBits SBV a
x     = forall a b. (a -> b) -> [a] -> [b]
map (forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x)

    -- NB. 'sPopCount' returns an 'SWord8', which can overflow when used on quantities that have
    -- more than 255 bits. For the regular interface, this suffices for all types we support.
    -- For the Dynamic interface, if we ever implement this, this will fail for bit-vectors
    -- larger than that many bits. The alternative would be to return SInteger here, but that
    -- seems a total overkill for most use cases. If such is required, users are encouraged
    -- to define their own variants, which is rather easy.
    sPopCount SBV a
x
      | Just a
v <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x = forall {t} {t}. (Num t, Num t, Bits t) => t -> t -> t
go SWord8
0 a
v
      | Bool
True                  = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
b SWord8
1 SWord8
0 | SBool
b <- forall a. SFiniteBits a => SBV a -> [SBool]
blastLE SBV a
x]
      where -- concrete case
            go :: t -> t -> t
go !t
c t
0 = t
c
            go !t
c t
w = t -> t -> t
go (t
cforall a. Num a => a -> a -> a
+t
1) (t
w forall a. Bits a => a -> a -> a
.&. (t
wforall a. Num a => a -> a -> a
-t
1))

    setBitTo SBV a
x Int
i SBool
b = forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
b (forall a. Bits a => a -> Int -> a
setBit SBV a
x Int
i) (forall a. Bits a => a -> Int -> a
clearBit SBV a
x Int
i)

    fullAdder SBV a
a SBV a
b
      | forall a. Bits a => a -> Bool
isSigned SBV a
a = forall a. HasCallStack => [Char] -> a
error [Char]
"fullAdder: only works on unsigned numbers"
      | Bool
True       = (SBV a
a forall a. OrdSymbolic a => a -> a -> SBool
.> SBV a
s SBool -> SBool -> SBool
.|| SBV a
b forall a. OrdSymbolic a => a -> a -> SBool
.> SBV a
s, SBV a
s)
      where s :: SBV a
s = SBV a
a forall a. Num a => a -> a -> a
+ SBV a
b

    -- N.B. The higher-order bits are determined using a simple shift-add multiplier,
    -- thus involving bit-blasting. It'd be naive to expect SMT solvers to deal efficiently
    -- with properties involving this function, at least with the current state of the art.
    fullMultiplier SBV a
a SBV a
b
      | forall a. Bits a => a -> Bool
isSigned SBV a
a = forall a. HasCallStack => [Char] -> a
error [Char]
"fullMultiplier: only works on unsigned numbers"
      | Bool
True       = (Int -> SBV a -> SBV a -> SBV a
go (forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
a) SBV a
0 SBV a
a, SBV a
aforall 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')  = forall a. Mergeable a => SBool -> a -> a -> a
ite (forall a. SFiniteBits a => SBV a -> SBool
lsb SBV a
x) (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'') = forall {a}. SFiniteBits a => SBool -> SBV a -> (SBool, SBV a)
shiftIn SBool
c SBV a
p'
                           (SBool
_, SBV a
x')  = 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
nforall 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 = (forall a. SFiniteBits a => SBV a -> SBool
lsb SBV a
v, SBV a
mask forall a. Bits a => a -> a -> a
.|. (SBV a
v forall a. Bits a => a -> Int -> a
`shiftR` Int
1))
               where mask :: SBV a
mask = forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
k (forall a. Bits a => Int -> a
bit (forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
v forall a. Num a => a -> a -> a
- Int
1)) SBV a
0

    -- See the note for 'sPopCount' for a comment on why we return 'SWord8'
    sCountLeadingZeros SBV a
x = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m forall a. Num a => a -> a -> a
- Int -> SWord8
go Int
m
      where m :: Int
m = forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
x forall a. Num a => a -> a -> a
- Int
1

            -- NB. When i is 0 below, which happens when x is 0 as we count all the way down,
            -- we return -1, which is equal to 2^n-1, giving us: n-1-(2^n-1) = n-2^n = n, as required, i.e., the bit-size.
            go :: Int -> SWord8
            go :: Int -> SWord8
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
< Int
0 = SWord8
i8
                 | Bool
True  = forall a. Mergeable a => SBool -> a -> a -> a
ite (forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x Int
i) SWord8
i8 (Int -> SWord8
go (Int
iforall a. Num a => a -> a -> a
-Int
1))
               where i8 :: SWord8
i8 = forall a. SymVal a => a -> SBV a
literal (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word8)

    -- See the note for 'sPopCount' for a comment on why we return 'SWord8'
    sCountTrailingZeros SBV a
x = Int -> SWord8
go Int
0
       where m :: Int
m = forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
x

             go :: Int -> SWord8
             go :: Int -> SWord8
go Int
i | Int
i forall a. Ord a => a -> a -> Bool
>= Int
m = SWord8
i8
                  | Bool
True   = forall a. Mergeable a => SBool -> a -> a -> a
ite (forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x Int
i) SWord8
i8 (Int -> SWord8
go (Int
iforall a. Num a => a -> a -> a
+Int
1))
                where i8 :: SWord8
i8 = forall a. SymVal a => a -> SBV a
literal (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i :: Word8)

-- 'SFiniteBits' Instances, skips Real/Float/Bool/Integer
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

-- | Returns 1 if the boolean is 'sTrue', otherwise 0.
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 = forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
t SBV a
1 SBV a
0

-- | Lift a pseudo-boolean op, performing checks
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
  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV." forall a. [a] -> [a] -> [a]
++ [Char]
w forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char]
e
  | Bool
True
  = SBool
result
  where check :: PBOp -> Maybe [Char]
check (PB_AtMost  Int
k) = forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k
        check (PB_AtLeast Int
k) = forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k
        check (PB_Exactly Int
k) = forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k
        check (PB_Le [Int]
cs   Int
k) = forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k 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) = forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k 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) = forall {a}. (Ord a, Num a, Show a) => a -> Maybe [Char]
pos Int
k 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 forall a. Ord a => a -> a -> Bool
< a
0 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"comparison value must be positive, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
k
          | Bool
True  = forall a. Maybe a
Nothing

        match :: [Int] -> Maybe [Char]
match [Int]
cs
          | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Ord a => a -> a -> Bool
< Int
0) [Int]
cs = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"coefficients must be non-negative. Received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show [Int]
cs
          | Int
lxs forall a. Eq a => a -> a -> Bool
/= Int
lcs   = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Char]
"coefficient length must match number of arguments. Received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
lcs, Int
lxs)
          | Bool
True         = forall a. Maybe a
Nothing
          where lxs :: Int
lxs = forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBool]
xs
                lcs :: Int
lcs = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
cs

        result :: SBool
result = forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (forall a b. b -> Either a b
Right (forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
        r :: State -> IO SV
r State
st   = do [SV]
xsv <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. State -> SBV a -> IO SV
sbvToSV State
st) [SBool]
xs
                    -- PseudoBoolean's implicitly require support for integers, so make sure to register that kind!
                    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)

-- | 'sTrue' if at most @k@ of the input arguments are 'sTrue'
pbAtMost :: [SBool] -> Int -> SBool
pbAtMost :: [SBool] -> Int -> SBool
pbAtMost [SBool]
xs Int
k
 | Int
k forall a. Ord a => a -> a -> Bool
< Int
0             = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbAtMost: Non-negative value required, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
k
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. SymVal a => SBV a -> Bool
isConcrete [SBool]
xs = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int -> SBool -> Integer
pbToInteger [Char]
"pbAtMost" Int
1) [SBool]
xs) forall a. Ord a => a -> a -> Bool
<= 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

-- | 'sTrue' if at least @k@ of the input arguments are 'sTrue'
pbAtLeast :: [SBool] -> Int -> SBool
pbAtLeast :: [SBool] -> Int -> SBool
pbAtLeast [SBool]
xs Int
k
 | Int
k forall a. Ord a => a -> a -> Bool
< Int
0             = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbAtLeast: Non-negative value required, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
k
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. SymVal a => SBV a -> Bool
isConcrete [SBool]
xs = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int -> SBool -> Integer
pbToInteger [Char]
"pbAtLeast" Int
1) [SBool]
xs) forall a. Ord a => a -> a -> Bool
>= 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

-- | 'sTrue' if exactly @k@ of the input arguments are 'sTrue'
pbExactly :: [SBool] -> Int -> SBool
pbExactly :: [SBool] -> Int -> SBool
pbExactly [SBool]
xs Int
k
 | Int
k forall a. Ord a => a -> a -> Bool
< Int
0             = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbExactly: Non-negative value required, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
k
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. SymVal a => SBV a -> Bool
isConcrete [SBool]
xs = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int -> SBool -> Integer
pbToInteger [Char]
"pbExactly" Int
1) [SBool]
xs) forall a. Eq a => a -> a -> Bool
== 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

-- | 'sTrue' if the sum of coefficients for 'sTrue' elements is at most @k@. Generalizes 'pbAtMost'.
pbLe :: [(Int, SBool)] -> Int -> SBool
pbLe :: [(Int, SBool)] -> Int -> SBool
pbLe [(Int, SBool)]
xs Int
k
 | Int
k forall a. Ord a => a -> a -> Bool
< Int
0                     = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbLe: Non-negative value required, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
k
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. SymVal a => SBV a -> Bool
isConcrete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, SBool)]
xs = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ 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] forall a. Ord a => a -> a -> Bool
<= 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 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, SBool)]
xs) Int
k) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, SBool)]
xs)

-- | 'sTrue' if the sum of coefficients for 'sTrue' elements is at least @k@. Generalizes 'pbAtLeast'.
pbGe :: [(Int, SBool)] -> Int -> SBool
pbGe :: [(Int, SBool)] -> Int -> SBool
pbGe [(Int, SBool)]
xs Int
k
 | Int
k forall a. Ord a => a -> a -> Bool
< Int
0                     = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbGe: Non-negative value required, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
k
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. SymVal a => SBV a -> Bool
isConcrete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, SBool)]
xs = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ 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] forall a. Ord a => a -> a -> Bool
>= 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 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, SBool)]
xs) Int
k) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, SBool)]
xs)

-- | 'sTrue' if the sum of coefficients for 'sTrue' elements is exactly least @k@. Useful for coding
-- /exactly K-of-N/ constraints, and in particular mutex constraints.
pbEq :: [(Int, SBool)] -> Int -> SBool
pbEq :: [(Int, SBool)] -> Int -> SBool
pbEq [(Int, SBool)]
xs Int
k
 | Int
k forall a. Ord a => a -> a -> Bool
< Int
0                     = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbEq: Non-negative value required, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
k
 | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. SymVal a => SBV a -> Bool
isConcrete forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(Int, SBool)]
xs = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ 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] forall a. Eq a => a -> a -> Bool
== 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 (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Int, SBool)]
xs) Int
k) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(Int, SBool)]
xs)

-- | 'sTrue' if there is at most one set bit
pbMutexed :: [SBool] -> SBool
pbMutexed :: [SBool] -> SBool
pbMutexed [SBool]
xs = [SBool] -> Int -> SBool
pbAtMost [SBool]
xs Int
1

-- | 'sTrue' if there is exactly one set bit
pbStronglyMutexed :: [SBool] -> SBool
pbStronglyMutexed :: [SBool] -> SBool
pbStronglyMutexed [SBool]
xs = [SBool] -> Int -> SBool
pbExactly [SBool]
xs Int
1

-- | Convert a concrete pseudo-boolean to given int; converting to integer
pbToInteger :: String -> Int -> SBool -> Integer
pbToInteger :: [Char] -> Int -> SBool -> Integer
pbToInteger [Char]
w Int
c SBool
b
 | Int
c forall a. Ord a => a -> a -> Bool
< Int
0                 = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV." forall a. [a] -> [a] -> [a]
++ [Char]
w forall a. [a] -> [a] -> [a]
++ [Char]
": Non-negative coefficient required, received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
c
 | Just Bool
v <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
b = if Bool
v then forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c else Integer
0
 | Bool
True                  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.pbToInteger: Received a symbolic boolean: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
c, SBool
b)

-- | Predicate for optimizing word operations like (+) and (*).
isConcreteZero :: SBV a -> Bool
isConcreteZero :: forall {a}. SBV a -> Bool
isConcreteZero (SBV (SVal Kind
_     (Left (CV Kind
_     (CInteger Integer
n))))) = Integer
n 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 forall a. Eq a => a -> a -> Bool
== AlgReal
0
isConcreteZero SBV a
_                                                 = Bool
False

-- | Predicate for optimizing word operations like (+) and (*).
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 forall a. Eq a => a -> a -> Bool
== AlgReal
1
isConcreteOne SBV a
_                                                 = Bool
False

-- Num instance for symbolic words.
instance (Ord a, Num a, SymVal a) => Num (SBV a) where
  fromInteger :: Integer -> SBV a
fromInteger = forall a. SymVal a => a -> SBV a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
  SBV SVal
x + :: SBV a -> SBV a -> SBV a
+ SBV SVal
y = 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 = 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 = forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svMinus SVal
x SVal
y)
  -- Abs is problematic for floating point, due to -0; case, so we carefully shuttle it down
  -- to the solver to avoid the can of worms. (Alternative would be to do an if-then-else here.)
  abs :: SBV a -> SBV a
abs (SBV SVal
x) = forall a. SVal -> SBV a
SBV (SVal -> SVal
svAbs SVal
x)
  signum :: SBV a -> SBV a
signum SBV a
a
    -- NB. The following "carefully" tests the number for == 0, as Float/Double's NaN and +/-0
    -- cases would cause trouble with explicit equality tests.
    | forall a. HasKind a => a -> Bool
hasSign SBV a
a = forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
a forall a. OrdSymbolic a => a -> a -> SBool
.> SBV a
z) SBV a
i
                forall a b. (a -> b) -> a -> b
$ forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
a forall a. OrdSymbolic a => a -> a -> SBool
.< SBV a
z) (forall a. Num a => a -> a
negate SBV a
i) SBV a
a
    | Bool
True      = forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
a forall a. OrdSymbolic a => a -> a -> SBool
.> SBV a
z) SBV a
i SBV a
a
    where z :: SBV a
z = forall a b. Integral a => Kind -> a -> SBV b
genLiteral (forall a. HasKind a => a -> Kind
kindOf SBV a
a) (Integer
0::Integer)
          i :: SBV a
i = forall a b. Integral a => Kind -> a -> SBV b
genLiteral (forall a. HasKind a => a -> Kind
kindOf SBV a
a) (Integer
1::Integer)
  -- negate is tricky because on double/float -0 is different than 0; so we cannot
  -- just rely on the default definition; which would be 0-0, which is not -0!
  negate :: SBV a -> SBV a
negate (SBV SVal
x) = forall a. SVal -> SBV a
SBV (SVal -> SVal
svUNeg SVal
x)

-- | Symbolic exponentiation using bit blasting and repeated squaring.
--
-- N.B. The exponent must be unsigned/bounded if symbolic. Signed exponents will be rejected.
(.^) :: (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
  | forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
e, Just (Integer
x :: Integer) <- forall a. SymVal a => SBV a -> Maybe a
unliteral (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 forall a. Ord a => a -> a -> Bool
>= Integer
0 then let go :: t -> a -> a
go t
n a
v
                        | t
n forall a. Eq a => a -> a -> Bool
== t
0 = a
1
                        | forall a. Integral a => a -> Bool
even t
n =     t -> a -> a
go (t
n forall a. Integral a => a -> a -> a
`div` t
2) (a
v forall a. Num a => a -> a -> a
* a
v)
                        | Bool
True   = a
v forall a. Num a => a -> a -> a
* t -> a -> a
go (t
n forall a. Integral a => a -> a -> a
`div` t
2) (a
v forall a. Num a => a -> a -> a
* a
v)
                   in  forall {t} {a}. (Num a, Integral t) => t -> a -> a
go Integer
x b
b
              else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"(.^): exponentiation: negative exponent: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
x
  | Bool -> Bool
not (forall a. HasKind a => a -> Bool
isBounded SBV e
e) Bool -> Bool -> Bool
|| forall a. Bits a => a -> Bool
isSigned SBV e
e
  = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"(.^): exponentiation only works with unsigned bounded symbolic exponents, kind: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. HasKind a => a -> Kind
kindOf SBV e
e)
  | Bool
True
  =  -- NB. We can't simply use sTestBit and blastLE since they have SFiniteBit requirement
     -- but we want to have SIntegral here only.
     let SBV SVal
expt = SBV e
e
         expBit :: Int -> SBool
expBit Int
i = forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svTestBit SVal
expt Int
i)
         blasted :: [SBool]
blasted  = forall a b. (a -> b) -> [a] -> [b]
map Int -> SBool
expBit [Int
0 .. forall a. HasKind a => a -> Int
intSizeOf SBV e
e forall a. Num a => a -> a -> a
- Int
1]
     in forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SBool
use b
n -> forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
use b
n b
1)
                          [SBool]
blasted
                          (forall a. (a -> a) -> a -> [a]
iterate (\b
x -> b
xforall 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  = forall a. SymVal a => a -> SBV a
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
sy 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  = forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svDivide SVal
x SVal
y)
             -- Identify those kinds where we have a div-0 equals 0 exception
             div0 :: Bool
div0 = case 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
                      -- Following cases should not happen since these types should *not* be instances of Fractional
                      k :: Kind
k@KBounded{}  -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@Kind
KUnbounded  -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@Kind
KBool       -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@Kind
KString     -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@Kind
KChar       -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@KList{}     -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@KSet{}      -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@KUserSort{} -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@KTuple{}    -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@KMaybe{}    -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k
                      k :: Kind
k@KEither{}   -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unexpected Fractional case for: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Kind
k

-- | Define Floating instance on SBV's; only for base types that are already floating; i.e., 'SFloat', 'SDouble', and 'SReal'.
-- (See the separate definition below for 'SFloatingPoint'.)  Note that unless you use delta-sat via 'Data.SBV.Provers.dReal' on 'SReal', most
-- of the fields are "undefined" for symbolic values. We will add methods as they are supported by SMTLib. Currently, the
-- only symbolically available function in this class is 'sqrt' for 'SFloat', 'SDouble' and 'SFloatingPoint'.
instance (Ord a, SymVal a, Fractional a, Floating a) => Floating (SBV a) where
  pi :: SBV a
pi      = forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$ (forall a. Floating a => a
pi :: Double)
  exp :: SBV a -> SBV a
exp     = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"exp"     forall a. Floating a => a -> a
exp
  log :: SBV a -> SBV a
log     = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"log"     forall a. Floating a => a -> a
log
  sqrt :: SBV a -> SBV a
sqrt    = forall a. SymVal a => FPOp -> (a -> a) -> SBV a -> SBV a
lift1F   FPOp
FP_Sqrt   forall a. Floating a => a -> a
sqrt
  sin :: SBV a -> SBV a
sin     = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"sin"     forall a. Floating a => a -> a
sin
  cos :: SBV a -> SBV a
cos     = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"cos"     forall a. Floating a => a -> a
cos
  tan :: SBV a -> SBV a
tan     = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"tan"     forall a. Floating a => a -> a
tan
  asin :: SBV a -> SBV a
asin    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"asin"    forall a. Floating a => a -> a
asin
  acos :: SBV a -> SBV a
acos    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"acos"    forall a. Floating a => a -> a
acos
  atan :: SBV a -> SBV a
atan    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"atan"    forall a. Floating a => a -> a
atan
  sinh :: SBV a -> SBV a
sinh    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"sinh"    forall a. Floating a => a -> a
sinh
  cosh :: SBV a -> SBV a
cosh    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"cosh"    forall a. Floating a => a -> a
cosh
  tanh :: SBV a -> SBV a
tanh    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"tanh"    forall a. Floating a => a -> a
tanh
  asinh :: SBV a -> SBV a
asinh   = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"asinh"   forall a. Floating a => a -> a
asinh
  acosh :: SBV a -> SBV a
acosh   = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"acosh"   forall a. Floating a => a -> a
acosh
  atanh :: SBV a -> SBV a
atanh   = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"atanh"   forall a. Floating a => a -> a
atanh
  ** :: SBV a -> SBV a -> SBV a
(**)    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS [Char]
"**"      forall a. Floating a => a -> a -> a
(**)
  logBase :: SBV a -> SBV a -> SBV a
logBase = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS [Char]
"logBase" forall a. Floating a => a -> a -> a
logBase

unsupported :: String -> a
unsupported :: forall a. [Char] -> a
unsupported [Char]
w = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Data.SBV.FloatingPoint: Unsupported operation: " forall a. [a] -> [a] -> [a]
++ [Char]
w forall a. [a] -> [a] -> [a]
++ [Char]
". Please request this as a feature!"

-- | We give a specific instance for 'SFloatingPoint', because the underlying floating-point type doesn't support
-- fromRational directly. The overlap with the above instance is unfortunate.
instance {-# OVERLAPPING #-} ValidFloat eb sb => Floating (SFloatingPoint eb sb) where
  -- Try from double; if there's enough precision this'll work, otherwise will bail out.
  pi :: SFloatingPoint eb sb
pi
   | Int
ei forall a. Ord a => a -> a -> Bool
> Int
11 Bool -> Bool -> Bool
|| Int
si forall a. Ord a => a -> a -> Bool
> Int
53 = forall a. [Char] -> a
unsupported forall a b. (a -> b) -> a -> b
$ [Char]
"Floating.SFloatingPoint.pi (not-enough-precision for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
ei, Int
si) forall a. [a] -> [a] -> [a]
++ [Char]
")"
   | Bool
True               = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ forall (eb :: Nat) (sb :: Nat). FP -> FloatingPoint eb sb
FloatingPoint forall a b. (a -> b) -> a -> b
$ Int -> Int -> Rational -> FP
fpFromRational Int
ei Int
si (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a
pi :: Double))
   where ei :: Int
ei = forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
Proxy @eb)
         si :: Int
si = forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
Proxy @sb)

  -- Likewise, exponentiation is again limited to precision of double
  exp :: SFloatingPoint eb sb -> SFloatingPoint eb sb
exp SFloatingPoint eb sb
i
   | Int
ei forall a. Ord a => a -> a -> Bool
> Int
11 Bool -> Bool -> Bool
|| Int
si forall a. Ord a => a -> a -> Bool
> Int
53 = forall a. [Char] -> a
unsupported forall a b. (a -> b) -> a -> b
$ [Char]
"Floating.SFloatingPoint.exp (not-enough-precision for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Int
ei, Int
si) forall a. [a] -> [a] -> [a]
++ [Char]
")"
   | Bool
True               = forall a. SymVal a => a -> SBV a
literal FloatingPoint eb sb
e forall a. Floating a => a -> a -> a
** SFloatingPoint eb sb
i
   where ei :: Int
ei = forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
Proxy @eb)
         si :: Int
si = forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall {k} (t :: k). Proxy t
Proxy @sb)
         e :: FloatingPoint eb sb
e  = forall (eb :: Nat) (sb :: Nat). FP -> FloatingPoint eb sb
FloatingPoint forall a b. (a -> b) -> a -> b
$ Int -> Int -> Rational -> FP
fpFromRational Int
ei Int
si (forall a. Real a => a -> Rational
toRational (forall a. Floating a => a -> a
exp Double
1 :: Double))

  log :: SFloatingPoint eb sb -> SFloatingPoint eb sb
log     = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"log"     forall a. Floating a => a -> a
log
  sqrt :: SFloatingPoint eb sb -> SFloatingPoint eb sb
sqrt    = forall a. SymVal a => FPOp -> (a -> a) -> SBV a -> SBV a
lift1F   FPOp
FP_Sqrt   forall a. Floating a => a -> a
sqrt
  sin :: SFloatingPoint eb sb -> SFloatingPoint eb sb
sin     = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"sin"     forall a. Floating a => a -> a
sin
  cos :: SFloatingPoint eb sb -> SFloatingPoint eb sb
cos     = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"cos"     forall a. Floating a => a -> a
cos
  tan :: SFloatingPoint eb sb -> SFloatingPoint eb sb
tan     = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"tan"     forall a. Floating a => a -> a
tan
  asin :: SFloatingPoint eb sb -> SFloatingPoint eb sb
asin    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"asin"    forall a. Floating a => a -> a
asin
  acos :: SFloatingPoint eb sb -> SFloatingPoint eb sb
acos    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"acos"    forall a. Floating a => a -> a
acos
  atan :: SFloatingPoint eb sb -> SFloatingPoint eb sb
atan    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"atan"    forall a. Floating a => a -> a
atan
  sinh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
sinh    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"sinh"    forall a. Floating a => a -> a
sinh
  cosh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
cosh    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"cosh"    forall a. Floating a => a -> a
cosh
  tanh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
tanh    = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"tanh"    forall a. Floating a => a -> a
tanh
  asinh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
asinh   = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"asinh"   forall a. Floating a => a -> a
asinh
  acosh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
acosh   = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"acosh"   forall a. Floating a => a -> a
acosh
  atanh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
atanh   = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a) -> SBV a -> SBV a
lift1FNS [Char]
"atanh"   forall a. Floating a => a -> a
atanh
  ** :: 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]
"**"      forall a. Floating a => a -> a -> a
(**)
  logBase :: SFloatingPoint eb sb
-> SFloatingPoint eb sb -> SFloatingPoint eb sb
logBase = forall a.
(SymVal a, Floating a) =>
[Char] -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS [Char]
"logBase" forall a. Floating a => a -> a -> a
logBase

-- | Lift a 1 arg FP-op, using sRNE default
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 <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
a
  = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ a -> a
op a
v
  | Bool
True
  = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k    = forall a. HasKind a => a -> Kind
kindOf SBV a
a
        r :: State -> IO SV
r State
st = do SV
swa  <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
a
                  SV
swm  <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SRoundingMode
sRNE
                  State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp (FPOp -> Op
IEEEFP FPOp
w) [SV
swm, SV
swa])

-- | Lift a float/double unary function, only over constants
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 <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
sv = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ a -> a
f a
v
  | Bool
True                   = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV." forall a. [a] -> [a] -> [a]
++ [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
": not supported for symbolic values of type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. HasKind a => a -> Kind
kindOf SBV a
sv)

-- | Lift a float/double binary function, only over constants
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 <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
sv1
  , Just a
v2 <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
sv2 = forall a. SymVal a => a -> SBV a
literal forall a b. (a -> b) -> a -> b
$ a -> a -> a
f a
v1 a
v2
  | Bool
True                     = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV." forall a. [a] -> [a] -> [a]
++ [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
": not supported for symbolic values of type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. HasKind a => a -> Kind
kindOf SBV a
sv1)

-- | SReal Floating instance, used in conjunction with the dReal solver for delta-satisfiability. Note that
-- we do not constant fold these values (except for pi), as Haskell doesn't really have any means of computing
-- them for arbitrary rationals.
instance {-# OVERLAPPING #-} Floating SReal where
  pi :: SReal
pi      = forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational forall a b. (a -> b) -> a -> b
$ (forall a. Floating a => a
pi :: Double)  -- Perhaps not good enough?
  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   = 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   = 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   = 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 = forall a. Floating a => a -> a
log SReal
y  forall a. Fractional a => a -> a -> a
/ forall a. Floating a => a -> a
log SReal
x

-- | Lift an sreal unary function
lift1SReal :: NROp -> SReal -> SReal
lift1SReal :: NROp -> SReal -> SReal
lift1SReal NROp
w SReal
a = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k    = forall a. HasKind a => a -> Kind
kindOf SReal
a
        r :: State -> IO SV
r State
st = do SV
swa <- 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])

-- | Lift an sreal binary function
lift2SReal :: NROp -> SReal -> SReal -> SReal
lift2SReal :: NROp -> SReal -> SReal -> SReal
lift2SReal NROp
w SReal
a SReal
b = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k    = forall a. HasKind a => a -> Kind
kindOf SReal
a
        r :: State -> IO SV
r State
st = do SV
swa <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SReal
a
                  SV
swb <- 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])

-- NB. In the optimizations below, use of -1 is valid as
-- -1 has all bits set to True for both signed and unsigned values
-- | Using 'popCount' or 'testBit' on non-concrete values will result in an
-- error. Use 'sPopCount' or 'sTestBit' instead.
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    = 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    = 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  = forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svXOr SVal
x SVal
y)
  complement :: SBV a -> SBV a
complement (SBV SVal
x) = forall a. SVal -> SBV a
SBV (SVal -> SVal
svNot SVal
x)
  bitSize :: SBV a -> Int
bitSize  SBV a
x         = forall a. HasKind a => a -> Int
intSizeOf SBV a
x
  bitSizeMaybe :: SBV a -> Maybe Int
bitSizeMaybe SBV a
x     = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. HasKind a => a -> Int
intSizeOf SBV a
x
  isSigned :: SBV a -> Bool
isSigned SBV a
x         = forall a. HasKind a => a -> Bool
hasSign SBV a
x
  bit :: Int -> SBV a
bit Int
i              = SBV a
1 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 forall a. Bits a => a -> a -> a
.|. forall a b. Integral a => Kind -> a -> SBV b
genLiteral (forall a. HasKind a => a -> Kind
kindOf SBV a
x) (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 forall a. Bits a => a -> a -> a
.&. forall a b. Integral a => Kind -> a -> SBV b
genLiteral (forall a. HasKind a => a -> Kind
kindOf SBV a
x) (forall a. Bits a => a -> a
complement (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 forall a. Bits a => a -> a -> a
`xor` forall a b. Integral a => Kind -> a -> SBV b
genLiteral (forall a. HasKind a => a -> Kind
kindOf SBV a
x) (forall a. Bits a => Int -> a
bit Int
i :: Integer)
  shiftL :: SBV a -> Int -> SBV a
shiftL  (SBV SVal
x) Int
i  = 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  = 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  = 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  = forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svRor SVal
x Int
i)
  -- NB. testBit is *not* implementable on non-concrete symbolic words
  SBV a
x testBit :: SBV a -> Int -> Bool
`testBit` Int
i
    | SBV (SVal Kind
_ (Left (CV Kind
_ (CInteger Integer
n)))) <- SBV a
x
    = forall a. Bits a => a -> Int -> Bool
testBit Integer
n Int
i
    | Bool
True
    = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.testBit: Called on symbolic value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SBV a
x forall a. [a] -> [a] -> [a]
++ [Char]
". Use sTestBit instead."
  -- NB. popCount is *not* implementable on non-concrete symbolic words
  popCount :: SBV a -> Int
popCount SBV a
x
    | SBV (SVal Kind
_ (Left (CV (KBounded Bool
_ Int
w) (CInteger Integer
n)))) <- SBV a
x
    = forall a. Bits a => a -> Int
popCount (Integer
n forall a. Bits a => a -> a -> a
.&. (forall a. Bits a => Int -> a
bit Int
w forall a. Num a => a -> a -> a
- Integer
1))
    | Bool
True
    = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.popCount: Called on symbolic value: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SBV a
x forall a. [a] -> [a] -> [a]
++ [Char]
". Use sPopCount instead."

-- | Conversion between integral-symbolic values, akin to Haskell's `fromIntegral`
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 forall a. Eq a => a -> a -> Bool
== Kind
kTo
  = forall a. SVal -> SBV a
SBV (forall a. SBV a -> SVal
unSBV SBV a
x)
  | forall a. HasKind a => a -> Bool
isReal SBV a
x
  = forall a. HasCallStack => [Char] -> a
error [Char]
"SBV.sFromIntegral: Called on a real value" -- can't really happen due to types, but being overcautious
  | Just a
v <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x
  = forall a. SymVal a => a -> SBV a
literal (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v)
  | Bool
True
  = SBV b
result
  where result :: SBV b
result = forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
kTo (forall a b. b -> Either a b
Right (forall a. (State -> IO a) -> Cached a
cache State -> IO SV
y)))
        kFrom :: Kind
kFrom  = forall a. HasKind a => a -> Kind
kindOf SBV a
x
        kTo :: Kind
kTo    = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @b)
        y :: State -> IO SV
y State
st   = do SV
xsv <- 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])

-- | Lift a binary operation thru it's dynamic counterpart. Note that
-- we still want the actual functions here as differ in their type
-- compared to their dynamic counterparts, but the implementations
-- are the same.
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) = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ SVal -> SVal -> SVal
f SVal
a SVal
b

-- | Generalization of 'shiftL', when the shift-amount is symbolic. Since Haskell's
-- 'shiftL' only takes an 'Int' as the shift amount, it cannot be used when we have
-- a symbolic amount to shift with.
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 = forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svShiftLeft

-- | Generalization of 'shiftR', when the shift-amount is symbolic. Since Haskell's
-- 'shiftR' only takes an 'Int' as the shift amount, it cannot be used when we have
-- a symbolic amount to shift with.
--
-- NB. If the shiftee is signed, then this is an arithmetic shift; otherwise it's logical,
-- following the usual Haskell convention. See 'sSignedShiftArithRight' for a variant
-- that explicitly uses the msb as the sign bit, even for unsigned underlying types.
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 = forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svShiftRight

-- | Arithmetic shift-right with a symbolic unsigned shift amount. This is equivalent
-- to 'sShiftRight' when the argument is signed. However, if the argument is unsigned,
-- then it explicitly treats its msb as a sign-bit, and uses it as the bit that
-- gets shifted in. Useful when using the underlying unsigned bit representation to implement
-- custom signed operations. Note that there is no direct Haskell analogue of this function.
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
  | forall a. Bits a => a -> Bool
isSigned SBV b
i = forall a. HasCallStack => [Char] -> a
error [Char]
"sSignedShiftArithRight: shift amount should be unsigned"
  | forall a. Bits a => a -> Bool
isSigned SBV a
x = forall {a} {b} {c}. SBV a -> SBV b -> SBV c
ssa SBV a
x SBV b
i
  | Bool
True       = forall a. Mergeable a => SBool -> a -> a -> a
ite (forall a. SFiniteBits a => SBV a -> SBool
msb SBV a
x)
                     (forall a. Bits a => a -> a
complement (forall {a} {b} {c}. SBV a -> SBV b -> SBV c
ssa (forall a. Bits a => a -> a
complement SBV a
x) SBV b
i))
                     (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 = forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svShiftRight

-- | Generalization of 'rotateL', when the shift-amount is symbolic. Since Haskell's
-- 'rotateL' only takes an 'Int' as the shift amount, it cannot be used when we have
-- a symbolic amount to shift with. The first argument should be a bounded quantity.
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 = forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svRotateLeft

-- | An implementation of rotate-left, using a barrel shifter like design. Only works when both
-- arguments are finite bitvectors, and furthermore when the second argument is unsigned.
-- The first condition is enforced by the type, but the second is dynamically checked.
-- We provide this implementation as an alternative to `sRotateLeft` since SMTLib logic
-- does not support variable argument rotates (as opposed to shifts), and thus this
-- implementation can produce better code for verification compared to `sRotateLeft`.
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 = forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svBarrelRotateLeft

-- | Generalization of 'rotateR', when the shift-amount is symbolic. Since Haskell's
-- 'rotateR' only takes an 'Int' as the shift amount, it cannot be used when we have
-- a symbolic amount to shift with. The first argument should be a bounded quantity.
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 = forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svRotateRight

-- | An implementation of rotate-right, using a barrel shifter like design. See comments
-- for `sBarrelRotateLeft` for details.
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 = forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svBarrelRotateRight

-- Enum instance. These instances are suitable for use with concrete values,
-- and will be less useful for symbolic values around. Note that `fromEnum` requires
-- a concrete argument for obvious reasons. Other variants (succ, pred, [x..]) etc are similarly
-- limited. While symbolic variants can be defined for many of these, they will just diverge
-- as final sizes cannot be determined statically.
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 forall a. Eq a => a -> a -> Bool
== (forall a. Bounded a => a
maxBound :: a) = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Enum.succ{" forall a. [a] -> [a] -> [a]
++ forall a. HasKind a => a -> [Char]
showType SBV a
x forall a. [a] -> [a] -> [a]
++ [Char]
"}: tried to take `succ' of maxBound"
    | Bool
True                 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ a
v forall a. Num a => a -> a -> a
+ a
1
    where v :: a
v = 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 forall a. Eq a => a -> a -> Bool
== (forall a. Bounded a => a
minBound :: a) = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Enum.pred{" forall a. [a] -> [a] -> [a]
++ forall a. HasKind a => a -> [Char]
showType SBV a
x forall a. [a] -> [a] -> [a]
++ [Char]
"}: tried to take `pred' of minBound"
    | Bool
True                 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ a
v forall a. Num a => a -> a -> a
- a
1
    where v :: a
v = 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 forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: a) Bool -> Bool -> Bool
|| Integer
xi forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a)
    = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Enum.toEnum{" forall a. [a] -> [a] -> [a]
++ forall a. HasKind a => a -> [Char]
showType SBV a
r forall a. [a] -> [a] -> [a]
++ [Char]
"}: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
x forall a. [a] -> [a] -> [a]
++ [Char]
" is out-of-bounds " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Bounded a => a
minBound :: a, forall a. Bounded a => a
maxBound :: a)
    | Bool
True
    = SBV a
r
    where xi :: Integer
          xi :: Integer
xi = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
          r  :: SBV a
          r :: SBV a
r  = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
  fromEnum :: SBV a -> Int
fromEnum SBV a
x
     | Integer
r forall a. Ord a => a -> a -> Bool
< forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int) Bool -> Bool -> Bool
|| Integer
r forall a. Ord a => a -> a -> Bool
> forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)
     = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Enum.fromEnum{" forall a. [a] -> [a] -> [a]
++ forall a. HasKind a => a -> [Char]
showType SBV a
x forall a. [a] -> [a] -> [a]
++ [Char]
"}:  value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Integer
r forall a. [a] -> [a] -> [a]
++ [Char]
" is outside of Int's bounds " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Bounded a => a
minBound :: Int, forall a. Bounded a => a
maxBound :: Int)
     | Bool
True
     = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
r
    where r :: Integer
          r :: Integer
r = 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer
xi .. forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a)]
     where xi :: Integer
           xi :: Integer
xi = 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 forall a. Ord a => a -> a -> Bool
>= Integer
xi  = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer
xi, Integer
yi .. forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: a)]
     | Bool
True      = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer
xi, Integer
yi .. forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: a)]
       where xi, yi :: Integer
             xi :: Integer
xi = forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFromThen.x" SBV a
x
             yi :: Integer
yi = 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 = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer
xi, Integer
yi .. Integer
zi]
       where xi, yi, zi :: Integer
             xi :: Integer
xi = forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFromThenTo.x" SBV a
x
             yi :: Integer
yi = forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFromThenTo.y" SBV a
y
             zi :: Integer
zi = forall a b. (SymVal a, Integral a, Num b) => [Char] -> SBV a -> b
enumCvt [Char]
"enumFromThenTo.z" SBV a
z

-- | Helper function for use in enum operations
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 forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x of
                Maybe a
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Enum." forall a. [a] -> [a] -> [a]
++ [Char]
w forall a. [a] -> [a] -> [a]
++ [Char]
"{" forall a. [a] -> [a] -> [a]
++ forall a. HasKind a => a -> [Char]
showType SBV a
x forall a. [a] -> [a] -> [a]
++ [Char]
"}: Called on symbolic value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show SBV a
x
                Just a
v  -> forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v

-- | The 'SDivisible' class captures the essence of division.
-- Unfortunately we cannot use Haskell's 'Integral' class since the 'Real'
-- and 'Enum' superclasses are not implementable for symbolic bit-vectors.
-- However, 'quotRem' and 'divMod' both make perfect sense, and the 'SDivisible' class captures
-- this operation. One issue is how division by 0 behaves. The verification
-- technology requires total functions, and there are several design choices
-- here. We follow Isabelle/HOL approach of assigning the value 0 for division
-- by 0. Therefore, we impose the following pair of laws:
--
-- @
--      x `sQuotRem` 0 = (0, x)
--      x `sDivMod`  0 = (0, x)
-- @
--
-- Note that our instances implement this law even when @x@ is @0@ itself.
--
-- NB. 'quot' truncates toward zero, while 'div' truncates toward negative infinity.
--
-- === C code generation of division operations
--
-- In the case of division or modulo of a minimal signed value (e.g. @-128@ for
-- 'SInt8') by @-1@, SMTLIB and Haskell agree on what the result should be.
-- Unfortunately the result in C code depends on CPU architecture and compiler
-- settings, as this is undefined behaviour in C.  **SBV does not guarantee**
-- what will happen in generated C code in this corner case.
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 = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ a
x forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` a
y
  a
x `sRem`  a
y = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ a
x forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` a
y
  a
x `sDiv`  a
y = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ a
x forall a. SDivisible a => a -> a -> (a, a)
`sDivMod`  a
y
  a
x `sMod`  a
y = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ a
x 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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) = 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 = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.sQuotRem: impossible, unexpected args received: " forall a. [a] -> [a] -> [a]
++ 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) = 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 = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.sDivMod: impossible, unexpected args received: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (CV
a, CV
b)

instance SDivisible SWord64 where
  sQuotRem :: SWord64 -> SWord64 -> (SWord64, SWord64)
sQuotRem = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SWord64 -> SWord64 -> (SWord64, SWord64)
sDivMod  = 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 = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SInt64 -> SInt64 -> (SInt64, SInt64)
sDivMod  = 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 = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SWord32 -> SWord32 -> (SWord32, SWord32)
sDivMod  = 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 = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SInt32 -> SInt32 -> (SInt32, SInt32)
sDivMod  = 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 = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SWord16 -> SWord16 -> (SWord16, SWord16)
sDivMod  = 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 = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SInt16 -> SInt16 -> (SInt16, SInt16)
sDivMod  = 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 = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SWord8 -> SWord8 -> (SWord8, SWord8)
sDivMod  = 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 = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SInt8 -> SInt8 -> (SInt8, SInt8)
sDivMod  = forall a.
(Ord a, SymVal a, Num a, SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod

-- | Lift 'quotRem' to symbolic words. Division by 0 is defined s.t. @x/0 = 0@; which
-- holds even when @x@ is @0@ itself.
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
  | forall {a}. SBV a -> Bool
isConcreteZero SBV a
x
  = (SBV a
x, SBV a
x)
  | forall {a}. SBV a -> Bool
isConcreteOne SBV a
y
  = (SBV a
x, SBV a
z)
{-------------------------------
 - N.B. The seemingly innocuous variant when y == -1 only holds if the type is signed;
 - and also is problematic around the minBound.. So, we refrain from that optimization
  | isConcreteOnes y
  = (-x, z)
--------------------------------}
  | Bool
True
  = forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
y forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
z) (SBV a
z, SBV a
x) (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) = forall a. SDivisible a => a -> a -> (a, a)
sQuotRem CV
a CV
b in (forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (forall a b. a -> Either a b
Left CV
q)), forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (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                       = (forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (forall a b. b -> Either a b
Right (forall a. (State -> IO a) -> Cached a
cache (Op -> State -> IO SV
mk Op
Quot)))), forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (forall a b. b -> Either a b
Right (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 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
a
                                   SV
sw2 <- 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 = forall a b. Integral a => Kind -> a -> SBV b
genLiteral (forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer
0::Integer)

-- | Lift 'divMod' to symbolic words. Division by 0 is defined s.t. @x/0 = 0@; which
-- holds even when @x@ is @0@ itself. Essentially, this is conversion from quotRem
-- (truncate to 0) to divMod (truncate towards negative infinity)
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
  | forall {a}. SBV a -> Bool
isConcreteZero SBV a
x
  = (SBV a
x, SBV a
x)
  | forall {a}. SBV a -> Bool
isConcreteOne SBV a
y
  = (SBV a
x, SBV a
z)
{-------------------------------
 - N.B. The seemingly innocuous variant when y == -1 only holds if the type is signed;
 - and also is problematic around the minBound.. So, we refrain from that optimization
  | isConcreteOnes y
  = (-x, z)
--------------------------------}
  | Bool
True
  = forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
y forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
z) (SBV a
z, SBV a
x) forall a b. (a -> b) -> a -> b
$ forall a. Mergeable a => SBool -> a -> a -> a
ite (forall a. Num a => a -> a
signum SBV a
r forall a. EqSymbolic a => a -> a -> SBool
.== forall a. Num a => a -> a
negate (forall a. Num a => a -> a
signum SBV a
y)) (SBV a
qforall a. Num a => a -> a -> a
-SBV a
i, SBV a
rforall 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 forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` SBV a
y
       z :: SBV a
z = forall a b. Integral a => Kind -> a -> SBV b
genLiteral (forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer
0::Integer)
       i :: SBV a
i = forall a b. Integral a => Kind -> a -> SBV b
genLiteral (forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer
1::Integer)

-- SInteger instance for quotRem/divMod are tricky!
-- SMT-Lib only has Euclidean operations, but Haskell
-- uses "truncate to 0" for quotRem, and "truncate to negative infinity" for divMod.
-- So, we cannot just use the above liftings directly.
instance SDivisible SInteger where
  sDivMod :: SInteger -> SInteger -> (SInteger, SInteger)
sDivMod = 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 (forall a. SymVal a => SBV a -> Bool
isSymbolic SInteger
x Bool -> Bool -> Bool
|| forall a. SymVal a => SBV a -> Bool
isSymbolic SInteger
y)
    = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem SInteger
x SInteger
y
    | Bool
True
    = forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
y forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
0) (SInteger
0, SInteger
x) (SInteger
qEforall a. Num a => a -> a -> a
+SInteger
i, SInteger
rEforall a. Num a => a -> a -> a
-SInteger
iforall a. Num a => a -> a -> a
*SInteger
y)
    where (SInteger
qE, SInteger
rE) = forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem SInteger
x SInteger
y   -- for integers, this is euclidean due to SMTLib semantics
          i :: SInteger
i = forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
x forall a. OrdSymbolic a => a -> a -> SBool
.>= SInteger
0 SBool -> SBool -> SBool
.|| SInteger
rE forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
0) SInteger
0
            forall a b. (a -> b) -> a -> b
$ forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
y forall a. OrdSymbolic a => a -> a -> SBool
.>  SInteger
0)              SInteger
1 (-SInteger
1)

-- Quickcheck interface
instance (SymVal a, Arbitrary a) => Arbitrary (SBV a) where
  arbitrary :: Gen (SBV a)
arbitrary = forall a. SymVal a => a -> SBV a
literal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. Arbitrary a => Gen a
arbitrary

-- |  Symbolic conditionals are modeled by the 'Mergeable' class, describing
-- how to merge the results of an if-then-else call with a symbolic test. SBV
-- provides all basic types as instances of this class, so users only need
-- to declare instances for custom data-types of their programs as needed.
--
-- A 'Mergeable' instance may be automatically derived for a custom data-type
-- with a single constructor where the type of each field is an instance of
-- 'Mergeable', such as a record of symbolic values. Users only need to add
-- 'G.Generic' and 'Mergeable' to the @deriving@ clause for the data-type. See
-- 'Documentation.SBV.Examples.Puzzles.U2Bridge.Status' for an example and an
-- illustration of what the instance would look like if written by hand.
--
-- The function 'select' is a total-indexing function out of a list of choices
-- with a default value, simulating array/list indexing. It's an n-way generalization
-- of the 'ite' function.
--
-- Minimal complete definition: None, if the type is instance of @Generic@. Otherwise
-- 'symbolicMerge'. Note that most types subject to merging are likely to be
-- trivial instances of @Generic@.
class Mergeable a where
   -- | Merge two values based on the condition. The first argument states
   -- whether we force the then-and-else branches before the merging, at the
   -- word level. This is an efficiency concern; one that we'd rather not
   -- make but unfortunately necessary for getting symbolic simulation
   -- working efficiently.
   symbolicMerge :: Bool -> SBool -> a -> a -> a
   -- | Total indexing operation. @select xs default index@ is intuitively
   -- the same as @xs !! index@, except it evaluates to @default@ if @index@
   -- underflows/overflows.
   select :: (Ord b, SymVal b, Num b) => [a] -> a -> SBV b -> a
   -- NB. Earlier implementation of select used the binary-search trick
   -- on the index to chop down the search space. While that is a good trick
   -- in general, it doesn't work for SBV since we do not have any notion of
   -- "concrete" subwords: If an index is symbolic, then all its bits are
   -- symbolic as well. So, the binary search only pays off only if the indexed
   -- list is really humongous, which is not very common in general. (Also,
   -- for the case when the list is bit-vectors, we use SMT tables anyhow.)
   select [a]
xs a
err SBV b
ind
    | forall a. HasKind a => a -> Bool
isReal   SBV b
ind = forall a. [Char] -> a
bad [Char]
"real"
    | forall a. HasKind a => a -> Bool
isFloat  SBV b
ind = forall a. [Char] -> a
bad [Char]
"float"
    | forall a. HasKind a => a -> Bool
isDouble SBV b
ind = forall a. [Char] -> a
bad [Char]
"double"
    | forall a. HasKind a => a -> Bool
hasSign  SBV b
ind = forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV b
ind forall a. OrdSymbolic a => a -> a -> SBool
.< SBV b
0) a
err (forall {a} {t}.
(Num a, Mergeable t, EqSymbolic a) =>
[t] -> a -> t -> t
walk [a]
xs SBV b
ind a
err)
    | Bool
True         =                     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 = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.select: unsupported " forall a. [a] -> [a] -> [a]
++ [Char]
w 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
iforall a. Num a => a -> a -> a
-a
1) (forall a. Mergeable a => SBool -> a -> a -> a
ite (a
i forall a. EqSymbolic a => a -> a -> SBool
.== a
0) t
e t
acc)

   -- Default implementation for 'symbolicMerge' if the type is 'Generic'
   default symbolicMerge :: (G.Generic a, GMergeable (G.Rep a)) => Bool -> SBool -> a -> a -> a
   symbolicMerge = forall a.
(Generic a, GMergeable (Rep a)) =>
Bool -> SBool -> a -> a -> a
symbolicMergeDefault

-- | If-then-else. This is by definition 'symbolicMerge' with both
-- branches forced. This is typically the desired behavior, but also
-- see 'iteLazy' should you need more laziness.
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 <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
t = if Bool
r then a
a else a
b
  | Bool
True                  = forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
True SBool
t a
a a
b

-- | A Lazy version of ite, which does not force its arguments. This might
-- cause issues for symbolic simulation with large thunks around, so use with
-- care.
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 <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
t = if Bool
r then a
a else a
b
  | Bool
True                  = forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
False SBool
t a
a a
b

-- | Symbolic assert. Check that the given boolean condition is always 'sTrue' in the given path. The
-- optional first argument can be used to provide call-stack info via GHC's location facilities.
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 <- forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
cond
   = if Bool
mustHold
     then SBV a
x
     else forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show forall a b. (a -> b) -> a -> b
$ (Maybe [Char], [Char], SMTResult) -> SafeResult
SafeResult (([([Char], SrcLoc)] -> [Char]
locInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [([Char], SrcLoc)]
getCallStack) 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 [] forall a. Maybe a
Nothing [] []))
   | Bool
True
   = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k     = forall a. HasKind a => a -> Kind
kindOf SBV a
x
        r :: State -> IO SV
r State
st  = do SV
xsv <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
                   let pc :: SBool
pc = State -> SBool
getPathCondition State
st
                       -- We're checking if there are any cases where the path-condition holds, but not the condition
                       -- Any violations of this, should be signaled, i.e., whenever the following formula is satisfiable
                       mustNeverHappen :: SBool
mustNeverHappen = SBool
pc SBool -> SBool -> SBool
.&& SBool -> SBool
sNot SBool
cond
                   SV
cnd <- 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
                   forall (m :: * -> *) a. Monad m => a -> m a
return SV
xsv

        locInfo :: [([Char], SrcLoc)] -> [Char]
locInfo [([Char], SrcLoc)]
ps = forall a. [a] -> [[a]] -> [a]
intercalate [Char]
",\n " (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) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [SrcLoc -> [Char]
srcLocFile SrcLoc
sl, [Char]
":", forall a. Show a => a -> [Char]
show (SrcLoc -> Int
srcLocStartLine SrcLoc
sl), [Char]
":", forall a. Show a => a -> [Char]
show (SrcLoc -> Int
srcLocStartCol SrcLoc
sl), [Char]
":", [Char]
f]

-- | Merge two symbolic values, at kind @k@, possibly @force@'ing the branches to make
-- sure they do not evaluate to the same result. This should only be used for internal purposes;
-- as default definitions provided should suffice in many cases. (i.e., End users should
-- only need to define 'symbolicMerge' when needed; which should be rare to start with.)
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) = 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
    -- Carefully use the kindOf instance to avoid strictness issues.
       | Bool
force = forall a. Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMergeWithKind (forall a. HasKind a => a -> Kind
kindOf SBV a
x)          Bool
True  SBool
t SBV a
x SBV a
y
       | Bool
True  = forall a. Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMergeWithKind (forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)) Bool
False SBool
t SBV a
x SBV a
y
    -- Custom version of select that translates to SMT-Lib tables at the base type of words
    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 forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i forall a. Ord a => a -> a -> Bool
>= forall i a. Num i => [a] -> i
genericLength [SBV a]
xs
                                                       then SBV a
err
                                                       else [SBV a]
xs forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
i
                                         CVal
_          -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.select: unsupported " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. HasKind a => a -> Kind
kindOf SBV b
ind) forall a. [a] -> [a] -> [a]
++ [Char]
" valued select/index expression"
    select [SBV a]
xsOrig SBV a
err SBV b
ind = [SBV a]
xs seq :: forall a b. a -> b -> b
`seq` forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
kElt (forall a b. b -> Either a b
Right (forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
      where kInd :: Kind
kInd = forall a. HasKind a => a -> Kind
kindOf SBV b
ind
            kElt :: Kind
kElt = forall a. HasKind a => a -> Kind
kindOf SBV a
err
            -- Based on the index size, we need to limit the elements. For instance if the index is 8 bits, but there
            -- are 257 elements, that last element will never be used and we can chop it of..
            xs :: [SBV a]
xs   = case forall a. HasKind a => a -> Kind
kindOf SBV b
ind of
                     KBounded Bool
False Int
i -> forall i a. Integral i => i -> [a] -> [a]
genericTake ((Integer
2::Integer) forall a b. (Num a, Integral b) => a -> b -> a
^ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i     :: Integer)) [SBV a]
xsOrig
                     KBounded Bool
True  Int
i -> forall i a. Integral i => i -> [a] -> [a]
genericTake ((Integer
2::Integer) forall a b. (Num a, Integral b) => a -> b -> a
^ (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iforall a. Num a => a -> a -> a
-Int
1) :: Integer)) [SBV a]
xsOrig
                     Kind
KUnbounded       -> [SBV a]
xsOrig
                     Kind
_                -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"SBV.select: unsupported " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. HasKind a => a -> Kind
kindOf SBV b
ind) forall a. [a] -> [a] -> [a]
++ [Char]
" valued select/index expression"
            r :: State -> IO SV
r State
st  = do [SV]
sws <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a. State -> SBV a -> IO SV
sbvToSV State
st) [SBV a]
xs
                       SV
swe <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
err
                       if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== SV
swe) [SV]
sws  -- off-chance that all elts are the same. Note that this also correctly covers the case when list is empty.
                          then 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 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
ind
                                  let len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBV a]
xs
                                  -- NB. No need to worry here that the index might be < 0; as the SMTLib translation takes care of that automatically
                                  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) [])

-- | Construct a useful error message if we hit an unmergeable case.
cannotMerge :: String -> String -> String -> a
cannotMerge :: forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
typ [Char]
why [Char]
hint = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [ [Char]
""
                                           , [Char]
"*** Data.SBV.Mergeable: Cannot merge instances of " forall a. [a] -> [a] -> [a]
++ [Char]
typ forall a. [a] -> [a] -> [a]
++ [Char]
"."
                                           , [Char]
"*** While trying to do a symbolic if-then-else with incompatible branch results."
                                           , [Char]
"***"
                                           , [Char]
"*** " forall a. [a] -> [a] -> [a]
++ [Char]
why
                                           , [Char]
"*** "
                                           , [Char]
"*** Hint: " forall a. [a] -> [a] -> [a]
++ [Char]
hint
                                           ]

-- | Merge concrete values that can be checked for equality
concreteMerge :: Show a => String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge :: forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
t [Char]
st a -> a -> Bool
eq a
x a
y
  | a
x a -> a -> Bool
`eq` a
y = a
x
  | Bool
True     = forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
t
                           ([Char]
"Concrete values can only be merged when equal. Got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
x forall a. [a] -> [a] -> [a]
++ [Char]
" vs. " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show a
y)
                           ([Char]
"Use an " forall a. [a] -> [a] -> [a]
++ [Char]
st forall a. [a] -> [a] -> [a]
++ [Char]
" field if the values can differ.")

-- Mergeable instances for List/Maybe/Either/Array are useful, but can
-- throw exceptions if there is no structural matching of the results
-- It's a question whether we should really keep them..

-- Lists
instance Mergeable a => Mergeable [a] where
  symbolicMerge :: Bool -> SBool -> [a] -> [a] -> [a]
symbolicMerge Bool
f SBool
t [a]
xs [a]
ys
    | Int
lxs forall a. Eq a => a -> a -> Bool
== Int
lys = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t) [a]
xs [a]
ys
    | Bool
True       = forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
"lists"
                               ([Char]
"Branches produce different sizes: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
lxs forall a. [a] -> [a] -> [a]
++ [Char]
" vs " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
lys 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) = (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs, forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys)

-- ZipList
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)
    = forall a. [a] -> ZipList a
ZipList (forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
force SBool
test [a]
xs [a]
ys)

-- Maybe
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  = forall a. Maybe a
Nothing
  symbolicMerge Bool
f SBool
t (Just a
a) (Just a
b) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 = forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
"'Maybe' values"
                                      ([Char]
"Branches produce different constructors: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall {a}. Maybe a -> [Char]
k Maybe a
a, 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"

-- Either
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)  = forall a b. a -> Either a b
Left  forall a b. (a -> b) -> a -> b
$ 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) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> 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 = forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
"'Either' values"
                                      ([Char]
"Branches produce different constructors: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall {a} {b}. Either a b -> [Char]
k Either a b
a, 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"

-- Arrays
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 forall a. Eq a => a -> a -> Bool
== (a, a)
bb = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (a, a)
ba (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t) (forall i e. Array i e -> [e]
elems Array a b
a) (forall i e. Array i e -> [e]
elems Array a b
b))
    | Bool
True     = forall a. [Char] -> [Char] -> [Char] -> a
cannotMerge [Char]
"'Array' values"
                             ([Char]
"Branches produce different ranges: " forall a. [a] -> [a] -> [a]
++ 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] = forall a b. (a -> b) -> [a] -> [b]
map forall i e. Array i e -> (i, i)
bounds [Array a b
a, Array a b
b]
          k :: (a, a) -> Int
k = forall a. Ix a => (a, a) -> Int
rangeSize

-- Functions
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 = forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t (a -> b
g a
x) (a -> b
h a
x)
  {- Following definition, while correct, is utterly inefficient. Since the
     application is delayed, this hangs on to the inner list and all the
     impending merges, even when ind is concrete. Thus, it's much better to
     simply use the default definition for the function case.
  -}
  -- select xs err ind = \x -> select (map ($ x) xs) (err x) ind

-- 2-Tuple
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) = ( forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                        , 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 = ( forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                               , 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) = forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
xs

-- 3-Tuple
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) = ( forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                , 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 = ( forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                     , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                     , 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) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(a, b, c)]
xs

-- 4-Tuple
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) = ( forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                        , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                        , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
                                                        , 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 = ( forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                           , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                           , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
                                           , 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) = forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [(a, b, c, d)]
xs

-- 5-Tuple
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) = ( forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                                , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                                , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
                                                                , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
                                                                , 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 = ( forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                                 , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                                 , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
                                                 , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
                                                 , 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) = forall a b c d e. [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
unzip5 [(a, b, c, d, e)]
xs

-- 6-Tuple
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) = ( forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                                        , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                                        , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
                                                                        , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
                                                                        , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t e
i4 e
j4
                                                                        , 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 = ( forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                                       , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                                       , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
                                                       , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
                                                       , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [e]
es e
err5 SBV b
ind
                                                       , 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) = 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

-- 7-Tuple
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) = ( forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                                                , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                                                , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
                                                                                , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
                                                                                , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t e
i4 e
j4
                                                                                , forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t f
i5 f
j5
                                                                                , 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 = ( forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                                             , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                                             , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
                                                             , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
                                                             , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [e]
es e
err5 SBV b
ind
                                                             , forall a b.
(Mergeable a, Ord b, SymVal b, Num b) =>
[a] -> a -> SBV b -> a
select [f]
fs f
err6 SBV b
ind
                                                             , 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) = 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

-- Base types are mergeable so long as they are equal
instance Mergeable ()      where symbolicMerge :: Bool -> SBool -> () -> () -> ()
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"()"      [Char]
"()"        forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Integer where symbolicMerge :: Bool -> SBool -> Integer -> Integer -> Integer
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Integer" [Char]
"SInteger"  forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Bool    where symbolicMerge :: Bool -> SBool -> Bool -> Bool -> Bool
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Bool"    [Char]
"SBool"     forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Char    where symbolicMerge :: Bool -> SBool -> Char -> Char -> Char
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Char"    [Char]
"SChar"     forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Float   where symbolicMerge :: Bool -> SBool -> Float -> Float -> Float
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Float"   [Char]
"SFloat"    forall a. RealFloat a => a -> a -> Bool
fpIsEqualObjectH
instance Mergeable Double  where symbolicMerge :: Bool -> SBool -> Double -> Double -> Double
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Double"  [Char]
"SDouble"   forall a. RealFloat a => a -> a -> Bool
fpIsEqualObjectH
instance Mergeable Word8   where symbolicMerge :: Bool -> SBool -> Word8 -> Word8 -> Word8
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Word8"   [Char]
"SWord8"    forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Word16  where symbolicMerge :: Bool -> SBool -> Word16 -> Word16 -> Word16
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Word16"  [Char]
"SWord16"   forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Word32  where symbolicMerge :: Bool -> SBool -> Word32 -> Word32 -> Word32
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Word32"  [Char]
"SWord32"   forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Word64  where symbolicMerge :: Bool -> SBool -> Word64 -> Word64 -> Word64
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Word64"  [Char]
"SWord64"   forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Int8    where symbolicMerge :: Bool -> SBool -> Int8 -> Int8 -> Int8
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Int8"    [Char]
"SInt8"     forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Int16   where symbolicMerge :: Bool -> SBool -> Int16 -> Int16 -> Int16
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Int16"   [Char]
"SInt16"    forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Int32   where symbolicMerge :: Bool -> SBool -> Int32 -> Int32 -> Int32
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Int32"   [Char]
"SInt32"    forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Int64   where symbolicMerge :: Bool -> SBool -> Int64 -> Int64 -> Int64
symbolicMerge Bool
_ SBool
_ = forall a.
Show a =>
[Char] -> [Char] -> (a -> a -> Bool) -> a -> a -> a
concreteMerge [Char]
"Int64"   [Char]
"SInt64"    forall a. Eq a => a -> a -> Bool
(==)

-- Arbitrary product types, using GHC.Generics
--
-- NB: Because of the way GHC.Generics works, the implementation of
-- symbolicMerge' is recursive. The derived instance for @data T a = T a a a a@
-- resembles that for (a, (a, (a, a))), not the flat 4-tuple (a, a, a, a). This
-- difference should have no effect in practice. Note also that, unlike the
-- hand-rolled tuple instances, the generic instance does not provide a custom
-- 'select' implementation, and so does not benefit from the SMT-table
-- implementation in the 'SBV a' instance.

-- | Not exported. Symbolic merge using the generic representation provided by
-- 'G.Generics'.
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 = forall a x. Generic a => Rep a x -> a
G.to forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t (forall a x. Generic a => a -> Rep a x
G.from a
x) (forall a x. Generic a => a -> Rep a x
G.from a
y)

-- | Not exported. Used only in 'symbolicMergeDefault'. Instances are provided for
-- the generic representations of product types where each element is Mergeable.
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
_ = 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) = forall k i c (p :: k). c -> K1 i c p
K1 forall a b. (a -> b) -> a -> b
$ 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) = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall a b. (a -> b) -> a -> b
$ 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) = forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t f a
x1 f a
x2 forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t g a
y1 g a
y2

-- Bounded instances
instance (SymVal a, Bounded a) => Bounded (SBV a) where
  minBound :: SBV a
minBound = forall a. SymVal a => a -> SBV a
literal forall a. Bounded a => a
minBound
  maxBound :: SBV a
maxBound = forall a. SymVal a => a -> SBV a
literal forall a. Bounded a => a
maxBound

-- Arrays

-- SArrays are both "EqSymbolic" and "Mergeable"
instance EqSymbolic (SArray a b) where
  SArray SArr
a .== :: SArray a b -> SArray a b -> SBool
.== SArray SArr
b = forall a. SVal -> SBV a
SBV (SArr
a SArr -> SArr -> SVal
`eqSArr` SArr
b)

-- When merging arrays; we'll ignore the force argument. This is arguably
-- the right thing to do as we've too many things and likely we want to keep it efficient.
instance SymVal b => Mergeable (SArray a b) where
  symbolicMerge :: Bool -> SBool -> SArray a b -> SArray a b -> SArray a b
symbolicMerge Bool
_ = forall (array :: * -> * -> *) b a.
(SymArray array, SymVal b) =>
SBool -> array a b -> array a b -> array a b
mergeArrays

-- | Uninterpreted constants and functions. An uninterpreted constant is
-- a value that is indexed by its name. The only property the prover assumes
-- about these values are that they are equivalent to themselves; i.e., (for
-- functions) they return the same results when applied to same arguments.
-- We support uninterpreted-functions as a general means of black-box'ing
-- operations that are /irrelevant/ for the purposes of the proof; i.e., when
-- the proofs can be performed without any knowledge about the function itself.
--
-- Minimal complete definition: 'sbvUninterpret'. However, most instances in
-- practice are already provided by SBV, so end-users should not need to define their
-- own instances.
class Uninterpreted a where
  -- | Uninterpret a value, receiving an object that can be used instead. Use this version
  -- when you do not need to add an axiom about this value.
  uninterpret :: String -> a
  -- | Uninterpret a value, only for the purposes of code-generation. For execution
  -- and verification the value is used as is. For code-generation, the alternate
  -- definition is used. This is useful when we want to take advantage of native
  -- libraries on the target languages.
  cgUninterpret :: String -> [String] -> a -> a
  -- | Most generalized form of uninterpretation, this function should not be needed
  -- by end-user-code, but is rather useful for the library development.
  sbvUninterpret :: Maybe ([String], a) -> String -> a
  -- | A synonym for 'uninterpret'. Allows us to create variables without
  -- having to call 'free' explicitly, i.e., without being in the symbolic monad.
  sym :: String -> a

  {-# MINIMAL sbvUninterpret #-}

  -- defaults:
  uninterpret             = forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret forall a. Maybe a
Nothing
  cgUninterpret [Char]
nm [[Char]]
code a
v = forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (forall a. a -> Maybe a
Just ([[Char]]
code, a
v)) [Char]
nm
  sym                     = forall a. Uninterpreted a => [Char] -> a
uninterpret

-- Plain constants
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                    = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
    where ka :: Kind
ka = forall a. HasKind a => a -> Kind
kindOf (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)) -> 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]) (forall a b. (a, b) -> a
fst 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 forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) []

-- Functions of one argument
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, forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg0
           = SBV b -> SBV a
v SBV b
arg0
           | Bool
True
           = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = forall a. HasKind a => a -> Kind
kindOf (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)) -> 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]) (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], SBV b -> SBV a)
mbCgData)
                                                            SV
sw0 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg0
                                                            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 forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0]

-- Functions of two arguments
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, forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg0, 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
           = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = forall a. HasKind a => a -> Kind
kindOf (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)) -> 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]) (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe ([[Char]], SBV c -> SBV b -> SBV a)
mbCgData)
                                                            SV
sw0 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg0
                                                            SV
sw1 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg1
                                                            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 forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0, SV
sw1]

-- Functions of three arguments
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, forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg0, forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg1, 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
           = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = forall a. HasKind a => a -> Kind
kindOf (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)) -> 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]) (forall a b. (a, b) -> a
fst 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 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg0
                                                            SV
sw1 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg1
                                                            SV
sw2 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg2
                                                            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 forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0, SV
sw1, SV
sw2]

-- Functions of four arguments
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, forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg0, forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg1, forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg2, 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
           = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = forall a. HasKind a => a -> Kind
kindOf (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)) -> 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]) (forall a b. (a, b) -> a
fst 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 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg0
                                                            SV
sw1 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg1
                                                            SV
sw2 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg2
                                                            SV
sw3 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg3
                                                            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 forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp ([Char] -> Op
Uninterpreted [Char]
nm) [SV
sw0, SV
sw1, SV
sw2, SV
sw3]

-- Functions of five arguments
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, forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg0, forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg1, forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg2, forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg3, 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
           = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = forall a. HasKind a => a -> Kind
kindOf (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)) -> 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]) (forall a b. (a, b) -> a
fst 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 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg0
                                                            SV
sw1 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg1
                                                            SV
sw2 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg2
                                                            SV
sw3 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg3
                                                            SV
sw4 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg4
                                                            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 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]

-- Functions of six arguments
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, forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg0, forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg1, forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg2, forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg3, forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg4, 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
           = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @f)
                 kg :: Kind
kg = forall a. HasKind a => a -> Kind
kindOf (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)) -> 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]) (forall a b. (a, b) -> a
fst 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 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg0
                                                            SV
sw1 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg1
                                                            SV
sw2 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg2
                                                            SV
sw3 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg3
                                                            SV
sw4 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg4
                                                            SV
sw5 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg5
                                                            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 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]

-- Functions of seven arguments
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, forall a. SymVal a => SBV a -> Bool
isConcrete SBV h
arg0, forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg1, forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg2, forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg3, forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg4, forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg5, 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
           = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @f)
                 kg :: Kind
kg = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @g)
                 kh :: Kind
kh = forall a. HasKind a => a -> Kind
kindOf (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)) -> 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]) (forall a b. (a, b) -> a
fst 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 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV h
arg0
                                                            SV
sw1 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg1
                                                            SV
sw2 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg2
                                                            SV
sw3 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg3
                                                            SV
sw4 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg4
                                                            SV
sw5 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg5
                                                            SV
sw6 <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg6
                                                            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 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]

-- Uncurried functions of two arguments
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 = forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (forall {a} {a} {b} {c}. (a, (a, b) -> c) -> (a, a -> b -> c)
uc2 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 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, forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> c
fn)

-- Uncurried functions of three arguments
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 = forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (forall {a} {a} {b} {c} {t}.
(a, (a, b, c) -> t) -> (a, a -> b -> c -> t)
uc3 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))

-- Uncurried functions of four arguments
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 = forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (forall {a} {a} {b} {c} {d} {t}.
(a, (a, b, c, d) -> t) -> (a, a -> b -> c -> d -> t)
uc4 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))

-- Uncurried functions of five arguments
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 = forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (forall {a} {a} {b} {c} {d} {e} {t}.
(a, (a, b, c, d, e) -> t) -> (a, a -> b -> c -> d -> e -> t)
uc5 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))

-- Uncurried functions of six arguments
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 = forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (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 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))

-- Uncurried functions of seven arguments
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 = forall a. Uninterpreted a => Maybe ([[Char]], a) -> [Char] -> a
sbvUninterpret (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 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))

-- | Symbolic computations provide a context for writing symbolic programs.
instance MonadIO m => SolverContext (SymbolicT m) where
   constrain :: SBool -> SymbolicT m ()
constrain                   (SBV SVal
c) = forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [([Char], [Char])] -> SVal -> m ()
imposeConstraint Bool
False []               SVal
c
   softConstrain :: SBool -> SymbolicT m ()
softConstrain               (SBV SVal
c) = 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) = 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) = forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [([Char], [Char])] -> SVal -> m ()
imposeConstraint Bool
False [([Char], [Char])]
atts             SVal
c
   addAxiom :: [Char] -> [[Char]] -> SymbolicT m ()
addAxiom                            = forall (m :: * -> *).
(SolverContext m, MonadIO m) =>
Bool -> [Char] -> [[Char]] -> m ()
addSymAxiom Bool
False
   addSMTDefinition :: [Char] -> [[Char]] -> SymbolicT m ()
addSMTDefinition                    = forall (m :: * -> *).
(SolverContext m, MonadIO m) =>
Bool -> [Char] -> [[Char]] -> m ()
addSymAxiom Bool
True
   contextState :: SymbolicT m State
contextState                        = forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv

   setOption :: SMTOption -> SymbolicT m ()
setOption SMTOption
o = forall (m :: * -> *). MonadSymbolic m => SMTOption -> m ()
addNewSMTOption  SMTOption
o

-- | Add an axiom. Only used internally, use `addAxiom` from user programs which works over
-- both regular and query modes of usage.
addSymAxiom :: (SolverContext m, MonadIO m) => Bool -> String -> [String] -> m ()
addSymAxiom :: forall (m :: * -> *).
(SolverContext m, MonadIO m) =>
Bool -> [Char] -> [[Char]] -> m ()
addSymAxiom Bool
hasDefinition [Char]
nm [[Char]]
ax = do
        State
st <- forall (m :: * -> *). SolverContext m => m State
contextState
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef [(Bool, [Char], [[Char]])]
raxioms ((Bool
hasDefinition, [Char]
nm, [[Char]]
ax) forall a. a -> [a] -> [a]
:) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Generalization of 'Data.SBV.assertWithPenalty'
assertWithPenalty :: MonadSymbolic m => String -> SBool -> Penalty -> m ()
assertWithPenalty :: forall (m :: * -> *).
MonadSymbolic m =>
[Char] -> SBool -> Penalty -> m ()
assertWithPenalty [Char]
nm SBool
o Penalty
p = forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal forall a b. (a -> b) -> a -> b
$ forall a. SBV a -> SVal
unSBV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. [Char] -> a -> Penalty -> Objective a
AssertWithPenalty [Char]
nm SBool
o Penalty
p

-- | Class of metrics we can optimize for. Currently, booleans,
-- bounded signed/unsigned bit-vectors, unbounded integers,
-- algebraic reals and floats can be optimized. You can add
-- your instances, but bewared that the 'MetricSpace' should
-- map your type to something the backend solver understands, which
-- are limited to unsigned bit-vectors, reals, and unbounded integers
-- for z3.
--
-- A good reference on these features is given in the following paper:
-- <http://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/nbjorner-scss2014.pdf>.
--
-- Minimal completion: None. However, if @MetricSpace@ is not identical to the type, you want
-- to define 'toMetricSpace' and possibly 'minimize'/'maximize' to add extra constraints as necessary.
class Metric a where
  -- | The metric space we optimize the goal over. Usually the same as the type itself, but not always!
  -- For instance, signed bit-vectors are optimized over their unsigned counterparts, floats are
  -- optimized over their 'Word32' comparable counterparts, etc.
  type MetricSpace a :: Type
  type MetricSpace a = a

  -- | Compute the metric value to optimize.
  toMetricSpace   :: SBV a -> SBV (MetricSpace a)
  -- | Compute the value itself from the metric corresponding to it.
  fromMetricSpace :: SBV (MetricSpace a) -> SBV a

  -- | Minimizing a metric space
  msMinimize :: (MonadSymbolic m, SolverContext m) => String -> SBV a -> m ()
  msMinimize [Char]
nm SBV a
o = forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal forall a b. (a -> b) -> a -> b
$ forall a. SBV a -> SVal
unSBV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. [Char] -> a -> Objective a
Minimize [Char]
nm (forall a. Metric a => SBV a -> SBV (MetricSpace a)
toMetricSpace SBV a
o)

  -- | Maximizing a metric space
  msMaximize :: (MonadSymbolic m, SolverContext m) => String -> SBV a -> m ()
  msMaximize [Char]
nm SBV a
o = forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal forall a b. (a -> b) -> a -> b
$ forall a. SBV a -> SVal
unSBV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a. [Char] -> a -> Objective a
Maximize [Char]
nm (forall a. Metric a => SBV a -> SBV (MetricSpace a)
toMetricSpace SBV a
o)

  -- if MetricSpace is the same, we can give a default definition
  default toMetricSpace :: (a ~ MetricSpace a) => SBV a -> SBV (MetricSpace a)
  toMetricSpace = forall a. a -> a
id

  default fromMetricSpace :: (a ~ MetricSpace a) => SBV (MetricSpace a) -> SBV a
  fromMetricSpace = forall a. a -> a
id

-- Booleans assume True is greater than False
instance Metric Bool where
  type MetricSpace Bool = Word8
  toMetricSpace :: SBool -> SBV (MetricSpace Bool)
toMetricSpace SBool
t       = 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     = SBV (MetricSpace Bool)
w forall a. EqSymbolic a => a -> a -> SBool
./= SWord8
0

-- | Generalization of 'Data.SBV.minimize'
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 = forall a (m :: * -> *).
(Metric a, MonadSymbolic m, SolverContext m) =>
[Char] -> SBV a -> m ()
msMinimize

-- | Generalization of 'Data.SBV.maximize'
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 = forall a (m :: * -> *).
(Metric a, MonadSymbolic m, SolverContext m) =>
[Char] -> SBV a -> m ()
msMaximize

-- Unsigned types, integers, and reals directly optimize
instance Metric Word8
instance Metric Word16
instance Metric Word32
instance Metric Word64
instance Metric Integer
instance Metric AlgReal

-- To optimize signed bounded values, we have to adjust to the range
instance Metric Int8 where
  type MetricSpace Int8 = Word8
  toMetricSpace :: SInt8 -> SBV (MetricSpace Int8)
toMetricSpace    SInt8
x    = forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SInt8
x forall a. Num a => a -> a -> a
+ SWord8
128  -- 2^7
  fromMetricSpace :: SBV (MetricSpace Int8) -> SInt8
fromMetricSpace  SBV (MetricSpace Int8)
x    = forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV (MetricSpace Int8)
x 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     = forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SInt16
x forall a. Num a => a -> a -> a
+ SWord16
32768  -- 2^15
  fromMetricSpace :: SBV (MetricSpace Int16) -> SInt16
fromMetricSpace  SBV (MetricSpace Int16)
x     = forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV (MetricSpace Int16)
x 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     = forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SInt32
x forall a. Num a => a -> a -> a
+ SWord32
2147483648 -- 2^31
  fromMetricSpace :: SBV (MetricSpace Int32) -> SInt32
fromMetricSpace  SBV (MetricSpace Int32)
x     = forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV (MetricSpace Int32)
x 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     = forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SInt64
x forall a. Num a => a -> a -> a
+ SWord64
9223372036854775808  -- 2^63
  fromMetricSpace :: SBV (MetricSpace Int64) -> SInt64
fromMetricSpace  SBV (MetricSpace Int64)
x     = forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV (MetricSpace Int64)
x forall a. Num a => a -> a -> a
- SInt64
9223372036854775808

-- Quickcheck interface on symbolic-booleans..
instance Testable SBool where
  property :: SBool -> Property
property (SBV (SVal Kind
_ (Left CV
b))) = forall prop. Testable prop => prop -> Property
property (CV -> Bool
cvToBool CV
b)
  property SBool
_                       = 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 = forall a. Testable a => PropertyM IO a -> Property
QC.monadicIO forall a b. (a -> b) -> a -> b
$ do (Bool
cond, Bool
r, [([Char], CV)]
modelVals) <- forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QC.run IO (Bool, Bool, [([Char], CV)])
test
                                     forall (m :: * -> *). Monad m => Bool -> PropertyM m ()
QC.pre Bool
cond
                                     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
r Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [([Char], CV)]
modelVals) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
(Property -> Property) -> PropertyM m ()
QC.monitor (forall prop. Testable prop => [Char] -> prop -> Property
QC.counterexample ([([Char], CV)] -> [Char]
complain [([Char], CV)]
modelVals))
                                     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}) <- forall (m :: * -> *) a.
MonadIO m =>
SBVRunMode -> SymbolicT m a -> m (a, Result)
runSymbolic (Maybe (Bool, [((Quantifier, NamedSymVar), Maybe CV)]) -> SBVRunMode
Concrete forall a. Maybe a
Nothing) Symbolic SBool
prop

                     let cval :: SV -> CV
cval = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot quick-check in the presence of uninterpeted constants!") forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(SV, CV)]
cs)
                         cond :: Bool
cond = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [CV -> Bool
cvToBool (SV -> CV
cval SV
v) | (Bool
False, [([Char], [Char])]
_, SV
v) <- forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq (Bool, [([Char], [Char])], SV)
cstrs] -- Only pick-up "hard" constraints, as indicated by False in the fist component

                         getObservable :: ([Char], CV -> Bool, SV) -> Maybe ([Char], CV)
getObservable ([Char]
nm, CV -> Bool
f, SV
v) = case SV
v 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 forall a. a -> Maybe a
Just ([Char]
nm, CV
cv) else forall a. Maybe a
Nothing
                                                      Maybe CV
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Quick-check: Observable " forall a. [a] -> [a] -> [a]
++ [Char]
nm forall a. [a] -> [a] -> [a]
++ [Char]
" did not reduce to a constant!"

                     case forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [([Char], SBVType)]
unints of
                       [] -> case forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
r of
                               Maybe Bool
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ 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  -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
cond, Bool
b, [([Char], CV)]
tvals forall a. [a] -> [a] -> [a]
++ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Char], CV -> Bool, SV) -> Maybe ([Char], CV)
getObservable [([Char], CV -> Bool, SV)]
ovals)
                       [[Char]]
us -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Cannot quick-check in the presence of uninterpreted constants: " forall a. [a] -> [a] -> [a]
++ 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 [] forall a. Maybe a
Nothing [([Char], CV)]
qcInfo [])

-- | Quick check an SBV property. Note that a regular @quickCheck@ call will work just as
-- well. Use this variant if you want to receive the boolean result.
sbvQuickCheck :: Symbolic SBool -> IO Bool
sbvQuickCheck :: Symbolic SBool -> IO Bool
sbvQuickCheck Symbolic SBool
prop = Result -> Bool
QC.isSuccess forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall prop. Testable prop => prop -> IO Result
QC.quickCheckResult Symbolic SBool
prop

-- Quickcheck interface on dynamically-typed values. A run-time check
-- ensures that the value has boolean type.
instance Testable (Symbolic SVal) where
  property :: Symbolic SVal -> Property
property Symbolic SVal
m = forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ do SVal
s <- Symbolic SVal
m
                             forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. HasKind a => a -> Kind
kindOf SVal
s forall a. Eq a => a -> a -> Bool
/= Kind
KBool) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot quickcheck non-boolean value"
                             forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. SVal -> SBV a
SBV SVal
s :: SBool)

-- | Explicit sharing combinator. The SBV library has internal caching/hash-consing mechanisms
-- built in, based on Andy Gill's type-safe observable sharing technique (see: <http://ku-fpg.github.io/files/Gill-09-TypeSafeReification.pdf>).
-- However, there might be times where being explicit on the sharing can help, especially in experimental code. The 'slet' combinator
-- ensures that its first argument is computed once and passed on to its continuation, explicitly indicating the intent of sharing. Most
-- use cases of the SBV library should simply use Haskell's @let@ construct for this purpose.
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 = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
    where k :: Kind
k    = forall a. HasKind a => a -> Kind
kindOf (forall {k} (t :: k). Proxy t
Proxy @b)
          r :: State -> IO SV
r State
st = do SV
xsv <- forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
                    let xsbv :: SBV a
xsbv = forall a. SVal -> SBV a
SBV forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal (forall a. HasKind a => a -> Kind
kindOf SBV a
x) (forall a b. b -> Either a b
Right (forall a. (State -> IO a) -> Cached a
cache (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return SV
xsv))))
                        res :: SBV b
res  = SBV a -> SBV b
f SBV a
xsbv
                    forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
res

-- | Equality as a proof method. Allows for
-- very concise construction of equivalence proofs, which is very typical in
-- bit-precise proofs.
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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove forall a b. (a -> b) -> a -> b
$ \SBV a
a -> SBV a -> z
k SBV a
a 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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) 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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) 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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) 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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) 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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) 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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 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 = forall (m :: * -> *) a. MProvable m a => a -> m ThmResult
prove 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) 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)         #-}