-----------------------------------------------------------------------------
-- |
-- 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 CPP                     #-}
{-# LANGUAGE DataKinds               #-}
{-# LANGUAGE DefaultSignatures       #-}
{-# LANGUAGE DeriveFunctor           #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE FlexibleInstances       #-}
{-# LANGUAGE InstanceSigs            #-}
{-# LANGUAGE MultiParamTypeClasses   #-}
{-# LANGUAGE NamedFieldPuns          #-}
{-# 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(..), SMTDefinable(..), QSaturate, qSaturateSavingObservables
  , Metric(..), minimize, maximize, assertWithPenalty, SIntegral, SFiniteBits(..)
  , ite, iteLazy, sFromIntegral, sShiftLeft, sShiftRight, sRotateLeft, sBarrelRotateLeft, sRotateRight, sBarrelRotateRight, sSignedShiftArithRight, (.^)
  , some
  , oneIf, genVar, genVar_
  , 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
  , sWord, sWord_, sWords, sInt, sInt_, sInts
  , sFPHalf, sFPHalf_, sFPHalfs, sFPBFloat, sFPBFloat_, sFPBFloats, sFPSingle, sFPSingle_, sFPSingles, sFPDouble, sFPDouble_, sFPDoubles, sFPQuad, sFPQuad_, sFPQuads, sArray, sArray_, sArrays
  , 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
  , sEDivMod, sEDiv, sEMod
  , sDivides
  , solve
  , slet
  , sRealToSInteger, sRealToSIntegerTruncate, label, observe, observeIf, sObserve
  , sAssert
  , liftQRem, liftDMod, symbolicMergeWithKind
  , genLiteral, genFromCV, genMkSymVar
  , zeroExtend, signExtend
  , sbvQuickCheck
  , readArray, writeArray, lambdaArray, listArray
  , FromSized, ToSized, FromSizedBV(..), ToSizedBV(..)
  , smtHOFunction, Closure(..)
  )
  where

import Control.Applicative    (ZipList(ZipList))
import Control.Monad          (when, unless, mplus, replicateM)
import Control.Monad.IO.Class (MonadIO, liftIO)

import qualified Control.Exception as C

import GHC.Generics (M1(..), U1(..), (:*:)(..), K1(..))
import qualified GHC.Generics as G

import GHC.Stack
import GHC.TypeLits
#if MIN_VERSION_base(4,18,0)
                    hiding(SChar)
#endif

import Data.Array  (Array, Ix, elems, bounds, rangeSize)
import qualified Data.Array as DA (listArray)

import Data.Bits   (Bits(..))
import Data.Int    (Int8, Int16, Int32, Int64)
import Data.Kind   (Type, Constraint)
import Data.List   (genericLength, genericIndex, genericTake, unzip4, unzip5, unzip6, unzip7, intercalate)
import Data.Maybe  (fromMaybe, mapMaybe)
import Data.String (IsString(..))
import Data.Word   (Word8, Word16, Word32, Word64)

import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE

import qualified Data.Set as Set

import Data.Proxy
import Data.Dynamic (fromDynamic, toDyn, Typeable)

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.Sized
import Data.SBV.Core.SizedFloats
import Data.SBV.Core.Data hiding (Constraint)
import Data.SBV.Core.Symbolic
import Data.SBV.Core.Operations
import Data.SBV.Core.Kind
import Data.SBV.Lambda
import Data.SBV.Utils.ExtractIO(ExtractIO)

import Data.SBV.Provers.Prover (defaultSMTCfg, SafeResult(..), defs2smt, prove)
import Data.SBV.SMT.SMT        (ThmResult, showModel)

import Data.SBV.Utils.Numeric (fpIsEqualObjectH)

import Data.IORef (readIORef, writeIORef)
import Data.SBV.Utils.Lib

import Data.Char

-- Symbolic-Word class instances

import Crypto.Hash.SHA512 (hash)
import qualified Data.ByteString.Base16 as B
import qualified Data.ByteString.Char8  as BC

-- | Generate a variable, named
genVar :: MonadSymbolic m => VarContext -> Kind -> String -> m (SBV a)
genVar :: forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> String -> m (SBV a)
genVar VarContext
q Kind
k = VarContext -> Kind -> Maybe String -> m (SBV a)
forall a (m :: * -> *).
MonadSymbolic m =>
VarContext -> Kind -> Maybe String -> m (SBV a)
mkSymSBV VarContext
q Kind
k (Maybe String -> m (SBV a))
-> (String -> Maybe String) -> String -> m (SBV a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just

-- | Generate an unnamed variable
genVar_ :: MonadSymbolic m => VarContext -> Kind -> m (SBV a)
genVar_ :: forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> m (SBV a)
genVar_ VarContext
q Kind
k = VarContext -> Kind -> Maybe String -> m (SBV a)
forall a (m :: * -> *).
MonadSymbolic m =>
VarContext -> Kind -> Maybe String -> m (SBV a)
mkSymSBV VarContext
q Kind
k Maybe String
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 = SVal -> SBV b
forall a. SVal -> SBV a
SBV (SVal -> SBV b) -> (a -> SVal) -> a -> SBV b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> (a -> Either CV (Cached SV)) -> a -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (a -> CV) -> a -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> a -> CV
forall a. Integral a => Kind -> a -> CV
mkConstCV Kind
k

-- | 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)) = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x
genFromCV CV
c                   = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"genFromCV: Unsupported non-integral value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
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 String -> m (SBV a)
genMkSymVar Kind
k VarContext
mbq Maybe String
Nothing  = VarContext -> Kind -> m (SBV a)
forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> m (SBV a)
genVar_ VarContext
mbq Kind
k
genMkSymVar Kind
k VarContext
mbq (Just String
s) = VarContext -> Kind -> String -> m (SBV a)
forall (m :: * -> *) a.
MonadSymbolic m =>
VarContext -> Kind -> String -> m (SBV a)
genVar  VarContext
mbq Kind
k String
s

instance SymVal Bool where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m SBool
mkSymVal = Kind -> VarContext -> Maybe String -> m SBool
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar Kind
KBool
  literal :: Bool -> SBool
literal  = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> (Bool -> SVal) -> Bool -> SBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> SVal
svBool
  fromCV :: CV -> Bool
fromCV   = CV -> Bool
cvToBool

instance SymVal Word8 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV Word8)
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV Word8)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
False Int
8)
  literal :: Word8 -> SBV Word8
literal  = Kind -> Word8 -> SBV Word8
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
False Int
8)
  fromCV :: CV -> Word8
fromCV   = CV -> Word8
forall a. Integral a => CV -> a
genFromCV

instance SymVal Int8 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV Int8)
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV Int8)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
True Int
8)
  literal :: Int8 -> SBV Int8
literal  = Kind -> Int8 -> SBV Int8
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
True Int
8)
  fromCV :: CV -> Int8
fromCV   = CV -> Int8
forall a. Integral a => CV -> a
genFromCV

instance SymVal Word16 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV Word16)
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV Word16)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
False Int
16)
  literal :: Word16 -> SBV Word16
literal  = Kind -> Word16 -> SBV Word16
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
False Int
16)
  fromCV :: CV -> Word16
fromCV   = CV -> Word16
forall a. Integral a => CV -> a
genFromCV

instance SymVal Int16 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV Int16)
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV Int16)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
True Int
16)
  literal :: Int16 -> SBV Int16
literal  = Kind -> Int16 -> SBV Int16
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
True Int
16)
  fromCV :: CV -> Int16
fromCV   = CV -> Int16
forall a. Integral a => CV -> a
genFromCV

instance SymVal Word32 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV Word32)
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV Word32)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
False Int
32)
  literal :: Word32 -> SBV Word32
literal  = Kind -> Word32 -> SBV Word32
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
False Int
32)
  fromCV :: CV -> Word32
fromCV   = CV -> Word32
forall a. Integral a => CV -> a
genFromCV

instance SymVal Int32 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV Int32)
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV Int32)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
True Int
32)
  literal :: Int32 -> SBV Int32
literal  = Kind -> Int32 -> SBV Int32
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
True Int
32)
  fromCV :: CV -> Int32
fromCV   = CV -> Int32
forall a. Integral a => CV -> a
genFromCV

instance SymVal Word64 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV Word64)
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV Word64)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
False Int
64)
  literal :: Word64 -> SBV Word64
literal  = Kind -> Word64 -> SBV Word64
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
False Int
64)
  fromCV :: CV -> Word64
fromCV   = CV -> Word64
forall a. Integral a => CV -> a
genFromCV

instance SymVal Int64 where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV Int64)
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV Int64)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Bool -> Int -> Kind
KBounded Bool
True Int
64)
  literal :: Int64 -> SBV Int64
literal  = Kind -> Int64 -> SBV Int64
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (Bool -> Int -> Kind
KBounded Bool
True Int
64)
  fromCV :: CV -> Int64
fromCV   = CV -> Int64
forall a. Integral a => CV -> a
genFromCV

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

instance SymVal Rational where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV Rational)
mkSymVal                    = Kind -> VarContext -> Maybe String -> m (SBV Rational)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar Kind
KRational
  literal :: Rational -> SBV Rational
literal                     = SVal -> SBV Rational
forall a. SVal -> SBV a
SBV (SVal -> SBV Rational)
-> (Rational -> SVal) -> Rational -> SBV Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KRational  (Either CV (Cached SV) -> SVal)
-> (Rational -> Either CV (Cached SV)) -> Rational -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Rational -> CV) -> Rational -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KRational (CVal -> CV) -> (Rational -> CVal) -> Rational -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> CVal
CRational
  fromCV :: CV -> Rational
fromCV (CV Kind
_ (CRational Rational
r)) = Rational
r
  fromCV CV
c                    = String -> Rational
forall a. HasCallStack => String -> a
error (String -> Rational) -> String -> Rational
forall a b. (a -> b) -> a -> b
$ String
"SymVal.Rational: Unexpected non-rational value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
show CV
c
  minMaxBound :: Maybe (Rational, Rational)
minMaxBound                 = Maybe (Rational, Rational)
forall a. Maybe a
Nothing

instance SymVal AlgReal where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m SReal
mkSymVal                   = Kind -> VarContext -> Maybe String -> m SReal
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar Kind
KReal
  literal :: AlgReal -> SReal
literal                    = SVal -> SReal
forall a. SVal -> SBV a
SBV (SVal -> SReal) -> (AlgReal -> SVal) -> AlgReal -> SReal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KReal (Either CV (Cached SV) -> SVal)
-> (AlgReal -> Either CV (Cached SV)) -> AlgReal -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (AlgReal -> CV) -> AlgReal -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KReal (CVal -> CV) -> (AlgReal -> CVal) -> AlgReal -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlgReal -> CVal
CAlgReal
  fromCV :: CV -> AlgReal
fromCV (CV Kind
_ (CAlgReal AlgReal
a)) = AlgReal
a
  fromCV CV
c                   = String -> AlgReal
forall a. HasCallStack => String -> a
error (String -> AlgReal) -> String -> AlgReal
forall a b. (a -> b) -> a -> b
$ String
"SymVal.AlgReal: Unexpected non-real value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
show CV
c
  minMaxBound :: Maybe (AlgReal, AlgReal)
minMaxBound               = Maybe (AlgReal, AlgReal)
forall a. Maybe a
Nothing

  -- 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 String -> m (SBV Float)
mkSymVal                 = Kind -> VarContext -> Maybe String -> m (SBV Float)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar Kind
KFloat
  literal :: Float -> SBV Float
literal                  = SVal -> SBV Float
forall a. SVal -> SBV a
SBV (SVal -> SBV Float) -> (Float -> SVal) -> Float -> SBV Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KFloat (Either CV (Cached SV) -> SVal)
-> (Float -> Either CV (Cached SV)) -> Float -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Float -> CV) -> Float -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KFloat (CVal -> CV) -> (Float -> CVal) -> Float -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> CVal
CFloat
  fromCV :: CV -> Float
fromCV (CV Kind
_ (CFloat Float
a)) = Float
a
  fromCV CV
c                 = String -> Float
forall a. HasCallStack => String -> a
error (String -> Float) -> String -> Float
forall a b. (a -> b) -> a -> b
$ String
"SymVal.Float: Unexpected non-float value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
show CV
c
  minMaxBound :: Maybe (Float, Float)
minMaxBound              = Maybe (Float, Float)
forall a. Maybe a
Nothing

  -- 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 String -> m (SBV Double)
mkSymVal                  = Kind -> VarContext -> Maybe String -> m (SBV Double)
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar Kind
KDouble
  literal :: Double -> SBV Double
literal                   = SVal -> SBV Double
forall a. SVal -> SBV a
SBV (SVal -> SBV Double) -> (Double -> SVal) -> Double -> SBV Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KDouble (Either CV (Cached SV) -> SVal)
-> (Double -> Either CV (Cached SV)) -> Double -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Double -> CV) -> Double -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
KDouble (CVal -> CV) -> (Double -> CVal) -> Double -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> CVal
CDouble
  fromCV :: CV -> Double
fromCV (CV Kind
_ (CDouble Double
a)) = Double
a
  fromCV CV
c                  = String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ String
"SymVal.Double: Unexpected non-double value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
show CV
c
  minMaxBound :: Maybe (Double, Double)
minMaxBound               = Maybe (Double, Double)
forall a. Maybe a
Nothing

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

instance SymVal a => SymVal [a] where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV [a])
mkSymVal
    | forall a. Typeable a => a -> Bool
isKString @[a] [a]
forall a. HasCallStack => a
undefined = Kind -> VarContext -> Maybe String -> m (SBV [a])
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar Kind
KString
    | Bool
True                     = Kind -> VarContext -> Maybe String -> m (SBV [a])
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Kind -> Kind
KList (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)))

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

  fromCV :: CV -> [a]
fromCV (CV Kind
_ (CString String
a)) = [a] -> Maybe [a] -> [a]
forall a. a -> Maybe a -> a
fromMaybe (String -> [a]
forall a. HasCallStack => String -> a
error String
"SString: Cannot extract a literal string!")
                                        (Dynamic -> Maybe [a]
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic (String -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn String
a))
  fromCV (CV Kind
_ (CList [CVal]
a))   = CV -> a
forall a. SymVal a => CV -> a
fromCV (CV -> a) -> (CVal -> CV) -> CVal -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) (CVal -> a) -> [CVal] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CVal]
a
  fromCV CV
c                  = String -> [a]
forall a. HasCallStack => String -> a
error (String -> [a]) -> String -> [a]
forall a b. (a -> b) -> a -> b
$ String
"SymVal.fromCV: Unexpected non-list value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
show CV
c

  minMaxBound :: Maybe ([a], [a])
minMaxBound               = Maybe ([a], [a])
forall a. Maybe a
Nothing

instance ValidFloat eb sb => HasKind (FloatingPoint eb sb) where
  kindOf :: FloatingPoint eb sb -> Kind
kindOf FloatingPoint eb sb
_ = Int -> Int -> Kind
KFP (Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @eb)) (Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @sb))

instance ValidFloat eb sb => SymVal (FloatingPoint eb sb) where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV (FloatingPoint eb sb))
mkSymVal                   = Kind -> VarContext -> Maybe String -> m (SBV (FloatingPoint eb sb))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Int -> Int -> Kind
KFP (Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @eb)) (Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
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 (Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @eb)) (Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @sb))
                               in SVal -> SBV (FloatingPoint eb sb)
forall a. SVal -> SBV a
SBV (SVal -> SBV (FloatingPoint eb sb))
-> SVal -> SBV (FloatingPoint eb sb)
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV)) -> CV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k (FP -> CVal
CFP FP
r)
  fromCV :: CV -> FloatingPoint eb sb
fromCV  (CV Kind
_ (CFP FP
r))     = FP -> FloatingPoint eb sb
forall (eb :: Nat) (sb :: Nat). FP -> FloatingPoint eb sb
FloatingPoint FP
r
  fromCV  CV
c                  = String -> FloatingPoint eb sb
forall a. HasCallStack => String -> a
error (String -> FloatingPoint eb sb) -> String -> FloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ String
"SymVal.FPR: Unexpected non-arbitrary-precision value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
show CV
c
  minMaxBound :: Maybe (FloatingPoint eb sb, FloatingPoint eb sb)
minMaxBound                = Maybe (FloatingPoint eb sb, FloatingPoint eb sb)
forall a. Maybe a
Nothing

-- | 'SymVal' instance for 'WordN'
instance (KnownNat n, BVIsNonZero n) => SymVal (WordN n) where
   literal :: WordN n -> SBV (WordN n)
literal  WordN n
x = Kind -> WordN n -> SBV (WordN n)
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (WordN n -> Kind
forall a. HasKind a => a -> Kind
kindOf WordN n
x) WordN n
x
   mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV (WordN n))
mkSymVal   = Kind -> VarContext -> Maybe String -> m (SBV (WordN n))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (WordN n -> Kind
forall a. HasKind a => a -> Kind
kindOf (WordN n
forall a. HasCallStack => a
undefined :: WordN n))
   fromCV :: CV -> WordN n
fromCV     = CV -> WordN n
forall a. Integral a => CV -> a
genFromCV

-- | 'SymVal' instance for 'IntN'
instance (KnownNat n, BVIsNonZero n) => SymVal (IntN n) where
   literal :: IntN n -> SBV (IntN n)
literal  IntN n
x = Kind -> IntN n -> SBV (IntN n)
forall a b. Integral a => Kind -> a -> SBV b
genLiteral  (IntN n -> Kind
forall a. HasKind a => a -> Kind
kindOf IntN n
x) IntN n
x
   mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV (IntN n))
mkSymVal   = Kind -> VarContext -> Maybe String -> m (SBV (IntN n))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (IntN n -> Kind
forall a. HasKind a => a -> Kind
kindOf (IntN n
forall a. HasCallStack => a
undefined :: IntN n))
   fromCV :: CV -> IntN n
fromCV     = CV -> IntN n
forall a. Integral a => CV -> a
genFromCV

toCV :: SymVal a => a -> CVal
toCV :: forall a. SymVal a => a -> CVal
toCV a
a = case a -> SBV a
forall a. SymVal a => a -> SBV a
literal a
a of
           SBV (SVal Kind
_ (Left CV
cv)) -> CV -> CVal
cvVal CV
cv
           SBV a
_                      -> String -> CVal
forall a. HasCallStack => String -> a
error String
"SymVal.toCV: Impossible happened, couldn't produce a concrete value"

mkCVTup :: Int -> Kind -> [CVal] -> SBV a
mkCVTup :: forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
i k :: Kind
k@(KTuple [Kind]
ks) [CVal]
cs
  | Int
lks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lcs Bool -> Bool -> Bool
&& Int
lks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV)) -> CV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k (CVal -> CV) -> CVal -> CV
forall a b. (a -> b) -> a -> b
$ [CVal] -> CVal
CTuple [CVal]
cs
  | Bool
True
  = String -> SBV a
forall a. HasCallStack => String -> a
error (String -> SBV a) -> String -> SBV a
forall a b. (a -> b) -> a -> b
$ String
"SymVal.mkCVTup: Impossible happened. Malformed tuple received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Kind) -> String
forall a. Show a => a -> String
show (Int
i, Kind
k)
   where lks :: Int
lks = [Kind] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
ks
         lcs :: Int
lcs = [CVal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CVal]
cs
mkCVTup Int
i Kind
k [CVal]
_
  = String -> SBV a
forall a. HasCallStack => String -> a
error (String -> SBV a) -> String -> SBV a
forall a b. (a -> b) -> a -> b
$ String
"SymVal.mkCVTup: Impossible happened. Non-tuple received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Kind) -> String
forall a. Show a => a -> String
show (Int
i, Kind
k)

fromCVTup :: Int -> CV -> [CV]
fromCVTup :: Int -> CV -> [CV]
fromCVTup Int
i inp :: CV
inp@(CV (KTuple [Kind]
ks) (CTuple [CVal]
cs))
   | Int
lks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lcs Bool -> Bool -> Bool
&& Int
lks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i
   = (Kind -> CVal -> CV) -> [Kind] -> [CVal] -> [CV]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Kind -> CVal -> CV
CV [Kind]
ks [CVal]
cs
   | Bool
True
   = String -> [CV]
forall a. HasCallStack => String -> a
error (String -> [CV]) -> String -> [CV]
forall a b. (a -> b) -> a -> b
$ String
"SymVal.fromCTup: Impossible happened. Malformed tuple received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, CV) -> String
forall a. Show a => a -> String
show (Int
i, CV
inp)
   where lks :: Int
lks = [Kind] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kind]
ks
         lcs :: Int
lcs = [CVal] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CVal]
cs
fromCVTup Int
i CV
inp = String -> [CV]
forall a. HasCallStack => String -> a
error (String -> [CV]) -> String -> [CV]
forall a b. (a -> b) -> a -> b
$ String
"SymVal.fromCVTup: Impossible happened. Non-tuple received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, CV) -> String
forall a. Show a => a -> String
show (Int
i, CV
inp)

instance (SymVal a, SymVal b) => SymVal (Either a b) where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV (Either a b))
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV (Either a b))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Proxy (Either a b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Either a b)))

  literal :: Either a b -> SBV (Either a b)
literal Either a b
s
    | Left  a
a <- Either a b
s = Either CVal CVal -> SBV (Either a b)
mk (Either CVal CVal -> SBV (Either a b))
-> Either CVal CVal -> SBV (Either a b)
forall a b. (a -> b) -> a -> b
$ CVal -> Either CVal CVal
forall a b. a -> Either a b
Left  (a -> CVal
forall a. SymVal a => a -> CVal
toCV a
a)
    | Right b
b <- Either a b
s = Either CVal CVal -> SBV (Either a b)
mk (Either CVal CVal -> SBV (Either a b))
-> Either CVal CVal -> SBV (Either a b)
forall a b. (a -> b) -> a -> b
$ CVal -> Either CVal CVal
forall a b. b -> Either a b
Right (b -> CVal
forall a. SymVal a => a -> CVal
toCV b
b)
    where k :: Kind
k  = Proxy (Either a b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Either a b))

          mk :: Either CVal CVal -> SBV (Either a b)
mk = SVal -> SBV (Either a b)
forall a. SVal -> SBV a
SBV (SVal -> SBV (Either a b))
-> (Either CVal CVal -> SVal)
-> Either CVal CVal
-> SBV (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> (Either CVal CVal -> Either CV (Cached SV))
-> Either CVal CVal
-> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Either CVal CVal -> CV)
-> Either CVal CVal
-> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
k (CVal -> CV)
-> (Either CVal CVal -> CVal) -> Either CVal CVal -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either CVal CVal -> CVal
CEither

  fromCV :: CV -> Either a b
fromCV (CV (KEither Kind
k1 Kind
_ ) (CEither (Left CVal
c)))  = a -> Either a b
forall a b. a -> Either a b
Left  (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ CV -> a
forall a. SymVal a => CV -> a
fromCV (CV -> a) -> CV -> a
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k1 CVal
c
  fromCV (CV (KEither Kind
_  Kind
k2) (CEither (Right CVal
c))) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> b -> Either a b
forall a b. (a -> b) -> a -> b
$ CV -> b
forall a. SymVal a => CV -> a
fromCV (CV -> b) -> CV -> b
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k2 CVal
c
  fromCV CV
bad                                      = String -> Either a b
forall a. HasCallStack => String -> a
error (String -> Either a b) -> String -> Either a b
forall a b. (a -> b) -> a -> b
$ String
"SymVal.fromCV (Either): Malformed either received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
show CV
bad

  minMaxBound :: Maybe (Either a b, Either a b)
minMaxBound = Maybe (Either a b, Either a b)
forall a. Maybe a
Nothing

instance SymVal a => SymVal (Maybe a) where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV (Maybe a))
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV (Maybe a))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Proxy (Maybe a) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Maybe a)))

  literal :: Maybe a -> SBV (Maybe a)
literal Maybe a
s
    | Maybe a
Nothing <- Maybe a
s = Maybe CVal -> SBV (Maybe a)
mk Maybe CVal
forall a. Maybe a
Nothing
    | Just  a
a <- Maybe a
s = Maybe CVal -> SBV (Maybe a)
mk (Maybe CVal -> SBV (Maybe a)) -> Maybe CVal -> SBV (Maybe a)
forall a b. (a -> b) -> a -> b
$ CVal -> Maybe CVal
forall a. a -> Maybe a
Just (a -> CVal
forall a. SymVal a => a -> CVal
toCV a
a)
    where k :: Kind
k = Proxy (Maybe a) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Maybe a))

          mk :: Maybe CVal -> SBV (Maybe a)
mk = SVal -> SBV (Maybe a)
forall a. SVal -> SBV a
SBV (SVal -> SBV (Maybe a))
-> (Maybe CVal -> SVal) -> Maybe CVal -> SBV (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> (Maybe CVal -> Either CV (Cached SV)) -> Maybe CVal -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (Maybe CVal -> CV) -> Maybe CVal -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
k (CVal -> CV) -> (Maybe CVal -> CVal) -> Maybe CVal -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CVal -> CVal
CMaybe

  fromCV :: CV -> Maybe a
fromCV (CV (KMaybe Kind
_) (CMaybe Maybe CVal
Nothing))  = Maybe a
forall a. Maybe a
Nothing
  fromCV (CV (KMaybe Kind
k) (CMaybe (Just CVal
x))) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ CV -> a
forall a. SymVal a => CV -> a
fromCV (CV -> a) -> CV -> a
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k CVal
x
  fromCV CV
bad                               = String -> Maybe a
forall a. HasCallStack => String -> a
error (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ String
"SymVal.fromCV (Maybe): Malformed sum received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
show CV
bad

  minMaxBound :: Maybe (Maybe a, Maybe a)
minMaxBound = Maybe (Maybe a, Maybe a)
forall a. Maybe a
Nothing

instance (HasKind a, HasKind b, SymVal a, SymVal b) => SymVal (ArrayModel a b) where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV (ArrayModel a b))
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV (ArrayModel a b))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Kind -> Kind -> Kind
KArray (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) (Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)))

  -- If the table has duplicate entries for keys, then the first one takes precedence.
  -- That is, [(a, v1), (a, v2)] is equivalent to [(a, v1)]. The best way to think about
  -- this is as a "stack" of writes. [(a, v1), (a, v2)] means we first "wrote" v2 at
  -- a, and then wrote v1 at the same address; so the first write of v2 got overwritten.
  literal :: ArrayModel a b -> SBV (ArrayModel a b)
literal (ArrayModel [(a, b)]
tbl b
def) = SVal -> SBV (ArrayModel a b)
forall a. SVal -> SBV a
SBV (SVal -> SBV (ArrayModel a b))
-> (CVal -> SVal) -> CVal -> SBV (ArrayModel a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
knd (Either CV (Cached SV) -> SVal)
-> (CVal -> Either CV (Cached SV)) -> CVal -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV))
-> (CVal -> CV) -> CVal -> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> CVal -> CV
CV Kind
knd (CVal -> SBV (ArrayModel a b)) -> CVal -> SBV (ArrayModel a b)
forall a b. (a -> b) -> a -> b
$ ArrayModel CVal CVal -> CVal
CArray (ArrayModel CVal CVal -> CVal) -> ArrayModel CVal CVal -> CVal
forall a b. (a -> b) -> a -> b
$ [(CVal, CVal)] -> CVal -> ArrayModel CVal CVal
forall a b. [(a, b)] -> b -> ArrayModel a b
ArrayModel [(a -> CVal
forall a. SymVal a => a -> CVal
toCV a
k, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v) | (a
k, b
v) <- [(a, b)]
tbl] (b -> CVal
forall a. SymVal a => a -> CVal
toCV b
def)
    where knd :: Kind
knd = Proxy (ArrayModel a b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(ArrayModel a b))

  fromCV :: CV -> ArrayModel a b
fromCV (CV (KArray Kind
k1 Kind
k2) (CArray (ArrayModel [(CVal, CVal)]
assocs CVal
def))) = [(a, b)] -> b -> ArrayModel a b
forall a b. [(a, b)] -> b -> ArrayModel a b
ArrayModel [(CV -> a
forall a. SymVal a => CV -> a
fromCV (Kind -> CVal -> CV
CV Kind
k1 CVal
a), CV -> b
forall a. SymVal a => CV -> a
fromCV (Kind -> CVal -> CV
CV Kind
k2 CVal
b)) | (CVal
a, CVal
b) <- [(CVal, CVal)]
assocs]
                                                                           (CV -> b
forall a. SymVal a => CV -> a
fromCV (Kind -> CVal -> CV
CV Kind
k2 CVal
def))

  fromCV CV
bad = String -> ArrayModel a b
forall a. HasCallStack => String -> a
error (String -> ArrayModel a b) -> String -> ArrayModel a b
forall a b. (a -> b) -> a -> b
$ String
"SymVal.fromCV (SArray): Malformed array received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CV -> String
forall a. Show a => a -> String
show CV
bad

  minMaxBound :: Maybe (ArrayModel a b, ArrayModel a b)
minMaxBound = Maybe (ArrayModel a b, ArrayModel a b)
forall a. Maybe a
Nothing

instance (Arbitrary a, Arbitrary b) => Arbitrary (ArrayModel a b) where
  arbitrary :: Gen (ArrayModel a b)
arbitrary = [(a, b)] -> b -> ArrayModel a b
forall a b. [(a, b)] -> b -> ArrayModel a b
ArrayModel ([(a, b)] -> b -> ArrayModel a b)
-> Gen [(a, b)] -> Gen (b -> ArrayModel a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [(a, b)]
forall a. Arbitrary a => Gen a
arbitrary Gen (b -> ArrayModel a b) -> Gen b -> Gen (ArrayModel a b)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen b
forall a. Arbitrary a => Gen a
arbitrary

instance (Ord a, SymVal a) => SymVal (RCSet a) where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV (RCSet a))
mkSymVal = Kind -> VarContext -> Maybe String -> m (SBV (RCSet a))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Proxy (RCSet a) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(RCSet a)))

  literal :: RCSet a -> SBV (RCSet a)
literal RCSet a
eur = SVal -> SBV (RCSet a)
forall a. SVal -> SBV a
SBV (SVal -> SBV (RCSet a)) -> SVal -> SBV (RCSet a)
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left (CV -> Either CV (Cached SV)) -> CV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ Kind -> CVal -> CV
CV Kind
k (CVal -> CV) -> CVal -> CV
forall a b. (a -> b) -> a -> b
$ RCSet CVal -> CVal
CSet (RCSet CVal -> CVal) -> RCSet CVal -> CVal
forall a b. (a -> b) -> a -> b
$ Set CVal -> RCSet CVal
dir (Set CVal -> RCSet CVal) -> Set CVal -> RCSet CVal
forall a b. (a -> b) -> a -> b
$ (a -> CVal) -> Set a -> Set CVal
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> CVal
forall a. SymVal a => a -> CVal
toCV Set a
s
    where (Set CVal -> RCSet CVal
dir, Set a
s) = case RCSet a
eur of
                      RegularSet Set a
x    -> (Set CVal -> RCSet CVal
forall a. Set a -> RCSet a
RegularSet,    Set a
x)
                      ComplementSet Set a
x -> (Set CVal -> RCSet CVal
forall a. Set a -> RCSet a
ComplementSet, Set a
x)
          k :: Kind
k        = Proxy (RCSet a) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(RCSet a))

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

  minMaxBound :: Maybe (RCSet a, RCSet a)
minMaxBound = Maybe (RCSet a, RCSet a)
forall a. Maybe a
Nothing

-- | SymVal for 0-tuple (i.e., unit)
instance SymVal () where
  mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV ())
mkSymVal   = Kind -> VarContext -> Maybe String -> m (SBV ())
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar ([Kind] -> Kind
KTuple [])
  literal :: () -> SBV ()
literal () = Int -> Kind -> [CVal] -> SBV ()
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
0   (Proxy () -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @())) []
  fromCV :: CV -> ()
fromCV CV
cv  = Int -> CV -> [CV]
fromCVTup Int
0 CV
cv [CV] -> () -> ()
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 String -> m (SBV (a, b))
mkSymVal         = Kind -> VarContext -> Maybe String -> m (SBV (a, b))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Proxy (a, b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b)))
   literal :: (a, b) -> SBV (a, b)
literal (a
v1, b
v2) = Int -> Kind -> [CVal] -> SBV (a, b)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
2   (Proxy (a, b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2]
   fromCV :: CV -> (a, b)
fromCV  CV
cv       = let ~[CV
v1, CV
v2] = Int -> CV -> [CV]
fromCVTup Int
2 CV
cv
                      in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2)

   minMaxBound :: Maybe ((a, b), (a, b))
minMaxBound = Maybe ((a, b), (a, b))
forall a. Maybe a
Nothing

-- | SymVal for 3-tuples
instance (SymVal a, SymVal b, SymVal c) => SymVal (a, b, c) where
   mkSymVal :: forall (m :: * -> *).
MonadSymbolic m =>
VarContext -> Maybe String -> m (SBV (a, b, c))
mkSymVal             = Kind -> VarContext -> Maybe String -> m (SBV (a, b, c))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Proxy (a, b, c) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c)))
   literal :: (a, b, c) -> SBV (a, b, c)
literal (a
v1, b
v2, c
v3) = Int -> Kind -> [CVal] -> SBV (a, b, c)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
3   (Proxy (a, b, c) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2, c -> CVal
forall a. SymVal a => a -> CVal
toCV c
v3]
   fromCV :: CV -> (a, b, c)
fromCV  CV
cv           = let ~[CV
v1, CV
v2, CV
v3] = Int -> CV -> [CV]
fromCVTup Int
3 CV
cv
                          in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2, CV -> c
forall a. SymVal a => CV -> a
fromCV CV
v3)
   minMaxBound :: Maybe ((a, b, c), (a, b, c))
minMaxBound          = Maybe ((a, b, c), (a, b, c))
forall a. Maybe a
Nothing

-- | 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 String -> m (SBV (a, b, c, d))
mkSymVal                 = Kind -> VarContext -> Maybe String -> m (SBV (a, b, c, d))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Proxy (a, b, c, d) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d)))
   literal :: (a, b, c, d) -> SBV (a, b, c, d)
literal (a
v1, b
v2, c
v3, d
v4) = Int -> Kind -> [CVal] -> SBV (a, b, c, d)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
4   (Proxy (a, b, c, d) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2, c -> CVal
forall a. SymVal a => a -> CVal
toCV c
v3, d -> CVal
forall a. SymVal a => a -> CVal
toCV d
v4]
   fromCV :: CV -> (a, b, c, d)
fromCV  CV
cv               = let ~[CV
v1, CV
v2, CV
v3, CV
v4] = Int -> CV -> [CV]
fromCVTup Int
4 CV
cv
                              in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2, CV -> c
forall a. SymVal a => CV -> a
fromCV CV
v3, CV -> d
forall a. SymVal a => CV -> a
fromCV CV
v4)
   minMaxBound :: Maybe ((a, b, c, d), (a, b, c, d))
minMaxBound              = Maybe ((a, b, c, d), (a, b, c, d))
forall a. Maybe a
Nothing

-- | 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 String -> m (SBV (a, b, c, d, e))
mkSymVal                     = Kind -> VarContext -> Maybe String -> m (SBV (a, b, c, d, e))
forall (m :: * -> *) a.
MonadSymbolic m =>
Kind -> VarContext -> Maybe String -> m (SBV a)
genMkSymVar (Proxy (a, b, c, d, e) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e)))
   literal :: (a, b, c, d, e) -> SBV (a, b, c, d, e)
literal (a
v1, b
v2, c
v3, d
v4, e
v5) = Int -> Kind -> [CVal] -> SBV (a, b, c, d, e)
forall a. Int -> Kind -> [CVal] -> SBV a
mkCVTup Int
5   (Proxy (a, b, c, d, e) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(a, b, c, d, e))) [a -> CVal
forall a. SymVal a => a -> CVal
toCV a
v1, b -> CVal
forall a. SymVal a => a -> CVal
toCV b
v2, c -> CVal
forall a. SymVal a => a -> CVal
toCV c
v3, d -> CVal
forall a. SymVal a => a -> CVal
toCV d
v4, e -> CVal
forall a. SymVal a => a -> CVal
toCV e
v5]
   fromCV :: CV -> (a, b, c, d, e)
fromCV  CV
cv                   = let ~[CV
v1, CV
v2, CV
v3, CV
v4, CV
v5] = Int -> CV -> [CV]
fromCVTup Int
5 CV
cv
                                  in (CV -> a
forall a. SymVal a => CV -> a
fromCV CV
v1, CV -> b
forall a. SymVal a => CV -> a
fromCV CV
v2, CV -> c
forall a. SymVal a => CV -> a
fromCV CV
v3, CV -> d
forall a. SymVal a => CV -> a
fromCV CV
v4, CV -> e
forall a. SymVal a => CV -> a
fromCV CV
v5)
   minMaxBound :: Maybe ((a, b, c, d, e), (a, b, c, d, e))
minMaxBound                  = Maybe ((a, b, c, d, e), (a, b, c, d, e))
forall a. Maybe a
Nothing

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

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

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

instance IsString SString where
  fromString :: String -> SString
fromString = String -> SString
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 => String -> m SBool
sBool = String -> m SBool
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
String -> m (SBV a)
forall (m :: * -> *). MonadSymbolic m => String -> m SBool
symbolic

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

-- | Generalization of 'Data.SBV.sFloatingPoint'
sFloatingPoint :: ValidFloat eb sb => String -> Symbolic (SFloatingPoint eb sb)
sFloatingPoint :: forall (eb :: Nat) (sb :: Nat).
ValidFloat eb sb =>
String -> Symbolic (SFloatingPoint eb sb)
sFloatingPoint = String -> SymbolicT IO (SBV (FloatingPoint eb sb))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
String -> m (SBV a)
forall (m :: * -> *).
MonadSymbolic m =>
String -> m (SBV (FloatingPoint eb sb))
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_ = SymbolicT IO (SBV (FloatingPoint eb sb))
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
forall (m :: * -> *).
MonadSymbolic m =>
m (SBV (FloatingPoint eb sb))
free_

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

-- | Generalization of 'Data.SBV.sWord'
sWord :: (KnownNat n, BVIsNonZero n) => MonadSymbolic m => String -> m (SWord n)
sWord :: forall (n :: Nat) (m :: * -> *).
(KnownNat n, BVIsNonZero n, MonadSymbolic m) =>
String -> m (SWord n)
sWord = String -> m (SBV (WordN n))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
String -> m (SBV a)
forall (m :: * -> *).
MonadSymbolic m =>
String -> m (SBV (WordN n))
symbolic

-- | Generalization of 'Data.SBV.sWord_'
sWord_ :: (KnownNat n, BVIsNonZero n) => MonadSymbolic m => m (SWord n)
sWord_ :: forall (n :: Nat) (m :: * -> *).
(KnownNat n, BVIsNonZero n, MonadSymbolic m) =>
m (SWord n)
sWord_ = m (SBV (WordN n))
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
forall (m :: * -> *). MonadSymbolic m => m (SBV (WordN n))
free_

-- | Generalization of 'Data.SBV.sWord64s'
sWords :: (KnownNat n, BVIsNonZero n) => MonadSymbolic m => [String] -> m [SWord n]
sWords :: forall (n :: Nat) (m :: * -> *).
(KnownNat n, BVIsNonZero n, MonadSymbolic m) =>
[String] -> m [SWord n]
sWords = [String] -> m [SBV (WordN n)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[String] -> m [SBV a]
forall (m :: * -> *).
MonadSymbolic m =>
[String] -> m [SBV (WordN n)]
symbolics

-- | Generalization of 'Data.SBV.sInt'
sInt :: (KnownNat n, BVIsNonZero n) => MonadSymbolic m => String -> m (SInt n)
sInt :: forall (n :: Nat) (m :: * -> *).
(KnownNat n, BVIsNonZero n, MonadSymbolic m) =>
String -> m (SInt n)
sInt = String -> m (SBV (IntN n))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
String -> m (SBV a)
forall (m :: * -> *). MonadSymbolic m => String -> m (SBV (IntN n))
symbolic

-- | Generalization of 'Data.SBV.sInt_'
sInt_ :: (KnownNat n, BVIsNonZero n) => MonadSymbolic m => m (SInt n)
sInt_ :: forall (n :: Nat) (m :: * -> *).
(KnownNat n, BVIsNonZero n, MonadSymbolic m) =>
m (SInt n)
sInt_ = m (SBV (IntN n))
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
forall (m :: * -> *). MonadSymbolic m => m (SBV (IntN n))
free_

-- | Generalization of 'Data.SBV.sInts'
sInts :: (KnownNat n, BVIsNonZero n) => MonadSymbolic m => [String] -> m [SInt n]
sInts :: forall (n :: Nat) (m :: * -> *).
(KnownNat n, BVIsNonZero n, MonadSymbolic m) =>
[String] -> m [SInt n]
sInts = [String] -> m [SBV (IntN n)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[String] -> m [SBV a]
forall (m :: * -> *).
MonadSymbolic m =>
[String] -> m [SBV (IntN n)]
symbolics

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

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

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

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

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

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

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

-- | Generalization of 'Data.SBV.sAray'
sArray :: (SymVal a, SymVal b, MonadSymbolic m) => String -> m (SArray a b)
sArray :: forall a b (m :: * -> *).
(SymVal a, SymVal b, MonadSymbolic m) =>
String -> m (SArray a b)
sArray = String -> m (SBV (ArrayModel a b))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
String -> m (SBV a)
forall (m :: * -> *).
MonadSymbolic m =>
String -> m (SBV (ArrayModel a b))
symbolic

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

-- | Generalization of 'Data.SBV.sLists'
sArrays :: (SymVal a, SymVal b, MonadSymbolic m) => [String] -> m [SArray a b]
sArrays :: forall a b (m :: * -> *).
(SymVal a, SymVal b, MonadSymbolic m) =>
[String] -> m [SArray a b]
sArrays = [String] -> m [SBV (ArrayModel a b)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[String] -> m [SBV a]
forall (m :: * -> *).
MonadSymbolic m =>
[String] -> m [SBV (ArrayModel a b)]
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) =>
String -> m (SBV tup)
sTuple = String -> m (SBV tup)
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
String -> m (SBV a)
forall (m :: * -> *). MonadSymbolic m => String -> m (SBV tup)
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_ = m (SBV tup)
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
forall (m :: * -> *). MonadSymbolic m => m (SBV tup)
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) =>
[String] -> m [SBV tup]
sTuples = [String] -> m [SBV tup]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[String] -> m [SBV a]
forall (m :: * -> *). MonadSymbolic m => [String] -> m [SBV tup]
symbolics

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

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

-- | Generalization of 'Data.SBV.sRationals'
sRationals :: MonadSymbolic m => [String] -> m [SRational]
sRationals :: forall (m :: * -> *).
MonadSymbolic m =>
[String] -> m [SBV Rational]
sRationals = [String] -> m [SBV Rational]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[String] -> m [SBV a]
forall (m :: * -> *).
MonadSymbolic m =>
[String] -> m [SBV Rational]
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) =>
String -> m (SEither a b)
sEither = String -> m (SBV (Either a b))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
String -> m (SBV a)
forall (m :: * -> *).
MonadSymbolic m =>
String -> m (SBV (Either a b))
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_ = m (SBV (Either a b))
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
forall (m :: * -> *). MonadSymbolic m => m (SBV (Either a b))
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) =>
[String] -> m [SEither a b]
sEithers = [String] -> m [SBV (Either a b)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[String] -> m [SBV a]
forall (m :: * -> *).
MonadSymbolic m =>
[String] -> m [SBV (Either a b)]
symbolics

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

-- | Generalization of 'Data.SBV.sMaybes'
sMaybes :: (SymVal a, MonadSymbolic m) => [String] -> m [SMaybe a]
sMaybes :: forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[String] -> m [SMaybe a]
sMaybes = [String] -> m [SBV (Maybe a)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[String] -> m [SBV a]
forall (m :: * -> *).
MonadSymbolic m =>
[String] -> m [SBV (Maybe 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) =>
String -> m (SSet a)
sSet = String -> m (SBV (RCSet a))
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
String -> m (SBV a)
forall (m :: * -> *).
MonadSymbolic m =>
String -> m (SBV (RCSet 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_ = m (SBV (RCSet a))
forall a (m :: * -> *). (SymVal a, MonadSymbolic m) => m (SBV a)
forall (m :: * -> *). MonadSymbolic m => m (SBV (RCSet 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) =>
[String] -> m [SSet a]
sSets = [String] -> m [SBV (RCSet a)]
forall a (m :: * -> *).
(SymVal a, MonadSymbolic m) =>
[String] -> m [SBV a]
forall (m :: * -> *).
MonadSymbolic m =>
[String] -> m [SBV (RCSet a)]
symbolics

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

-- | 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 <- SReal -> Maybe AlgReal
forall a. SymVal a => SBV a -> Maybe a
unliteral SReal
x, AlgReal -> Bool
isExactRational AlgReal
i
  = Integer -> SInteger
forall a. SymVal a => a -> SBV a
literal (Integer -> SInteger) -> Integer -> SInteger
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (AlgReal -> Rational
forall a. Real a => a -> Rational
toRational AlgReal
i)
  | Bool
True
  = SVal -> SInteger
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KUnbounded (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
y)))
  where y :: State -> IO SV
y State
st = do SV
xsv <- State -> SReal -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SReal
x
                  State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KUnbounded (Op -> [SV] -> SBVExpr
SBVApp (Kind -> Kind -> Op
KindCast Kind
KReal Kind
KUnbounded) [SV
xsv])

-- | Convert an SReal to an SInteger, truncating version.
sRealToSIntegerTruncate :: SReal -> SInteger
sRealToSIntegerTruncate :: SReal -> SInteger
sRealToSIntegerTruncate SReal
x = SBool -> SInteger -> SInteger -> SInteger
forall a. Mergeable a => SBool -> a -> a -> a
ite (SReal
x SReal -> SReal -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< SReal
0) (SReal -> SInteger
sRealToSInteger SReal
x) (- (SReal -> SInteger
sRealToSInteger (- SReal
x)))

-- | 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 => String -> SBV a -> SBV a
label String
m SBV a
x
   | Just a
_ <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x = SBV a
x
   | Bool
True                  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k    = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
        r :: State -> IO SV
r State
st = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
                  State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Label String
m) [SV
xsv])


-- | 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.
--
-- NB. If the observed expression happens under a SBV-lambda expression, then it is silently ignored; since
-- there's no way to access the value of such a value.
observeIf :: SymVal a => (a -> Bool) -> String -> SBV a -> SBV a
observeIf :: forall a. SymVal a => (a -> Bool) -> String -> SBV a -> SBV a
observeIf a -> Bool
cond String
m SBV a
x
  | Just String
bad <- String -> Maybe String
checkObservableName String
m
  = String -> SBV a
forall a. HasCallStack => String -> a
error String
bad
  | Bool
True
  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
        r :: State -> IO SV
r State
st = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (String -> SBV a -> SBV a
forall a. SymVal a => String -> SBV a -> SBV a
label (String
"Observing: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
m) SBV a
x)
                  State -> String -> (CV -> Bool) -> SV -> IO ()
recordObservable State
st String
m (a -> Bool
cond (a -> Bool) -> (CV -> a) -> CV -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CV -> a
forall a. SymVal a => CV -> a
fromCV) SV
xsv
                  SV -> IO SV
forall a. a -> IO a
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 => String -> SBV a -> SBV a
observe = (a -> Bool) -> String -> SBV a -> SBV a
forall a. SymVal a => (a -> Bool) -> String -> SBV a -> SBV a
observeIf (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)

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

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

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


{- 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 (HasKind a, SymVal a) => EqSymbolic (SBV a) where
  SBV SVal
x .== :: SBV a -> SBV a -> SBool
.== SBV SVal
y = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svEqual SVal
x SVal
y)
  SBV SVal
x ./= :: SBV a -> SBV a -> SBool
./= SBV SVal
y = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svNotEqual SVal
x SVal
y)

  SBV SVal
x .=== :: SBV a -> SBV a -> SBool
.=== SBV SVal
y = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svStrongEqual SVal
x SVal
y)

  -- 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 | (SBV a -> Bool) -> [SBV a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBV a -> Bool
forall {a}. SBV a -> Bool
isConc [SBV a]
xs                             = [SBV a] -> SBool
forall {a}. EqSymbolic a => [a] -> SBool
checkDiff [SBV a]
xs
              | [SBV SVal
a, SBV SVal
b] <- [SBV a]
xs, SVal
a SVal -> SVal -> Bool
`is` Bool -> SVal
svBool Bool
True  = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ SVal -> SVal
svNot SVal
b
              | [SBV SVal
a, SBV SVal
b] <- [SBV a]
xs, SVal
b SVal -> SVal -> Bool
`is` Bool -> SVal
svBool Bool
True  = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ SVal -> SVal
svNot SVal
a
              | [SBV SVal
a, SBV SVal
b] <- [SBV a]
xs, SVal
a SVal -> SVal -> Bool
`is` Bool -> SVal
svBool Bool
False = SVal -> SBool
forall a. SVal -> SBV a
SBV SVal
b
              | [SBV SVal
a, SBV SVal
b] <- [SBV a]
xs, SVal
b SVal -> SVal -> Bool
`is` Bool -> SVal
svBool Bool
False = SVal -> SBool
forall a. SVal -> SBV a
SBV SVal
a
              -- 3 booleans can't be distinct!
              | (SBV a
x : SBV a
_ : SBV a
_ : [SBV a]
_) <- [SBV a]
xs, SBV a -> Bool
forall {a}. SBV a -> Bool
isBool SBV a
x           = SBool
sFalse
              | Bool
True                                      = SVal -> SBool
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
    where r :: State -> IO SV
r State
st = do [SV]
xsv <- (SBV a -> IO SV) -> [SBV a] -> IO [SV]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st) [SBV a]
xs
                    State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool (Op -> [SV] -> SBVExpr
SBVApp Op
NotEqual [SV]
xsv)

          -- 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) = (a -> SBool) -> [a] -> SBool
forall a. (a -> SBool) -> [a] -> SBool
sAll (a
a a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
./=) [a]
as SBool -> SBool -> SBool
.&& [a] -> SBool
checkDiff [a]
as

          -- 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) (Kind, CV) -> (Kind, CV) -> Bool
forall a. Eq a => a -> a -> Bool
== (Kind
k2, CV
c2)
          SVal
_                 `is` SVal
_                 = Bool
False

          isBool :: SBV a -> Bool
isBool (SBV (SVal Kind
KBool Either CV (Cached SV)
_)) = Bool
True
          isBool SBV a
_                    = Bool
False

  -- Custom version of distinctExcept that generates better code for base types
  distinctExcept :: [SBV a] -> [SBV a] -> SBool
distinctExcept []  [SBV a]
_       = SBool
sTrue
  distinctExcept [SBV a
_] [SBV a]
_       = SBool
sTrue
  distinctExcept [SBV a]
es  [SBV a]
ignored
    | (SBV a -> Bool) -> [SBV a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBV a -> Bool
forall {a}. SBV a -> Bool
isConc ([SBV a]
es [SBV a] -> [SBV a] -> [SBV a]
forall a. [a] -> [a] -> [a]
++ [SBV a]
ignored)
    = [SBV a] -> SBool
forall {a}. EqSymbolic a => [a] -> SBool
distinct ((SBV a -> Bool) -> [SBV a] -> [SBV a]
forall a. (a -> Bool) -> [a] -> [a]
filter SBV a -> Bool
ignoreConc [SBV a]
es)
    | Bool
True
    = SVal -> SBool
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
    where ignoreConc :: SBV a -> Bool
ignoreConc SBV a
x = case SBV a
x SBV a -> [SBV a] -> SBool
forall a. EqSymbolic a => a -> [a] -> SBool
`sElem` [SBV a]
ignored of
                           SBV (SVal Kind
KBool (Left CV
cv)) -> CV -> Bool
cvToBool CV
cv
                           SBool
_                          -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"distinctExcept: Impossible happened, concrete sElem failed: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([SBV a], [SBV a], SBV a) -> String
forall a. Show a => a -> String
show ([SBV a]
es, [SBV a]
ignored, SBV a
x)

          r :: State -> IO SV
r State
st = do let incr :: SBV a -> SBV (ArrayModel a Integer) -> SInteger
incr SBV a
x SBV (ArrayModel a Integer)
table = SBool -> SInteger -> SInteger -> SInteger
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
x SBV a -> [SBV a] -> SBool
forall a. EqSymbolic a => a -> [a] -> SBool
`sElem` [SBV a]
ignored) (SInteger
0 :: SInteger) (SInteger
1 SInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
+ SBV (ArrayModel a Integer) -> SBV a -> SInteger
forall {a} {a} {a}. SBV a -> SBV a -> SBV a
readArrayNoEq SBV (ArrayModel a Integer)
table SBV a
x)

                        initArray :: SArray a Integer
                        initArray :: SBV (ArrayModel a Integer)
initArray = (SBV a -> SInteger) -> SBV (ArrayModel a Integer)
forall a b. (SymVal a, HasKind b) => (SBV a -> SBV b) -> SArray a b
lambdaArray (SInteger -> SBV a -> SInteger
forall a b. a -> b -> a
const SInteger
0)

                        finalArray :: SBV (ArrayModel a Integer)
finalArray = (SBV (ArrayModel a Integer) -> SBV a -> SBV (ArrayModel a Integer))
-> SBV (ArrayModel a Integer)
-> [SBV a]
-> SBV (ArrayModel a Integer)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\SBV (ArrayModel a Integer)
table SBV a
x -> SBV (ArrayModel a Integer)
-> SBV a -> SInteger -> SBV (ArrayModel a Integer)
forall key.
HasKind key =>
SArray key Integer -> SBV key -> SInteger -> SArray key Integer
writeArrayNoKnd SBV (ArrayModel a Integer)
table SBV a
x (SBV a -> SBV (ArrayModel a Integer) -> SInteger
incr SBV a
x SBV (ArrayModel a Integer)
table)) SBV (ArrayModel a Integer)
initArray [SBV a]
es

                    State -> SBool -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBool -> IO SV) -> SBool -> IO SV
forall a b. (a -> b) -> a -> b
$ (SBV a -> SBool) -> [SBV a] -> SBool
forall a. (a -> SBool) -> [a] -> SBool
sAll (\SBV a
e -> SBV (ArrayModel a Integer) -> SBV a -> SInteger
forall {a} {a} {a}. SBV a -> SBV a -> SBV a
readArrayNoEq SBV (ArrayModel a Integer)
finalArray SBV a
e SInteger -> SInteger -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<= (SInteger
1 :: SInteger)) [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

          -- Version of readArray that doesn't have the Eq constraint, since we don't have it here
          readArrayNoEq :: SBV a -> SBV a -> SBV a
readArrayNoEq SBV a
array SBV a
key = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> (Cached SV -> SVal) -> Cached SV -> SBV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KUnbounded (Either CV (Cached SV) -> SVal)
-> (Cached SV -> Either CV (Cached SV)) -> Cached SV -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> SBV a) -> Cached SV -> SBV a
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
g
             where g :: State -> IO SV
g State
st = do SV
f <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
array
                             SV
k <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
key
                             State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KUnbounded (Op -> [SV] -> SBVExpr
SBVApp Op
ReadArray [SV
f, SV
k])

          writeArrayNoKnd :: forall key. HasKind key => SArray key Integer -> SBV key -> SInteger -> SArray key Integer
          writeArrayNoKnd :: forall key.
HasKind key =>
SArray key Integer -> SBV key -> SInteger -> SArray key Integer
writeArrayNoKnd SArray key Integer
array SBV key
key SInteger
value = SVal -> SArray key Integer
forall a. SVal -> SBV a
SBV (SVal -> SArray key Integer)
-> (Cached SV -> SVal) -> Cached SV -> SArray key Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> (Cached SV -> Either CV (Cached SV)) -> Cached SV -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> SArray key Integer)
-> Cached SV -> SArray key Integer
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
g
              where k :: Kind
k  = Kind -> Kind -> Kind
KArray (Proxy key -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @key)) Kind
KUnbounded

                    g :: State -> IO SV
g State
st = do SV
arr    <- State -> SArray key Integer -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SArray key Integer
array
                              SV
keyVal <- State -> SBV key -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV key
key
                              SV
val    <- State -> SInteger -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SInteger
value
                              State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp Op
WriteArray [SV
arr, SV
keyVal, SV
val])

-- | 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) | String -> SBV a -> SBV a -> Bool
forall a. (SymVal a, HasKind a) => String -> SBV a -> SBV a -> Bool
smtComparable String
"<"   SBV a
a SBV a
b = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svLessThan SVal
x SVal
y)
                          | Bool
True                    = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svStructuralLessThan SVal
x SVal
y)

  a :: SBV a
a@(SBV SVal
x) .<= :: SBV a -> SBV a -> SBool
.<= b :: SBV a
b@(SBV SVal
y) | String -> SBV a -> SBV a -> Bool
forall a. (SymVal a, HasKind a) => String -> SBV a -> SBV a -> Bool
smtComparable String
".<=" SBV a
a SBV a
b = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svLessEq SVal
x SVal
y)
                          | Bool
True                    = SBV a
a SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< SBV a
b SBool -> SBool -> SBool
.|| SBV a
a SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
b

  a :: SBV a
a@(SBV SVal
x) .> :: SBV a -> SBV a -> SBool
.>  b :: SBV a
b@(SBV SVal
y) | String -> SBV a -> SBV a -> Bool
forall a. (SymVal a, HasKind a) => String -> SBV a -> SBV a -> Bool
smtComparable String
">"   SBV a
a SBV a
b = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svGreaterThan SVal
x SVal
y)
                          | Bool
True                    = SBV a
b SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< SBV a
a

  a :: SBV a
a@(SBV SVal
x) .>= :: SBV a -> SBV a -> SBool
.>= b :: SBV a
b@(SBV SVal
y) | String -> SBV a -> SBV a -> Bool
forall a. (SymVal a, HasKind a) => String -> SBV a -> SBV a -> Bool
smtComparable String
">="  SBV a
a SBV a
b = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svGreaterEq SVal
x SVal
y)
                          | Bool
True                    = SBV a
b SBV a -> SBV a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<= SBV a
a

-- 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) => String -> SBV a -> SBV a -> Bool
smtComparable String
op SBV a
x SBV a
y
  | SBV a -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV a
x Bool -> Bool -> Bool
&& SBV a -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (Kind -> Bool
forall a. HasKind a => a -> Bool
isSet Kind
k)
  = Bool
True
  | Bool
True
  = case Kind
k of
      Kind
KBool         -> Bool
True
      KBounded   {} -> Bool
True
      KUnbounded {} -> Bool
True
      KReal      {} -> Bool
True
      KUserSort  {} -> Bool
True
      Kind
KFloat        -> Bool
True
      Kind
KDouble       -> Bool
True
      KRational  {} -> Bool
True
      KFP        {} -> Bool
True
      Kind
KChar         -> Bool
True
      Kind
KString       -> Bool
True
      KList      {} -> Bool
nope     -- Unfortunately, no way for us to desugar this
      KSet       {} -> Bool
nope     -- Ditto here..
      KTuple     {} -> Bool
False
      KMaybe     {} -> Bool
False
      KEither    {} -> Bool
False
      KArray     {} -> Bool
True
 where k :: Kind
k    = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
       nope :: Bool
nope = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Data.SBV.OrdSymbolic: SMTLib does not support " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k

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

-- Lists
instance EqSymbolic a => EqSymbolic [a] where
  []     .== :: [a] -> [a] -> SBool
.==  []     = SBool
sTrue
  (a
x:[a]
xs) .==  (a
y:[a]
ys) = a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
y SBool -> SBool -> SBool
.&& [a]
xs [a] -> [a] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== [a]
ys
  [a]
_      .==  [a]
_      = SBool
sFalse

  []     .=== :: [a] -> [a] -> SBool
.=== []     = SBool
sTrue
  (a
x:[a]
xs) .=== (a
y:[a]
ys) = a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== a
y SBool -> SBool -> SBool
.&& [a]
xs [a] -> [a] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== [a]
ys
  [a]
_      .=== [a]
_      = SBool
sFalse

instance OrdSymbolic a => OrdSymbolic [a] where
  []     .< :: [a] -> [a] -> SBool
.< []     = SBool
sFalse
  []     .< [a]
_      = SBool
sTrue
  [a]
_      .< []     = SBool
sFalse
  (a
x:[a]
xs) .< (a
y:[a]
ys) = a
x a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
y SBool -> SBool -> SBool
.|| (a
x a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
y SBool -> SBool -> SBool
.&& [a]
xs [a] -> [a] -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< [a]
ys)

-- NonEmpty
instance EqSymbolic a => EqSymbolic (NonEmpty a) where
  (a
x :| [a]
xs) .== :: NonEmpty a -> NonEmpty a -> SBool
.==  (a
y :| [a]
ys) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs [a] -> [a] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.==  a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
  (a
x :| [a]
xs) .=== :: NonEmpty a -> NonEmpty a -> SBool
.=== (a
y :| [a]
ys) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs [a] -> [a] -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys

instance OrdSymbolic a => OrdSymbolic (NonEmpty a) where
   (a
x :| [a]
xs) .< :: NonEmpty a -> NonEmpty a -> SBool
.< (a
y :| [a]
ys) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs [a] -> [a] -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [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 a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
b
  Maybe a
_       .== Maybe a
_       = SBool
sFalse

instance OrdSymbolic a => OrdSymbolic (Maybe a) where
  Maybe a
Nothing .< :: Maybe a -> Maybe a -> SBool
.<  Maybe a
Nothing = SBool
sFalse
  Maybe a
Nothing .<  Maybe a
_       = SBool
sTrue
  Just a
_  .<  Maybe a
Nothing = SBool
sFalse
  Just a
a  .<  Just a
b  = a
a a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
b

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

  Left a
a  .=== :: Either a b -> Either a b -> SBool
.=== Left a
b  = a
a a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== a
b
  Right b
a .=== Right b
b = b
a b -> b -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== b
b
  Either a b
_       .=== Either a b
_       = SBool
sFalse

instance (OrdSymbolic a, OrdSymbolic b) => OrdSymbolic (Either a b) where
  Left a
a  .< :: Either a b -> Either a b -> SBool
.< Left a
b  = a
a a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
b
  Left a
_  .< Right b
_ = SBool
sTrue
  Right b
_ .< Left a
_  = SBool
sFalse
  Right b
a .< Right b
b = b
a b -> b -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< b
b

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

instance (OrdSymbolic a, OrdSymbolic b) => OrdSymbolic (a, b) where
  (a
a0, b
b0) .< :: (a, b) -> (a, b) -> SBool
.< (a
a1, b
b1) = a
a0 a -> a -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< a
a1 SBool -> SBool -> SBool
.|| (a
a0 a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
a1 SBool -> SBool -> SBool
.&& b
b0 b -> b -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< b
b1)

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

instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c) => OrdSymbolic (a, b, c) where
  (a
a0, b
b0, c
c0) .< :: (a, b, c) -> (a, b, c) -> SBool
.< (a
a1, b
b1, c
c1) = (a
a0, b
b0) (a, b) -> (a, b) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1) SBool -> SBool -> SBool
.|| ((a
a0, b
b0) (a, b) -> (a, b) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1) SBool -> SBool -> SBool
.&& c
c0 c -> c -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< c
c1)

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

instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d) => OrdSymbolic (a, b, c, d) where
  (a
a0, b
b0, c
c0, d
d0) .< :: (a, b, c, d) -> (a, b, c, d) -> SBool
.< (a
a1, b
b1, c
c1, d
d1) = (a
a0, b
b0, c
c0) (a, b, c) -> (a, b, c) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1, c
c1) SBool -> SBool -> SBool
.|| ((a
a0, b
b0, c
c0) (a, b, c) -> (a, b, c) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1) SBool -> SBool -> SBool
.&& d
d0 d -> d -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< d
d1)

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

instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e) => OrdSymbolic (a, b, c, d, e) where
  (a
a0, b
b0, c
c0, d
d0, e
e0) .< :: (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
.< (a
a1, b
b1, c
c1, d
d1, e
e1) = (a
a0, b
b0, c
c0, d
d0) (a, b, c, d) -> (a, b, c, d) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< (a
a1, b
b1, c
c1, d
d1) SBool -> SBool -> SBool
.|| ((a
a0, b
b0, c
c0, d
d0) (a, b, c, d) -> (a, b, c, d) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1) SBool -> SBool -> SBool
.&& e
e0 e -> e -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< e
e1)

-- 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) (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.==  (a
a1, b
b1, c
c1, d
d1, e
e1) SBool -> SBool -> SBool
.&& f
f0 f -> f -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.==  f
f1
  (a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) .=== :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
.=== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) = (a
a0, b
b0, c
c0, d
d0, e
e0) (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== (a
a1, b
b1, c
c1, d
d1, e
e1) SBool -> SBool -> SBool
.&& f
f0 f -> f -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== f
f1

instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e, OrdSymbolic f) => OrdSymbolic (a, b, c, d, e, f) where
  (a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) .< :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
.< (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) =    (a
a0, b
b0, c
c0, d
d0, e
e0) (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<  (a
a1, b
b1, c
c1, d
d1, e
e1)
                                                       SBool -> SBool -> SBool
.|| ((a
a0, b
b0, c
c0, d
d0, e
e0) (a, b, c, d, e) -> (a, b, c, d, e) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1) SBool -> SBool -> SBool
.&& f
f0 f -> f -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< f
f1)

-- 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) (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.==  (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) SBool -> SBool -> SBool
.&& g
g0 g -> g -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.==  g
g1
  (a
a0, b
b0, c
c0, d
d0, e
e0, f
f0, g
g0) .=== :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> SBool
.=== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1, g
g1) = (a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) SBool -> SBool -> SBool
.&& g
g0 g -> g -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.=== g
g1

instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e, OrdSymbolic f, OrdSymbolic g) => OrdSymbolic (a, b, c, d, e, f, g) where
  (a
a0, b
b0, c
c0, d
d0, e
e0, f
f0, g
g0) .< :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> SBool
.< (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1, g
g1) =    (a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.<  (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1)
                                                               SBool -> SBool -> SBool
.|| ((a
a0, b
b0, c
c0, d
d0, e
e0, f
f0) (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (a
a1, b
b1, c
c1, d
d1, e
e1, f
f1) SBool -> SBool -> SBool
.&& g
g0 g -> g -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< g
g1)

-- | 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 = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
    where r :: State -> IO SV
r State
st = State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool (SBVExpr -> IO SV) -> SBVExpr -> IO SV
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 = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
    where r :: State -> IO SV
r State
st = State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
KBool (SBVExpr -> IO SV) -> SBVExpr -> IO SV
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, Num (SBV 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
instance (KnownNat n, BVIsNonZero n) => SIntegral (WordN n)
instance (KnownNat n, BVIsNonZero n) => SIntegral (IntN n)

-- | Zero extend a bit-vector.
zeroExtend :: forall n m bv. ( KnownNat n, BVIsNonZero n, SymVal (bv n)
                             , KnownNat m, BVIsNonZero m, SymVal (bv m)
                             , n + 1 <= m
                             , SIntegral (bv (m - n))
                             , BVIsNonZero (m - n)
                             ) => SBV (bv n)    -- ^ Input, of size @n@
                               -> SBV (bv m)    -- ^ Output, of size @m@. @n < m@ must hold
zeroExtend :: forall (n :: Nat) (m :: Nat) (bv :: Nat -> *).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat m,
 BVIsNonZero m, SymVal (bv m), (n + 1) <= m, SIntegral (bv (m - n)),
 BVIsNonZero (m - n)) =>
SBV (bv n) -> SBV (bv m)
zeroExtend SBV (bv n)
n = SVal -> SBV (bv m)
forall a. SVal -> SBV a
SBV (SVal -> SBV (bv m)) -> SVal -> SBV (bv m)
forall a b. (a -> b) -> a -> b
$ Int -> SVal -> SVal
svZeroExtend Int
i (SBV (bv n) -> SVal
forall a. SBV a -> SVal
unSBV SBV (bv n)
n)
  where nv :: Int
nv = Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)
        mv :: Int
mv = Proxy m -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
        i :: Int
i  = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
mv Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nv)

-- | Sign extend a bit-vector.
signExtend :: forall n m bv. ( KnownNat n, BVIsNonZero n, SymVal (bv n)
                             , KnownNat m, BVIsNonZero m, SymVal (bv m)
                             , n + 1 <= m
                             , SFiniteBits (bv n)
                             , SIntegral   (bv (m - n))
                             , BVIsNonZero (m - n)
                             ) => SBV (bv n)  -- ^ Input, of size @n@
                               -> SBV (bv m)  -- ^ Output, of size @m@. @n < m@ must hold
signExtend :: forall (n :: Nat) (m :: Nat) (bv :: Nat -> *).
(KnownNat n, BVIsNonZero n, SymVal (bv n), KnownNat m,
 BVIsNonZero m, SymVal (bv m), (n + 1) <= m, SFiniteBits (bv n),
 SIntegral (bv (m - n)), BVIsNonZero (m - n)) =>
SBV (bv n) -> SBV (bv m)
signExtend SBV (bv n)
n = SVal -> SBV (bv m)
forall a. SVal -> SBV a
SBV (SVal -> SBV (bv m)) -> SVal -> SBV (bv m)
forall a b. (a -> b) -> a -> b
$ Int -> SVal -> SVal
svSignExtend Int
i (SBV (bv n) -> SVal
forall a. SBV a -> SVal
unSBV SBV (bv n)
n)
  where nv :: Int
nv = Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)
        mv :: Int
mv = Proxy m -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
        i :: Int
i  = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
mv Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
nv)


-- | 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, Num (SBV 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
    -- | Variant of 'setBitTo' when the index is symbolic. If the index it out-of-bounds,
    -- then the result is underspecified.
    sSetBitTo           :: Integral a => SBV a -> SBV a -> 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) = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svTestBit SVal
v Int
0)
    msb SBV a
x       = SBV a -> Int -> SBool
forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x (SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

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

    fromBitsBE = [SBool] -> SBV a
forall a. SFiniteBits a => [SBool] -> SBV a
fromBitsLE ([SBool] -> SBV a) -> ([SBool] -> [SBool]) -> [SBool] -> SBV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SBool] -> [SBool]
forall a. [a] -> [a]
reverse
    fromBitsLE [SBool]
bs
       | [SBool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBool]
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
w
       = String -> SBV a
forall a. HasCallStack => String -> a
error (String -> SBV a) -> String -> SBV a
forall a b. (a -> b) -> a -> b
$ String
"SBV.SFiniteBits.fromBitsLE/BE: Expected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" bits, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([SBool] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SBool]
bs)
       | Bool
True
       = SBV a
result
       where w :: Int
w = SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
result
             result :: SBV a
result = SBV a -> Int -> [SBool] -> SBV a
forall {t}. (Mergeable t, Bits t) => t -> Int -> [SBool] -> t
go SBV a
0 Int
0 [SBool]
bs

             go :: t -> Int -> [SBool] -> t
go !t
acc Int
_  []     = t
acc
             go !t
acc !Int
i (SBool
x:[SBool]
xs) = t -> Int -> [SBool] -> t
go (SBool -> t -> t -> t
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
x (t -> Int -> t
forall a. Bits a => a -> Int -> a
setBit t
acc Int
i) t
acc) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [SBool]
xs

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

    -- 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 <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x = SBV Word8 -> a -> SBV Word8
forall {t} {t}. (Num t, Num t, Bits t) => t -> t -> t
go SBV Word8
0 a
v
      | Bool
True                  = [SBV Word8] -> SBV Word8
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [SBool -> SBV Word8 -> SBV Word8 -> SBV Word8
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
b SBV Word8
1 SBV Word8
0 | SBool
b <- SBV a -> [SBool]
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
ct -> t -> t
forall a. Num a => a -> a -> a
+t
1) (t
w t -> t -> t
forall a. Bits a => a -> a -> a
.&. (t
wt -> t -> t
forall a. Num a => a -> a -> a
-t
1))

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

    sSetBitTo SBV a
x SBV a
idx SBool
b
      | Just a
i <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
idx, Just Int
index <- a -> Maybe Int
forall {a} {a}. (Integral a, Integral a) => a -> Maybe a
safe a
i
      = SBV a -> Int -> SBool -> SBV a
forall a. SFiniteBits a => SBV a -> Int -> SBool -> SBV a
setBitTo SBV a
x Int
index SBool
b
      | Bool
True
      = SBV a -> [Int] -> SBV a
go SBV a
x [Int
0 .. SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
      where -- paranoia check: make sure index can fit in an int
            safe :: a -> Maybe a
safe a
i = let asInteger :: Integer
asInteger   = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
i
                         asInt :: a
asInt       = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
asInteger
                         backInteger :: Integer
backInteger = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
asInt
                     in if Integer
backInteger Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
asInteger
                        then a -> Maybe a
forall a. a -> Maybe a
Just a
asInt
                        else Maybe a
forall a. Maybe a
Nothing

            go :: SBV a -> [Int] -> SBV a
go SBV a
v []     = SBV a
v
            go SBV a
v (Int
i:[Int]
is) = SBV a -> [Int] -> SBV a
go (SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
idx SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a -> SBV a
forall a. SymVal a => a -> SBV a
literal (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i)) (SBV a -> Int -> SBool -> SBV a
forall a. SFiniteBits a => SBV a -> Int -> SBool -> SBV a
setBitTo SBV a
v (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i) SBool
b) SBV a
v) [Int]
is

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

    -- 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
      | SBV a -> Bool
forall a. Bits a => a -> Bool
isSigned SBV a
a = String -> (SBV a, SBV a)
forall a. HasCallStack => String -> a
error String
"fullMultiplier: only works on unsigned numbers"
      | Bool
True       = (Int -> SBV a -> SBV a -> SBV a
go (SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
a) SBV a
0 SBV a
a, SBV a
aSBV a -> SBV a -> SBV a
forall a. Num a => a -> a -> a
*SBV a
b)
      where go :: Int -> SBV a -> SBV a -> SBV a
go Int
0 SBV a
p SBV a
_ = SBV a
p
            go Int
n SBV a
p SBV a
x = let (SBool
c, SBV a
p')  = SBool -> (SBool, SBV a) -> (SBool, SBV a) -> (SBool, SBV a)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> SBool
forall a. SFiniteBits a => SBV a -> SBool
lsb SBV a
x) (SBV a -> SBV a -> (SBool, SBV a)
forall a. SFiniteBits a => SBV a -> SBV a -> (SBool, SBV a)
fullAdder SBV a
p SBV a
b) (SBool
sFalse, SBV a
p)
                           (SBool
o, SBV a
p'') = SBool -> SBV a -> (SBool, SBV a)
forall {a}. SFiniteBits a => SBool -> SBV a -> (SBool, SBV a)
shiftIn SBool
c SBV a
p'
                           (SBool
_, SBV a
x')  = SBool -> SBV a -> (SBool, SBV a)
forall {a}. SFiniteBits a => SBool -> SBV a -> (SBool, SBV a)
shiftIn SBool
o SBV a
x
                       in Int -> SBV a -> SBV a -> SBV a
go (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) SBV a
p'' SBV a
x'
            shiftIn :: SBool -> SBV a -> (SBool, SBV a)
shiftIn SBool
k SBV a
v = (SBV a -> SBool
forall a. SFiniteBits a => SBV a -> SBool
lsb SBV a
v, SBV a
mask SBV a -> SBV a -> SBV a
forall a. Bits a => a -> a -> a
.|. (SBV a
v SBV a -> Int -> SBV a
forall a. Bits a => a -> Int -> a
`shiftR` Int
1))
               where mask :: SBV a
mask = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
k (Int -> SBV a
forall a. Bits a => Int -> a
bit (SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) SBV a
0

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

            -- 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 -> SBV Word8
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = SBV Word8
i8
                 | Bool
True  = SBool -> SBV Word8 -> SBV Word8 -> SBV Word8
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> Int -> SBool
forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x Int
i) SBV Word8
i8 (Int -> SBV Word8
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
               where i8 :: SBV Word8
i8 = Word8 -> SBV Word8
forall a. SymVal a => a -> SBV a
literal (Int -> Word8
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 -> SBV Word8
go Int
0
       where m :: Int
m = SBV a -> Int
forall a. SFiniteBits a => SBV a -> Int
sFiniteBitSize SBV a
x

             go :: Int -> SWord8
             go :: Int -> SBV Word8
go Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m = SBV Word8
i8
                  | Bool
True   = SBool -> SBV Word8 -> SBV Word8 -> SBV Word8
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> Int -> SBool
forall a. SFiniteBits a => SBV a -> Int -> SBool
sTestBit SBV a
x Int
i) SBV Word8
i8 (Int -> SBV Word8
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
                where i8 :: SBV Word8
i8 = Word8 -> SBV Word8
forall a. SymVal a => a -> SBV a
literal (Int -> Word8
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 :: SBV Word8 -> Int
sFiniteBitSize SBV Word8
_ =  Int
8
instance SFiniteBits Word16 where sFiniteBitSize :: SBV Word16 -> Int
sFiniteBitSize SBV Word16
_ = Int
16
instance SFiniteBits Word32 where sFiniteBitSize :: SBV Word32 -> Int
sFiniteBitSize SBV Word32
_ = Int
32
instance SFiniteBits Word64 where sFiniteBitSize :: SBV Word64 -> Int
sFiniteBitSize SBV Word64
_ = Int
64
instance SFiniteBits Int8   where sFiniteBitSize :: SBV Int8 -> Int
sFiniteBitSize SBV Int8
_ =  Int
8
instance SFiniteBits Int16  where sFiniteBitSize :: SBV Int16 -> Int
sFiniteBitSize SBV Int16
_ = Int
16
instance SFiniteBits Int32  where sFiniteBitSize :: SBV Int32 -> Int
sFiniteBitSize SBV Int32
_ = Int
32
instance SFiniteBits Int64  where sFiniteBitSize :: SBV Int64 -> Int
sFiniteBitSize SBV Int64
_ = Int
64
instance (KnownNat n, BVIsNonZero n) => SFiniteBits (WordN n) where sFiniteBitSize :: SBV (WordN n) -> Int
sFiniteBitSize SBV (WordN n)
_ = Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)
instance (KnownNat n, BVIsNonZero n) => SFiniteBits (IntN  n) where sFiniteBitSize :: SBV (IntN n) -> Int
sFiniteBitSize SBV (IntN n)
_ = Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)

-- | Returns 1 if the boolean is 'sTrue', otherwise 0.
oneIf :: (Ord a, Num (SBV a), SymVal a) => SBool -> SBV a
oneIf :: forall a. (Ord a, Num (SBV a), SymVal a) => SBool -> SBV a
oneIf SBool
t = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
t SBV a
1 SBV a
0

-- | Lift a pseudo-boolean op, performing checks
liftPB :: String -> PBOp -> [SBool] -> SBool
liftPB :: String -> PBOp -> [SBool] -> SBool
liftPB String
w PBOp
o [SBool]
xs
  | Just String
e <- PBOp -> Maybe String
check PBOp
o
  = String -> SBool
forall a. HasCallStack => String -> a
error (String -> SBool) -> String -> SBool
forall a b. (a -> b) -> a -> b
$ String
"SBV." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
  | Bool
True
  = SBool
result
  where check :: PBOp -> Maybe String
check (PB_AtMost  Int
k) = Int -> Maybe String
forall {a}. (Ord a, Num a, Show a) => a -> Maybe String
pos Int
k
        check (PB_AtLeast Int
k) = Int -> Maybe String
forall {a}. (Ord a, Num a, Show a) => a -> Maybe String
pos Int
k
        check (PB_Exactly Int
k) = Int -> Maybe String
forall {a}. (Ord a, Num a, Show a) => a -> Maybe String
pos Int
k
        check (PB_Le [Int]
cs   Int
k) = Int -> Maybe String
forall {a}. (Ord a, Num a, Show a) => a -> Maybe String
pos Int
k Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Int] -> Maybe String
match [Int]
cs
        check (PB_Ge [Int]
cs   Int
k) = Int -> Maybe String
forall {a}. (Ord a, Num a, Show a) => a -> Maybe String
pos Int
k Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Int] -> Maybe String
match [Int]
cs
        check (PB_Eq [Int]
cs   Int
k) = Int -> Maybe String
forall {a}. (Ord a, Num a, Show a) => a -> Maybe String
pos Int
k Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` [Int] -> Maybe String
match [Int]
cs

        pos :: a -> Maybe String
pos a
k
          | a
k a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"comparison value must be positive, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
k
          | Bool
True  = Maybe String
forall a. Maybe a
Nothing

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

        result :: SBool
result = SVal -> SBool
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
KBool (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
        r :: State -> IO SV
r State
st   = do [SV]
xsv <- (SBool -> IO SV) -> [SBool] -> IO [SV]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (State -> SBool -> IO SV
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0             = String -> SBool
forall a. HasCallStack => String -> a
error (String -> SBool) -> String -> SBool
forall a b. (a -> b) -> a -> b
$ String
"SBV.pbAtMost: Non-negative value required, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
 | (SBool -> Bool) -> [SBool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete [SBool]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((SBool -> Integer) -> [SBool] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> SBool -> Integer
pbToInteger String
"pbAtMost" Int
1) [SBool]
xs) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
 | Bool
True              = String -> PBOp -> [SBool] -> SBool
liftPB String
"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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0             = String -> SBool
forall a. HasCallStack => String -> a
error (String -> SBool) -> String -> SBool
forall a b. (a -> b) -> a -> b
$ String
"SBV.pbAtLeast: Non-negative value required, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
 | (SBool -> Bool) -> [SBool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete [SBool]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((SBool -> Integer) -> [SBool] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> SBool -> Integer
pbToInteger String
"pbAtLeast" Int
1) [SBool]
xs) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
 | Bool
True              = String -> PBOp -> [SBool] -> SBool
liftPB String
"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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0             = String -> SBool
forall a. HasCallStack => String -> a
error (String -> SBool) -> String -> SBool
forall a b. (a -> b) -> a -> b
$ String
"SBV.pbExactly: Non-negative value required, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
 | (SBool -> Bool) -> [SBool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete [SBool]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((SBool -> Integer) -> [SBool] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int -> SBool -> Integer
pbToInteger String
"pbExactly" Int
1) [SBool]
xs) Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
 | Bool
True              = String -> PBOp -> [SBool] -> SBool
liftPB String
"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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                     = String -> SBool
forall a. HasCallStack => String -> a
error (String -> SBool) -> String -> SBool
forall a b. (a -> b) -> a -> b
$ String
"SBV.pbLe: Non-negative value required, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
 | ((Int, SBool) -> Bool) -> [(Int, SBool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete (SBool -> Bool) -> ((Int, SBool) -> SBool) -> (Int, SBool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd) [(Int, SBool)]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [String -> Int -> SBool -> Integer
pbToInteger String
"pbLe" Int
c SBool
b | (Int
c, SBool
b) <- [(Int, SBool)]
xs] Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
 | Bool
True                      = String -> PBOp -> [SBool] -> SBool
liftPB String
"pbLe" ([Int] -> Int -> PBOp
PB_Le (((Int, SBool) -> Int) -> [(Int, SBool)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> Int
forall a b. (a, b) -> a
fst [(Int, SBool)]
xs) Int
k) (((Int, SBool) -> SBool) -> [(Int, SBool)] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd [(Int, SBool)]
xs)

-- | '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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                     = String -> SBool
forall a. HasCallStack => String -> a
error (String -> SBool) -> String -> SBool
forall a b. (a -> b) -> a -> b
$ String
"SBV.pbGe: Non-negative value required, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
 | ((Int, SBool) -> Bool) -> [(Int, SBool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete (SBool -> Bool) -> ((Int, SBool) -> SBool) -> (Int, SBool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd) [(Int, SBool)]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [String -> Int -> SBool -> Integer
pbToInteger String
"pbGe" Int
c SBool
b | (Int
c, SBool
b) <- [(Int, SBool)]
xs] Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
 | Bool
True                      = String -> PBOp -> [SBool] -> SBool
liftPB String
"pbGe" ([Int] -> Int -> PBOp
PB_Ge (((Int, SBool) -> Int) -> [(Int, SBool)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> Int
forall a b. (a, b) -> a
fst [(Int, SBool)]
xs) Int
k) (((Int, SBool) -> SBool) -> [(Int, SBool)] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd [(Int, SBool)]
xs)

-- | '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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                     = String -> SBool
forall a. HasCallStack => String -> a
error (String -> SBool) -> String -> SBool
forall a b. (a -> b) -> a -> b
$ String
"SBV.pbEq: Non-negative value required, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
k
 | ((Int, SBool) -> Bool) -> [(Int, SBool)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SBool -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete (SBool -> Bool) -> ((Int, SBool) -> SBool) -> (Int, SBool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd) [(Int, SBool)]
xs = Bool -> SBool
forall a. SymVal a => a -> SBV a
literal (Bool -> SBool) -> Bool -> SBool
forall a b. (a -> b) -> a -> b
$ [Integer] -> Integer
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [String -> Int -> SBool -> Integer
pbToInteger String
"pbEq" Int
c SBool
b | (Int
c, SBool
b) <- [(Int, SBool)]
xs] Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
 | Bool
True                      = String -> PBOp -> [SBool] -> SBool
liftPB String
"pbEq" ([Int] -> Int -> PBOp
PB_Eq (((Int, SBool) -> Int) -> [(Int, SBool)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> Int
forall a b. (a, b) -> a
fst [(Int, SBool)]
xs) Int
k) (((Int, SBool) -> SBool) -> [(Int, SBool)] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map (Int, SBool) -> SBool
forall a b. (a, b) -> b
snd [(Int, SBool)]
xs)

-- | '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 :: String -> Int -> SBool -> Integer
pbToInteger String
w Int
c SBool
b
 | Int
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0                 = String -> Integer
forall a. HasCallStack => String -> a
error (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ String
"SBV." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": Non-negative coefficient required, received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c
 | Just Bool
v <- SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
b = if Bool
v then Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c else Integer
0
 | Bool
True                  = String -> Integer
forall a. HasCallStack => String -> a
error (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ String
"SBV.pbToInteger: Received a symbolic boolean: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, SBool) -> String
forall a. Show a => a -> String
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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
isConcreteZero (SBV (SVal Kind
KReal (Left (CV Kind
KReal (CAlgReal AlgReal
v))))) = AlgReal -> Bool
isExactRational AlgReal
v Bool -> Bool -> Bool
&& AlgReal
v AlgReal -> AlgReal -> Bool
forall a. Eq a => a -> a -> Bool
== AlgReal
0
isConcreteZero SBV a
_                                                 = Bool
False

-- | 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 AlgReal -> AlgReal -> Bool
forall a. Eq a => a -> a -> Bool
== AlgReal
1
isConcreteOne SBV a
_                                                 = Bool
False

-- | 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
  | SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
e, Just (Integer
x :: Integer) <- SInteger -> Maybe Integer
forall a. SymVal a => SBV a -> Maybe a
unliteral (SBV e -> SInteger
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV e
e)
  = if Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 then let go :: t -> a -> a
go t
n a
v
                        | t
n t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
0 = a
1
                        | t -> Bool
forall a. Integral a => a -> Bool
even t
n =     t -> a -> a
go (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2) (a
v a -> a -> a
forall a. Num a => a -> a -> a
* a
v)
                        | Bool
True   = a
v a -> a -> a
forall a. Num a => a -> a -> a
* t -> a -> a
go (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
2) (a
v a -> a -> a
forall a. Num a => a -> a -> a
* a
v)
                   in  Integer -> b -> b
forall {t} {a}. (Num a, Integral t) => t -> a -> a
go Integer
x b
b
              else String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"(.^): exponentiation: negative exponent: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
x
  | Bool -> Bool
not (SBV e -> Bool
forall a. HasKind a => a -> Bool
isBounded SBV e
e) Bool -> Bool -> Bool
|| SBV e -> Bool
forall a. Bits a => a -> Bool
isSigned SBV e
e
  = String -> b
forall a. HasCallStack => String -> a
error (String -> b) -> String -> b
forall a b. (a -> b) -> a -> b
$ String
"(.^): exponentiation only works with unsigned bounded symbolic exponents, kind: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (SBV e -> Kind
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 = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svTestBit SVal
expt Int
i)
         blasted :: [SBool]
blasted  = (Int -> SBool) -> [Int] -> [SBool]
forall a b. (a -> b) -> [a] -> [b]
map Int -> SBool
expBit [Int
0 .. SBV e -> Int
forall a. HasKind a => a -> Int
intSizeOf SBV e
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
     in [b] -> b
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product ([b] -> b) -> [b] -> b
forall a b. (a -> b) -> a -> b
$ (SBool -> b -> b) -> [SBool] -> [b] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\SBool
use b
n -> SBool -> b -> b -> b
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
use b
n b
1)
                          [SBool]
blasted
                          ((b -> b) -> b -> [b]
forall a. (a -> a) -> a -> [a]
iterate (\b
x -> b
xb -> b -> b
forall a. Num a => a -> a -> a
*b
x) b
b)
infixr 8 .^

instance (Ord a, Num (SBV a), SymVal a, Fractional a) => Fractional (SBV a) where
  fromRational :: Rational -> SBV a
fromRational  = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> (Rational -> a) -> Rational -> SBV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
  SBV SVal
x / :: SBV a -> SBV a -> SBV a
/ sy :: SBV a
sy@(SBV SVal
y) | Bool
div0 = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
sy SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
0) SBV a
0 SBV a
res
                     | Bool
True = SBV a
res
       where res :: SBV a
res  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svDivide SVal
x SVal
y)
             -- Identify those kinds where we have a div-0 equals 0 exception
             div0 :: Bool
div0 = case SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
sy of
                      Kind
KFloat             -> Bool
False
                      Kind
KDouble            -> Bool
False
                      KFP{}              -> Bool
False
                      Kind
KReal              -> Bool
True
                      Kind
KRational          -> Bool
True
                      -- Following cases should not happen since these types should *not* be instances of Fractional
                      k :: Kind
k@KBounded{}  -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@Kind
KUnbounded  -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@Kind
KBool       -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@Kind
KString     -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@Kind
KChar       -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@KList{}     -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@KSet{}      -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@KUserSort{} -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@KTuple{}    -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@KMaybe{}    -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@KEither{}   -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show Kind
k
                      k :: Kind
k@KArray{}    -> String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"Unexpected Fractional case for: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
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, Num (SBV a), SymVal a, Fractional a, Floating a) => Floating (SBV a) where
  pi :: SBV a
pi      = Rational -> SBV a
forall a. Fractional a => Rational -> a
fromRational (Rational -> SBV a) -> (Double -> Rational) -> Double -> SBV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> SBV a) -> Double -> SBV a
forall a b. (a -> b) -> a -> b
$ (Double
forall a. Floating a => a
pi :: Double)
  exp :: SBV a -> SBV a
exp     = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"exp"     a -> a
forall a. Floating a => a -> a
exp
  log :: SBV a -> SBV a
log     = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"log"     a -> a
forall a. Floating a => a -> a
log
  sqrt :: SBV a -> SBV a
sqrt    = FPOp -> (a -> a) -> SBV a -> SBV a
forall a. SymVal a => FPOp -> (a -> a) -> SBV a -> SBV a
lift1F   FPOp
FP_Sqrt   a -> a
forall a. Floating a => a -> a
sqrt
  sin :: SBV a -> SBV a
sin     = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"sin"     a -> a
forall a. Floating a => a -> a
sin
  cos :: SBV a -> SBV a
cos     = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"cos"     a -> a
forall a. Floating a => a -> a
cos
  tan :: SBV a -> SBV a
tan     = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"tan"     a -> a
forall a. Floating a => a -> a
tan
  asin :: SBV a -> SBV a
asin    = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"asin"    a -> a
forall a. Floating a => a -> a
asin
  acos :: SBV a -> SBV a
acos    = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"acos"    a -> a
forall a. Floating a => a -> a
acos
  atan :: SBV a -> SBV a
atan    = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"atan"    a -> a
forall a. Floating a => a -> a
atan
  sinh :: SBV a -> SBV a
sinh    = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"sinh"    a -> a
forall a. Floating a => a -> a
sinh
  cosh :: SBV a -> SBV a
cosh    = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"cosh"    a -> a
forall a. Floating a => a -> a
cosh
  tanh :: SBV a -> SBV a
tanh    = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"tanh"    a -> a
forall a. Floating a => a -> a
tanh
  asinh :: SBV a -> SBV a
asinh   = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"asinh"   a -> a
forall a. Floating a => a -> a
asinh
  acosh :: SBV a -> SBV a
acosh   = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"acosh"   a -> a
forall a. Floating a => a -> a
acosh
  atanh :: SBV a -> SBV a
atanh   = String -> (a -> a) -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"atanh"   a -> a
forall a. Floating a => a -> a
atanh
  ** :: SBV a -> SBV a -> SBV a
(**)    = String -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS String
"**"      a -> a -> a
forall a. Floating a => a -> a -> a
(**)
  logBase :: SBV a -> SBV a -> SBV a
logBase = String -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
forall a.
(SymVal a, Floating a) =>
String -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS String
"logBase" a -> a -> a
forall a. Floating a => a -> a -> a
logBase

unsupported :: String -> a
unsupported :: forall a. String -> a
unsupported String
w = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Data.SBV.FloatingPoint: Unsupported operation: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
11 Bool -> Bool -> Bool
|| Int
si Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
53 = String -> SFloatingPoint eb sb
forall a. String -> a
unsupported (String -> SFloatingPoint eb sb) -> String -> SFloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ String
"Floating.SFloatingPoint.pi (not-enough-precision for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
ei, Int
si) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
   | Bool
True               = FloatingPoint eb sb -> SFloatingPoint eb sb
forall a. SymVal a => a -> SBV a
literal (FloatingPoint eb sb -> SFloatingPoint eb sb)
-> FloatingPoint eb sb -> SFloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ FP -> FloatingPoint eb sb
forall (eb :: Nat) (sb :: Nat). FP -> FloatingPoint eb sb
FloatingPoint (FP -> FloatingPoint eb sb) -> FP -> FloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Rational -> FP
fpFromRational Int
ei Int
si (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double
forall a. Floating a => a
pi :: Double))
   where ei :: Int
ei = Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @eb)
         si :: Int
si = Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
11 Bool -> Bool -> Bool
|| Int
si Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
53 = String -> SFloatingPoint eb sb
forall a. String -> a
unsupported (String -> SFloatingPoint eb sb) -> String -> SFloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ String
"Floating.SFloatingPoint.exp (not-enough-precision for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
ei, Int
si) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
   | Bool
True               = FloatingPoint eb sb -> SFloatingPoint eb sb
forall a. SymVal a => a -> SBV a
literal FloatingPoint eb sb
e SFloatingPoint eb sb
-> SFloatingPoint eb sb -> SFloatingPoint eb sb
forall a. Floating a => a -> a -> a
** SFloatingPoint eb sb
i
   where ei :: Int
ei = Proxy eb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @eb)
         si :: Int
si = Proxy sb -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @sb)
         e :: FloatingPoint eb sb
e  = FP -> FloatingPoint eb sb
forall (eb :: Nat) (sb :: Nat). FP -> FloatingPoint eb sb
FloatingPoint (FP -> FloatingPoint eb sb) -> FP -> FloatingPoint eb sb
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Rational -> FP
fpFromRational Int
ei Int
si (Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Double
forall a. Floating a => a -> a
exp Double
1 :: Double))

  log :: SFloatingPoint eb sb -> SFloatingPoint eb sb
log     = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"log"     FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
log
  sqrt :: SFloatingPoint eb sb -> SFloatingPoint eb sb
sqrt    = FPOp
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a. SymVal a => FPOp -> (a -> a) -> SBV a -> SBV a
lift1F   FPOp
FP_Sqrt   FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
sqrt
  sin :: SFloatingPoint eb sb -> SFloatingPoint eb sb
sin     = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"sin"     FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
sin
  cos :: SFloatingPoint eb sb -> SFloatingPoint eb sb
cos     = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"cos"     FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
cos
  tan :: SFloatingPoint eb sb -> SFloatingPoint eb sb
tan     = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"tan"     FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
tan
  asin :: SFloatingPoint eb sb -> SFloatingPoint eb sb
asin    = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"asin"    FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
asin
  acos :: SFloatingPoint eb sb -> SFloatingPoint eb sb
acos    = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"acos"    FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
acos
  atan :: SFloatingPoint eb sb -> SFloatingPoint eb sb
atan    = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"atan"    FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
atan
  sinh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
sinh    = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"sinh"    FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
sinh
  cosh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
cosh    = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"cosh"    FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
cosh
  tanh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
tanh    = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"tanh"    FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
tanh
  asinh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
asinh   = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"asinh"   FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
asinh
  acosh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
acosh   = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"acosh"   FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
acosh
  atanh :: SFloatingPoint eb sb -> SFloatingPoint eb sb
atanh   = String
-> (FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
"atanh"   FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a
atanh
  ** :: SFloatingPoint eb sb
-> SFloatingPoint eb sb -> SFloatingPoint eb sb
(**)    = String
-> (FloatingPoint eb sb
    -> FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS String
"**"      FloatingPoint eb sb -> FloatingPoint eb sb -> FloatingPoint eb sb
forall a. Floating a => a -> a -> a
(**)
  logBase :: SFloatingPoint eb sb
-> SFloatingPoint eb sb -> SFloatingPoint eb sb
logBase = String
-> (FloatingPoint eb sb
    -> FloatingPoint eb sb -> FloatingPoint eb sb)
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
-> SFloatingPoint eb sb
forall a.
(SymVal a, Floating a) =>
String -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS String
"logBase" FloatingPoint eb sb -> FloatingPoint eb sb -> FloatingPoint eb sb
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 <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
a
  = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> a -> SBV a
forall a b. (a -> b) -> a -> b
$ a -> a
op a
v
  | Bool
True
  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k    = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
a
        r :: State -> IO SV
r State
st = do SV
swa  <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
a
                  SV
swm  <- State -> SBV RoundingMode -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV RoundingMode
sRNE
                  State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp (FPOp -> Op
IEEEFP FPOp
w) [SV
swm, SV
swa])

-- | 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) =>
String -> (a -> a) -> SBV a -> SBV a
lift1FNS String
nm a -> a
f SBV a
sv
  | Just a
v <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
sv = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> a -> SBV a
forall a b. (a -> b) -> a -> b
$ a -> a
f a
v
  | Bool
True                   = String -> SBV a
forall a. HasCallStack => String -> a
error (String -> SBV a) -> String -> SBV a
forall a b. (a -> b) -> a -> b
$ String
"SBV." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": not supported for symbolic values of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (SBV a -> Kind
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) =>
String -> (a -> a -> a) -> SBV a -> SBV a -> SBV a
lift2FNS String
nm a -> a -> a
f SBV a
sv1 SBV a
sv2
  | Just a
v1 <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
sv1
  , Just a
v2 <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
sv2 = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> a -> SBV a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
f a
v1 a
v2
  | Bool
True                     = String -> SBV a
forall a. HasCallStack => String -> a
error (String -> SBV a) -> String -> SBV a
forall a b. (a -> b) -> a -> b
$ String
"SBV." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": not supported for symbolic values of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (SBV a -> Kind
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      = Rational -> SReal
forall a. Fractional a => Rational -> a
fromRational (Rational -> SReal) -> (Double -> Rational) -> Double -> SReal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> SReal) -> Double -> SReal
forall a b. (a -> b) -> a -> b
$ (Double
forall a. Floating a => a
pi :: Double)  -- 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   = String -> SReal -> SReal
forall a. HasCallStack => String -> a
error String
"Data.SBV.SReal: asinh is currently not supported. Please request this as a feature!"
  acosh :: SReal -> SReal
acosh   = String -> SReal -> SReal
forall a. HasCallStack => String -> a
error String
"Data.SBV.SReal: acosh is currently not supported. Please request this as a feature!"
  atanh :: SReal -> SReal
atanh   = String -> SReal -> SReal
forall a. HasCallStack => String -> a
error String
"Data.SBV.SReal: atanh is currently not supported. Please request this as a feature!"
  ** :: SReal -> SReal -> SReal
(**)    = NROp -> SReal -> SReal -> SReal
lift2SReal NROp
NR_Pow

  logBase :: SReal -> SReal -> SReal
logBase SReal
x SReal
y = SReal -> SReal
forall a. Floating a => a -> a
log SReal
y  SReal -> SReal -> SReal
forall a. Fractional a => a -> a -> a
/ SReal -> SReal
forall a. Floating a => a -> a
log SReal
x

-- | Lift an sreal unary function
lift1SReal :: NROp -> SReal -> SReal
lift1SReal :: NROp -> SReal -> SReal
lift1SReal NROp
w SReal
a = SVal -> SReal
forall a. SVal -> SBV a
SBV (SVal -> SReal) -> SVal -> SReal
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k    = SReal -> Kind
forall a. HasKind a => a -> Kind
kindOf SReal
a
        r :: State -> IO SV
r State
st = do SV
swa <- State -> SReal -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SReal
a
                  State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp (NROp -> Op
NonLinear NROp
w) [SV
swa])

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

-- Bail out nicely.
noEquals :: String -> String -> (String, String) -> a
noEquals :: forall a. String -> String -> (String, String) -> a
noEquals String
o String
n (String
l, String
r) = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
""
                                      , String
"*** Data.SBV: Comparing symbolic values using Haskell's Eq class!"
                                      , String
"***"
                                      , String
"*** Received:    (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
o String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                                      , String
"*** Instead use: (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") "  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
r String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
                                      , String
"***"
                                      , String
"*** The Eq instance for symbolic values are necessiated only because"
                                      , String
"*** of the Bits class requirement. You must use symbolic equality"
                                      , String
"*** operators instead. (And complain to Haskell folks that they"
                                      , String
"*** remove the 'Eq' superclass from 'Bits'!.)"
                                      ]

-- | This instance is only defined so that we can define an instance for
-- 'Data.Bits.Bits'. '==' and '/=' simply throw an error. Use
-- 'Data.SBV.EqSymbolic' instead.
instance SymVal a => Eq (SBV a) where
  SBV a
a == :: SBV a -> SBV a -> Bool
== SBV a
b = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (String -> String -> (String, String) -> Bool
forall a. String -> String -> (String, String) -> a
noEquals String
"==" String
".==" (SBV a -> String
forall a. Show a => a -> String
show SBV a
a, SBV a -> String
forall a. Show a => a -> String
show SBV a
b)) (SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral (SBV a
a SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
b))
  SBV a
a /= :: SBV a -> SBV a -> Bool
/= SBV a
b = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe (String -> String -> (String, String) -> Bool
forall a. String -> String -> (String, String) -> a
noEquals String
"/=" String
"./=" (SBV a -> String
forall a. Show a => a -> String
show SBV a
a, SBV a -> String
forall a. Show a => a -> String
show SBV a
b)) (SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral (SBV a
a SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
./= SBV a
b))

-- 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 (SBV a), Num a, Bits a, SymVal a) => Bits (SBV a) where
  SBV SVal
x .&. :: SBV a -> SBV a -> SBV a
.&. SBV SVal
y    = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svAnd SVal
x SVal
y)
  SBV SVal
x .|. :: SBV a -> SBV a -> SBV a
.|. SBV SVal
y    = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svOr SVal
x SVal
y)
  SBV SVal
x xor :: SBV a -> SBV a -> SBV a
`xor` SBV SVal
y  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal -> SVal
svXOr SVal
x SVal
y)
  complement :: SBV a -> SBV a
complement (SBV SVal
x) = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SVal
svNot SVal
x)
  bitSize :: SBV a -> Int
bitSize  SBV a
x         = SBV a -> Int
forall a. HasKind a => a -> Int
intSizeOf SBV a
x
  bitSizeMaybe :: SBV a -> Maybe Int
bitSizeMaybe SBV a
x     = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ SBV a -> Int
forall a. HasKind a => a -> Int
intSizeOf SBV a
x
  isSigned :: SBV a -> Bool
isSigned SBV a
x         = SBV a -> Bool
forall a. HasKind a => a -> Bool
hasSign SBV a
x
  bit :: Int -> SBV a
bit Int
i              = SBV a
1 SBV a -> Int -> SBV a
forall a. Bits a => a -> Int -> a
`shiftL` Int
i
  setBit :: SBV a -> Int -> SBV a
setBit        SBV a
x Int
i  = SBV a
x SBV a -> SBV a -> SBV a
forall a. Bits a => a -> a -> a
.|. Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Int -> Integer
forall a. Bits a => Int -> a
bit Int
i :: Integer)
  clearBit :: SBV a -> Int -> SBV a
clearBit      SBV a
x Int
i  = SBV a
x SBV a -> SBV a -> SBV a
forall a. Bits a => a -> a -> a
.&. Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer -> Integer
forall a. Bits a => a -> a
complement (Int -> Integer
forall a. Bits a => Int -> a
bit Int
i) :: Integer)
  complementBit :: SBV a -> Int -> SBV a
complementBit SBV a
x Int
i  = SBV a
x SBV a -> SBV a -> SBV a
forall a. Bits a => a -> a -> a
`xor` Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Int -> Integer
forall a. Bits a => Int -> a
bit Int
i :: Integer)
  shiftL :: SBV a -> Int -> SBV a
shiftL  (SBV SVal
x) Int
i  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svShl SVal
x Int
i)
  shiftR :: SBV a -> Int -> SBV a
shiftR  (SBV SVal
x) Int
i  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svShr SVal
x Int
i)
  rotateL :: SBV a -> Int -> SBV a
rotateL (SBV SVal
x) Int
i  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svRol SVal
x Int
i)
  rotateR :: SBV a -> Int -> SBV a
rotateR (SBV SVal
x) Int
i  = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> Int -> SVal
svRor SVal
x Int
i)
  -- 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
    = Integer -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Integer
n Int
i
    | Bool
True
    = String -> Bool
forall a. HasCallStack => String -> a
error (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
"SBV.testBit: Called on symbolic value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SBV a -> String
forall a. Show a => a -> String
show SBV a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". 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
    = Integer -> Int
forall a. Bits a => a -> Int
popCount (Integer
n Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. (Int -> Integer
forall a. Bits a => Int -> a
bit Int
w Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
    | Bool
True
    = String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"SBV.popCount: Called on symbolic value: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SBV a -> String
forall a. Show a => a -> String
show SBV a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". 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 Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
== Kind
kTo
  = SVal -> SBV b
forall a. SVal -> SBV a
SBV (SBV a -> SVal
forall a. SBV a -> SVal
unSBV SBV a
x)
  | SBV a -> Bool
forall a. HasKind a => a -> Bool
isReal SBV a
x
  = String -> SBV b
forall a. HasCallStack => String -> a
error String
"SBV.sFromIntegral: Called on a real value" -- can't really happen due to types, but being overcautious
  | Just a
v <- SBV a -> Maybe a
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV a
x
  = b -> SBV b
forall a. SymVal a => a -> SBV a
literal (a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v)
  | Bool
True
  = SBV b
result
  where result :: SBV b
result = SVal -> SBV b
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
kTo (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
y)))
        kFrom :: Kind
kFrom  = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
        kTo :: Kind
kTo    = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
        y :: State -> IO SV
y State
st   = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
                    State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
kTo (Op -> [SV] -> SBVExpr
SBVApp (Kind -> Kind -> Op
KindCast Kind
kFrom Kind
kTo) [SV
xsv])

-- | 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) = SVal -> SBV c
forall a. SVal -> SBV a
SBV (SVal -> SBV c) -> SVal -> SBV c
forall a b. (a -> b) -> a -> b
$ SVal -> SVal -> SVal
f SVal
a SVal
b

-- | 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 = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svShiftLeft

-- | 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 = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svShiftRight

-- | 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
  | SBV b -> Bool
forall a. Bits a => a -> Bool
isSigned SBV b
i = String -> SBV a
forall a. HasCallStack => String -> a
error String
"sSignedShiftArithRight: shift amount should be unsigned"
  | SBV a -> Bool
forall a. Bits a => a -> Bool
isSigned SBV a
x = SBV a -> SBV b -> SBV a
forall {a} {a} {a}. SBV a -> SBV a -> SBV a
ssa SBV a
x SBV b
i
  | Bool
True       = SBool -> SBV a -> SBV a -> SBV a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> SBool
forall a. SFiniteBits a => SBV a -> SBool
msb SBV a
x)
                     (SBV a -> SBV a
forall a. Bits a => a -> a
complement (SBV a -> SBV b -> SBV a
forall {a} {a} {a}. SBV a -> SBV a -> SBV a
ssa (SBV a -> SBV a
forall a. Bits a => a -> a
complement SBV a
x) SBV b
i))
                     (SBV a -> SBV b -> SBV a
forall {a} {a} {a}. SBV a -> SBV a -> SBV a
ssa SBV a
x SBV b
i)
  where ssa :: SBV a -> SBV b -> SBV c
ssa = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svShiftRight

-- | 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 = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svRotateLeft

-- | 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 = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svBarrelRotateLeft

-- | 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 = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svRotateRight

-- | 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 = (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV a
forall a b c. (SVal -> SVal -> SVal) -> SBV a -> SBV b -> SBV c
liftViaSVal SVal -> SVal -> SVal
svBarrelRotateRight

-- | Capturing non-matching instances for better error messages, conversions from sized
type FromSizedErr (arg :: Type) =     'Text "fromSized: Cannot convert from type: " ':<>: 'ShowType arg
                                ':$$: 'Text "           Source type must be one of SInt N, SWord N, IntN N, WordN N"
                                ':$$: 'Text "           where N is 8, 16, 32, or 64."

-- | Capturing non-matching instances for better error messages, conversions to sized
type ToSizedErr (arg :: Type) =      'Text "toSized: Cannot convert from type: " ':<>: 'ShowType arg
                              ':$$: 'Text "          Source type must be one of Int8/16/32/64"
                              ':$$: 'Text "                                  OR Word8/16/32/64"
                              ':$$: 'Text "                                  OR their symbolic variants."

-- | Capture the correspondence between sized and fixed-sized BVs
type family FromSized (t :: Type) :: Type where
   FromSized (WordN  8) = Word8
   FromSized (WordN 16) = Word16
   FromSized (WordN 32) = Word32
   FromSized (WordN 64) = Word64
   FromSized (IntN   8) = Int8
   FromSized (IntN  16) = Int16
   FromSized (IntN  32) = Int32
   FromSized (IntN  64) = Int64
   FromSized (SWord  8) = SWord8
   FromSized (SWord 16) = SWord16
   FromSized (SWord 32) = SWord32
   FromSized (SWord 64) = SWord64
   FromSized (SInt   8) = SInt8
   FromSized (SInt  16) = SInt16
   FromSized (SInt  32) = SInt32
   FromSized (SInt  64) = SInt64

-- | Capture the correspondence, in terms of a constraint
type family FromSizedCstr (t :: Type) :: Constraint where
   FromSizedCstr (WordN  8) = ()
   FromSizedCstr (WordN 16) = ()
   FromSizedCstr (WordN 32) = ()
   FromSizedCstr (WordN 64) = ()
   FromSizedCstr (IntN   8) = ()
   FromSizedCstr (IntN  16) = ()
   FromSizedCstr (IntN  32) = ()
   FromSizedCstr (IntN  64) = ()
   FromSizedCstr (SWord  8) = ()
   FromSizedCstr (SWord 16) = ()
   FromSizedCstr (SWord 32) = ()
   FromSizedCstr (SWord 64) = ()
   FromSizedCstr (SInt   8) = ()
   FromSizedCstr (SInt  16) = ()
   FromSizedCstr (SInt  32) = ()
   FromSizedCstr (SInt  64) = ()
   FromSizedCstr arg        = TypeError (FromSizedErr arg)

-- | Conversion from a sized BV to a fixed-sized bit-vector.
class FromSizedBV a where
   -- | Convert a sized bit-vector to the corresponding fixed-sized bit-vector,
   -- for instance 'SWord 16' to 'SWord16'. See also 'toSized'.
   fromSized :: a -> FromSized a

   default fromSized :: (Num (FromSized a), Integral a) => a -> FromSized a
   fromSized = a -> FromSized a
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance {-# OVERLAPPING  #-} FromSizedBV (WordN   8)
instance {-# OVERLAPPING  #-} FromSizedBV (WordN  16)
instance {-# OVERLAPPING  #-} FromSizedBV (WordN  32)
instance {-# OVERLAPPING  #-} FromSizedBV (WordN  64)
instance {-# OVERLAPPING  #-} FromSizedBV (IntN    8)
instance {-# OVERLAPPING  #-} FromSizedBV (IntN   16)
instance {-# OVERLAPPING  #-} FromSizedBV (IntN   32)
instance {-# OVERLAPPING  #-} FromSizedBV (IntN   64)
instance {-# OVERLAPPING  #-} FromSizedBV (SWord   8) where fromSized :: SWord 8 -> FromSized (SWord 8)
fromSized = SWord 8 -> SBV Word8
SWord 8 -> FromSized (SWord 8)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} FromSizedBV (SWord  16) where fromSized :: SWord 16 -> FromSized (SWord 16)
fromSized = SWord 16 -> SBV Word16
SWord 16 -> FromSized (SWord 16)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} FromSizedBV (SWord  32) where fromSized :: SWord 32 -> FromSized (SWord 32)
fromSized = SWord 32 -> SBV Word32
SWord 32 -> FromSized (SWord 32)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} FromSizedBV (SWord  64) where fromSized :: SWord 64 -> FromSized (SWord 64)
fromSized = SWord 64 -> SBV Word64
SWord 64 -> FromSized (SWord 64)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} FromSizedBV (SInt    8) where fromSized :: SInt 8 -> FromSized (SInt 8)
fromSized = SInt 8 -> SBV Int8
SInt 8 -> FromSized (SInt 8)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} FromSizedBV (SInt   16) where fromSized :: SInt 16 -> FromSized (SInt 16)
fromSized = SInt 16 -> SBV Int16
SInt 16 -> FromSized (SInt 16)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} FromSizedBV (SInt   32) where fromSized :: SInt 32 -> FromSized (SInt 32)
fromSized = SInt 32 -> SBV Int32
SInt 32 -> FromSized (SInt 32)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} FromSizedBV (SInt   64) where fromSized :: SInt 64 -> FromSized (SInt 64)
fromSized = SInt 64 -> SBV Int64
SInt 64 -> FromSized (SInt 64)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPABLE #-} FromSizedCstr arg => FromSizedBV arg where fromSized :: arg -> FromSized arg
fromSized = String -> arg -> FromSized arg
forall a. HasCallStack => String -> a
error String
"unreachable"

-- | Capture the correspondence between fixed-sized and sized BVs
type family ToSized (t :: Type) :: Type where
   ToSized Word8   = WordN  8
   ToSized Word16  = WordN 16
   ToSized Word32  = WordN 32
   ToSized Word64  = WordN 64
   ToSized Int8    = IntN   8
   ToSized Int16   = IntN  16
   ToSized Int32   = IntN  32
   ToSized Int64   = IntN  64
   ToSized SWord8  = SWord  8
   ToSized SWord16 = SWord 16
   ToSized SWord32 = SWord 32
   ToSized SWord64 = SWord 64
   ToSized SInt8   = SInt   8
   ToSized SInt16  = SInt  16
   ToSized SInt32  = SInt  32
   ToSized SInt64  = SInt  64

-- | Capture the correspondence in terms of a constraint
type family ToSizedCstr (t :: Type) :: Constraint where
   ToSizedCstr Word8   = ()
   ToSizedCstr Word16  = ()
   ToSizedCstr Word32  = ()
   ToSizedCstr Word64  = ()
   ToSizedCstr Int8    = ()
   ToSizedCstr Int16   = ()
   ToSizedCstr Int32   = ()
   ToSizedCstr Int64   = ()
   ToSizedCstr SWord8  = ()
   ToSizedCstr SWord16 = ()
   ToSizedCstr SWord32 = ()
   ToSizedCstr SWord64 = ()
   ToSizedCstr SInt8   = ()
   ToSizedCstr SInt16  = ()
   ToSizedCstr SInt32  = ()
   ToSizedCstr SInt64  = ()
   ToSizedCstr arg     = TypeError (ToSizedErr arg)

-- | Conversion from a fixed-sized BV to a sized bit-vector.
class ToSizedBV a where
   -- | Convert a fixed-sized bit-vector to the corresponding sized bit-vector,
   -- for instance 'SWord16' to 'SWord 16'. See also 'fromSized'.
   toSized :: a -> ToSized a

   default toSized :: (Num (ToSized a), Integral a) => (a -> ToSized a)
   toSized = a -> ToSized a
forall a b. (Integral a, Num b) => a -> b
fromIntegral

instance {-# OVERLAPPING  #-} ToSizedBV Word8
instance {-# OVERLAPPING  #-} ToSizedBV Word16
instance {-# OVERLAPPING  #-} ToSizedBV Word32
instance {-# OVERLAPPING  #-} ToSizedBV Word64
instance {-# OVERLAPPING  #-} ToSizedBV Int8
instance {-# OVERLAPPING  #-} ToSizedBV Int16
instance {-# OVERLAPPING  #-} ToSizedBV Int32
instance {-# OVERLAPPING  #-} ToSizedBV Int64
instance {-# OVERLAPPING  #-} ToSizedBV SWord8  where toSized :: SBV Word8 -> ToSized (SBV Word8)
toSized = SBV Word8 -> SWord 8
SBV Word8 -> ToSized (SBV Word8)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} ToSizedBV SWord16 where toSized :: SBV Word16 -> ToSized (SBV Word16)
toSized = SBV Word16 -> SWord 16
SBV Word16 -> ToSized (SBV Word16)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} ToSizedBV SWord32 where toSized :: SBV Word32 -> ToSized (SBV Word32)
toSized = SBV Word32 -> SWord 32
SBV Word32 -> ToSized (SBV Word32)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} ToSizedBV SWord64 where toSized :: SBV Word64 -> ToSized (SBV Word64)
toSized = SBV Word64 -> SWord 64
SBV Word64 -> ToSized (SBV Word64)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} ToSizedBV SInt8   where toSized :: SBV Int8 -> ToSized (SBV Int8)
toSized = SBV Int8 -> SInt 8
SBV Int8 -> ToSized (SBV Int8)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} ToSizedBV SInt16  where toSized :: SBV Int16 -> ToSized (SBV Int16)
toSized = SBV Int16 -> SInt 16
SBV Int16 -> ToSized (SBV Int16)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} ToSizedBV SInt32  where toSized :: SBV Int32 -> ToSized (SBV Int32)
toSized = SBV Int32 -> SInt 32
SBV Int32 -> ToSized (SBV Int32)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPING  #-} ToSizedBV SInt64  where toSized :: SBV Int64 -> ToSized (SBV Int64)
toSized = SBV Int64 -> SInt 64
SBV Int64 -> ToSized (SBV Int64)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral
instance {-# OVERLAPPABLE #-} ToSizedCstr arg => ToSizedBV arg where toSized :: arg -> ToSized arg
toSized = String -> arg -> ToSized arg
forall a. HasCallStack => String -> a
error String
"unreachable"

-- | 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 = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` a
y
  a
x `sRem`  a
y = (a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` a
y
  a
x `sDiv`  a
y = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall a. SDivisible a => a -> a -> (a, a)
`sDivMod`  a
y
  a
x `sMod`  a
y = (a, a) -> a
forall a b. (a, b) -> b
snd ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> (a, a)
forall a. SDivisible a => a -> a -> (a, a)
`sDivMod`  a
y

instance SDivisible Word64 where
  sQuotRem :: Word64 -> Word64 -> (Word64, Word64)
sQuotRem Word64
x Word64
0 = (Word64
0, Word64
x)
  sQuotRem Word64
x Word64
y = Word64
x Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word64
y
  sDivMod :: Word64 -> Word64 -> (Word64, Word64)
sDivMod  Word64
x Word64
0 = (Word64
0, Word64
x)
  sDivMod  Word64
x Word64
y = Word64
x Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word64
y

instance SDivisible Int64 where
  sQuotRem :: Int64 -> Int64 -> (Int64, Int64)
sQuotRem Int64
x Int64
0 = (Int64
0, Int64
x)
  sQuotRem Int64
x Int64
y = Int64
x Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int64
y
  sDivMod :: Int64 -> Int64 -> (Int64, Int64)
sDivMod  Int64
x Int64
0 = (Int64
0, Int64
x)
  sDivMod  Int64
x Int64
y = Int64
x Int64 -> Int64 -> (Int64, Int64)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int64
y

instance SDivisible Word32 where
  sQuotRem :: Word32 -> Word32 -> (Word32, Word32)
sQuotRem Word32
x Word32
0 = (Word32
0, Word32
x)
  sQuotRem Word32
x Word32
y = Word32
x Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word32
y
  sDivMod :: Word32 -> Word32 -> (Word32, Word32)
sDivMod  Word32
x Word32
0 = (Word32
0, Word32
x)
  sDivMod  Word32
x Word32
y = Word32
x Word32 -> Word32 -> (Word32, Word32)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word32
y

instance SDivisible Int32 where
  sQuotRem :: Int32 -> Int32 -> (Int32, Int32)
sQuotRem Int32
x Int32
0 = (Int32
0, Int32
x)
  sQuotRem Int32
x Int32
y = Int32
x Int32 -> Int32 -> (Int32, Int32)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int32
y
  sDivMod :: Int32 -> Int32 -> (Int32, Int32)
sDivMod  Int32
x Int32
0 = (Int32
0, Int32
x)
  sDivMod  Int32
x Int32
y = Int32
x Int32 -> Int32 -> (Int32, Int32)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int32
y

instance SDivisible Word16 where
  sQuotRem :: Word16 -> Word16 -> (Word16, Word16)
sQuotRem Word16
x Word16
0 = (Word16
0, Word16
x)
  sQuotRem Word16
x Word16
y = Word16
x Word16 -> Word16 -> (Word16, Word16)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word16
y
  sDivMod :: Word16 -> Word16 -> (Word16, Word16)
sDivMod  Word16
x Word16
0 = (Word16
0, Word16
x)
  sDivMod  Word16
x Word16
y = Word16
x Word16 -> Word16 -> (Word16, Word16)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word16
y

instance SDivisible Int16 where
  sQuotRem :: Int16 -> Int16 -> (Int16, Int16)
sQuotRem Int16
x Int16
0 = (Int16
0, Int16
x)
  sQuotRem Int16
x Int16
y = Int16
x Int16 -> Int16 -> (Int16, Int16)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int16
y
  sDivMod :: Int16 -> Int16 -> (Int16, Int16)
sDivMod  Int16
x Int16
0 = (Int16
0, Int16
x)
  sDivMod  Int16
x Int16
y = Int16
x Int16 -> Int16 -> (Int16, Int16)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int16
y

instance SDivisible Word8 where
  sQuotRem :: Word8 -> Word8 -> (Word8, Word8)
sQuotRem Word8
x Word8
0 = (Word8
0, Word8
x)
  sQuotRem Word8
x Word8
y = Word8
x Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Word8
y
  sDivMod :: Word8 -> Word8 -> (Word8, Word8)
sDivMod  Word8
x Word8
0 = (Word8
0, Word8
x)
  sDivMod  Word8
x Word8
y = Word8
x Word8 -> Word8 -> (Word8, Word8)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word8
y

instance SDivisible Int8 where
  sQuotRem :: Int8 -> Int8 -> (Int8, Int8)
sQuotRem Int8
x Int8
0 = (Int8
0, Int8
x)
  sQuotRem Int8
x Int8
y = Int8
x Int8 -> Int8 -> (Int8, Int8)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int8
y
  sDivMod :: Int8 -> Int8 -> (Int8, Int8)
sDivMod  Int8
x Int8
0 = (Int8
0, Int8
x)
  sDivMod  Int8
x Int8
y = Int8
x Int8 -> Int8 -> (Int8, Int8)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int8
y

instance SDivisible Integer where
  sQuotRem :: Integer -> Integer -> (Integer, Integer)
sQuotRem Integer
x Integer
0 = (Integer
0, Integer
x)
  sQuotRem Integer
x Integer
y = Integer
x Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
y
  sDivMod :: Integer -> Integer -> (Integer, Integer)
sDivMod  Integer
x Integer
0 = (Integer
0, Integer
x)
  sDivMod  Integer
x Integer
y = Integer
x Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
y

instance SDivisible CV where
  sQuotRem :: CV -> CV -> (CV, CV)
sQuotRem CV
a CV
b
    | CInteger Integer
x <- CV -> CVal
cvVal CV
a, CInteger Integer
y <- CV -> CVal
cvVal CV
b
    = let (Integer
r1, Integer
r2) = Integer -> Integer -> (Integer, Integer)
forall a. SDivisible a => a -> a -> (a, a)
sQuotRem Integer
x Integer
y in (CV -> CV
normCV CV
a{ cvVal = CInteger r1 }, CV -> CV
normCV CV
b{ cvVal = CInteger r2 })
  sQuotRem CV
a CV
b = String -> (CV, CV)
forall a. HasCallStack => String -> a
error (String -> (CV, CV)) -> String -> (CV, CV)
forall a b. (a -> b) -> a -> b
$ String
"SBV.sQuotRem: impossible, unexpected args received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (CV, CV) -> String
forall a. Show a => a -> String
show (CV
a, CV
b)
  sDivMod :: CV -> CV -> (CV, CV)
sDivMod CV
a CV
b
    | CInteger Integer
x <- CV -> CVal
cvVal CV
a, CInteger Integer
y <- CV -> CVal
cvVal CV
b
    = let (Integer
r1, Integer
r2) = Integer -> Integer -> (Integer, Integer)
forall a. SDivisible a => a -> a -> (a, a)
sDivMod Integer
x Integer
y in (CV -> CV
normCV CV
a{ cvVal = CInteger r1 }, CV -> CV
normCV CV
b{ cvVal = CInteger r2 })
  sDivMod CV
a CV
b = String -> (CV, CV)
forall a. HasCallStack => String -> a
error (String -> (CV, CV)) -> String -> (CV, CV)
forall a b. (a -> b) -> a -> b
$ String
"SBV.sDivMod: impossible, unexpected args received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (CV, CV) -> String
forall a. Show a => a -> String
show (CV
a, CV
b)

instance SDivisible SWord64 where {sQuotRem :: SBV Word64 -> SBV Word64 -> (SBV Word64, SBV Word64)
sQuotRem = SBV Word64 -> SBV Word64 -> (SBV Word64, SBV Word64)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem; sDivMod :: SBV Word64 -> SBV Word64 -> (SBV Word64, SBV Word64)
sDivMod  = SBV Word64 -> SBV Word64 -> (SBV Word64, SBV Word64)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod}
instance SDivisible SWord32 where {sQuotRem :: SBV Word32 -> SBV Word32 -> (SBV Word32, SBV Word32)
sQuotRem = SBV Word32 -> SBV Word32 -> (SBV Word32, SBV Word32)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem; sDivMod :: SBV Word32 -> SBV Word32 -> (SBV Word32, SBV Word32)
sDivMod  = SBV Word32 -> SBV Word32 -> (SBV Word32, SBV Word32)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod}
instance SDivisible SWord16 where {sQuotRem :: SBV Word16 -> SBV Word16 -> (SBV Word16, SBV Word16)
sQuotRem = SBV Word16 -> SBV Word16 -> (SBV Word16, SBV Word16)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem; sDivMod :: SBV Word16 -> SBV Word16 -> (SBV Word16, SBV Word16)
sDivMod  = SBV Word16 -> SBV Word16 -> (SBV Word16, SBV Word16)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod}
instance SDivisible SWord8  where {sQuotRem :: SBV Word8 -> SBV Word8 -> (SBV Word8, SBV Word8)
sQuotRem = SBV Word8 -> SBV Word8 -> (SBV Word8, SBV Word8)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem; sDivMod :: SBV Word8 -> SBV Word8 -> (SBV Word8, SBV Word8)
sDivMod  = SBV Word8 -> SBV Word8 -> (SBV Word8, SBV Word8)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod}
instance SDivisible SInt64  where {sQuotRem :: SBV Int64 -> SBV Int64 -> (SBV Int64, SBV Int64)
sQuotRem = SBV Int64 -> SBV Int64 -> (SBV Int64, SBV Int64)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem; sDivMod :: SBV Int64 -> SBV Int64 -> (SBV Int64, SBV Int64)
sDivMod  = SBV Int64 -> SBV Int64 -> (SBV Int64, SBV Int64)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod}
instance SDivisible SInt32  where {sQuotRem :: SBV Int32 -> SBV Int32 -> (SBV Int32, SBV Int32)
sQuotRem = SBV Int32 -> SBV Int32 -> (SBV Int32, SBV Int32)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem; sDivMod :: SBV Int32 -> SBV Int32 -> (SBV Int32, SBV Int32)
sDivMod  = SBV Int32 -> SBV Int32 -> (SBV Int32, SBV Int32)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod}
instance SDivisible SInt16  where {sQuotRem :: SBV Int16 -> SBV Int16 -> (SBV Int16, SBV Int16)
sQuotRem = SBV Int16 -> SBV Int16 -> (SBV Int16, SBV Int16)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem; sDivMod :: SBV Int16 -> SBV Int16 -> (SBV Int16, SBV Int16)
sDivMod  = SBV Int16 -> SBV Int16 -> (SBV Int16, SBV Int16)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod}
instance SDivisible SInt8   where {sQuotRem :: SBV Int8 -> SBV Int8 -> (SBV Int8, SBV Int8)
sQuotRem = SBV Int8 -> SBV Int8 -> (SBV Int8, SBV Int8)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem; sDivMod :: SBV Int8 -> SBV Int8 -> (SBV Int8, SBV Int8)
sDivMod  = SBV Int8 -> SBV Int8 -> (SBV Int8, SBV Int8)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod}

-- | 'SDivisible' instance for 'WordN'
instance (KnownNat n, BVIsNonZero n) => SDivisible (WordN n) where
  sQuotRem :: WordN n -> WordN n -> (WordN n, WordN n)
sQuotRem WordN n
x WordN n
0 = (WordN n
0, WordN n
x)
  sQuotRem WordN n
x WordN n
y = WordN n
x WordN n -> WordN n -> (WordN n, WordN n)
forall a. Integral a => a -> a -> (a, a)
`quotRem` WordN n
y
  sDivMod :: WordN n -> WordN n -> (WordN n, WordN n)
sDivMod  WordN n
x WordN n
0 = (WordN n
0, WordN n
x)
  sDivMod  WordN n
x WordN n
y = WordN n
x WordN n -> WordN n -> (WordN n, WordN n)
forall a. Integral a => a -> a -> (a, a)
`divMod` WordN n
y

-- | 'SDivisible' instance for 'IntN'
instance (KnownNat n, BVIsNonZero n) => SDivisible (IntN n) where
  sQuotRem :: IntN n -> IntN n -> (IntN n, IntN n)
sQuotRem IntN n
x IntN n
0 = (IntN n
0, IntN n
x)
  sQuotRem IntN n
x IntN n
y = IntN n
x IntN n -> IntN n -> (IntN n, IntN n)
forall a. Integral a => a -> a -> (a, a)
`quotRem` IntN n
y
  sDivMod :: IntN n -> IntN n -> (IntN n, IntN n)
sDivMod  IntN n
x IntN n
0 = (IntN n
0, IntN n
x)
  sDivMod  IntN n
x IntN n
y = IntN n
x IntN n -> IntN n -> (IntN n, IntN n)
forall a. Integral a => a -> a -> (a, a)
`divMod` IntN n
y

-- | 'SDivisible' instance for 'SWord'
instance (KnownNat n, BVIsNonZero n) => SDivisible (SWord n) where
  sQuotRem :: SWord n -> SWord n -> (SWord n, SWord n)
sQuotRem = SWord n -> SWord n -> (SWord n, SWord n)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SWord n -> SWord n -> (SWord n, SWord n)
sDivMod  = SWord n -> SWord n -> (SWord n, SWord n)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod

-- | 'SDivisible' instance for 'SInt'
instance (KnownNat n, BVIsNonZero n) => SDivisible (SInt n) where
  sQuotRem :: SInt n -> SInt n -> (SInt n, SInt n)
sQuotRem = SInt n -> SInt n -> (SInt n, SInt n)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem
  sDivMod :: SInt n -> SInt n -> (SInt n, SInt n)
sDivMod  = SInt n -> SInt n -> (SInt n, SInt n)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod

-- | Does the concrete positive number n divide the given integer?
sDivides :: Integer -> SInteger -> SBool
sDivides :: Integer -> SInteger -> SBool
sDivides Integer
n SInteger
v
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
  = String -> SBool
forall a. HasCallStack => String -> a
error (String -> SBool) -> String -> SBool
forall a b. (a -> b) -> a -> b
$ String
"svDivides: First argument must be a strictly positive integer. Received: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n
  | Just Integer
x <- SInteger -> Maybe Integer
forall a. SymVal a => SBV a -> Maybe a
unliteral SInteger
v
  = if Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then SBool
sTrue else SBool
sFalse
  | Bool
True
  = SVal -> SBool
forall a. SVal -> SBV a
SBV (SVal -> SBool) -> SVal -> SBool
forall a b. (a -> b) -> a -> b
$ Integer -> SVal -> SVal
svDivides Integer
n (SInteger -> SVal
forall a. SBV a -> SVal
unSBV SInteger
v)

-- | 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
  | SBV a -> Bool
forall {a}. SBV a -> Bool
isConcreteZero SBV a
x
  = (SBV a
x, SBV a
x)
  | SBV a -> Bool
forall {a}. SBV a -> Bool
isConcreteOne SBV a
y
  = (SBV a
x, SBV a
z)
{-------------------------------
 - 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
  = SBool -> (SBV a, SBV a) -> (SBV a, SBV a) -> (SBV a, SBV a)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
y SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
z) (SBV a
z, SBV a
x) (SBV a -> SBV a -> (SBV a, SBV a)
forall {a} {a} {a} {a}. SBV a -> SBV a -> (SBV a, SBV a)
qr SBV a
x SBV a
y)
  where qr :: SBV a -> SBV a -> (SBV a, SBV a)
qr (SBV (SVal Kind
sgnsz (Left CV
a))) (SBV (SVal Kind
_ (Left CV
b))) = let (CV
q, CV
r) = CV -> CV -> (CV, CV)
forall a. SDivisible a => a -> a -> (a, a)
sQuotRem CV
a CV
b in (SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left CV
q)), SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (CV -> Either CV (Cached SV)
forall a b. a -> Either a b
Left CV
r)))
        qr a :: SBV a
a@(SBV (SVal Kind
sgnsz Either CV (Cached SV)
_))      SBV a
b                       = (SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache (Op -> State -> IO SV
mk Op
Quot)))), SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
sgnsz (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache (Op -> State -> IO SV
mk Op
Rem)))))
                where mk :: Op -> State -> IO SV
mk Op
o State
st = do SV
sw1 <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
a
                                   SV
sw2 <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
b
                                   Op -> State -> Kind -> SV -> SV -> IO SV
mkSymOp Op
o State
st Kind
sgnsz SV
sw1 SV
sw2
        z :: SBV a
z = Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer
0::Integer)

-- | 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, Num (SBV a), SDivisible (SBV a)) => SBV a -> SBV a -> (SBV a, SBV a)
liftDMod :: forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod SBV a
x SBV a
y
  | SBV a -> Bool
forall {a}. SBV a -> Bool
isConcreteZero SBV a
x
  = (SBV a
x, SBV a
x)
  | SBV a -> Bool
forall {a}. SBV a -> Bool
isConcreteOne SBV a
y
  = (SBV a
x, SBV a
z)
{-------------------------------
 - 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
  = SBool -> (SBV a, SBV a) -> (SBV a, SBV a) -> (SBV a, SBV a)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a
y SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
z) (SBV a
z, SBV a
x) ((SBV a, SBV a) -> (SBV a, SBV a))
-> (SBV a, SBV a) -> (SBV a, SBV a)
forall a b. (a -> b) -> a -> b
$ SBool -> (SBV a, SBV a) -> (SBV a, SBV a) -> (SBV a, SBV a)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV a -> SBV a
forall a. Num a => a -> a
signum SBV a
r SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV a
forall a. Num a => a -> a
negate (SBV a -> SBV a
forall a. Num a => a -> a
signum SBV a
y)) (SBV a
qSBV a -> SBV a -> SBV a
forall a. Num a => a -> a -> a
-SBV a
i, SBV a
rSBV a -> SBV a -> SBV a
forall a. Num a => a -> a -> a
+SBV a
y) (SBV a, SBV a)
qr
 where qr :: (SBV a, SBV a)
qr@(SBV a
q, SBV a
r) = SBV a
x SBV a -> SBV a -> (SBV a, SBV a)
forall a. SDivisible a => a -> a -> (a, a)
`sQuotRem` SBV a
y
       z :: SBV a
z = Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer
0::Integer)
       i :: SBV a
i = Kind -> Integer -> SBV a
forall a b. Integral a => Kind -> a -> SBV b
genLiteral (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Integer
1::Integer)

-- 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 SInteger
x SInteger
y = SBool
-> (SInteger, SInteger)
-> (SInteger, SInteger)
-> (SInteger, SInteger)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
y SInteger -> SInteger -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.> SInteger
0) (SInteger -> SInteger -> (SInteger, SInteger)
sEDivMod SInteger
x SInteger
y) (SInteger -> SInteger -> (SInteger, SInteger)
forall a.
(Ord a, SymVal a, Num a, Num (SBV a), SDivisible (SBV a)) =>
SBV a -> SBV a -> (SBV a, SBV a)
liftDMod SInteger
x SInteger
y)
  sQuotRem :: SInteger -> SInteger -> (SInteger, SInteger)
sQuotRem SInteger
x SInteger
y
    | Bool -> Bool
not (SInteger -> Bool
forall a. SymVal a => SBV a -> Bool
isSymbolic SInteger
x Bool -> Bool -> Bool
|| SInteger -> Bool
forall a. SymVal a => SBV a -> Bool
isSymbolic SInteger
y)
    = SInteger -> SInteger -> (SInteger, SInteger)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem SInteger
x SInteger
y
    | Bool
True
    = SBool
-> (SInteger, SInteger)
-> (SInteger, SInteger)
-> (SInteger, SInteger)
forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
y SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
0) (SInteger
0, SInteger
x) (SInteger
qESInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
+SInteger
i, SInteger
rESInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
-SInteger
iSInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
*SInteger
y)
    where (SInteger
qE, SInteger
rE) = SInteger -> SInteger -> (SInteger, SInteger)
forall a. (Eq a, SymVal a) => SBV a -> SBV a -> (SBV a, SBV a)
liftQRem SInteger
x SInteger
y   -- for integers, this is euclidean due to SMTLib semantics
          i :: SInteger
i = SBool -> SInteger -> SInteger -> SInteger
forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
x SInteger -> SInteger -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>= SInteger
0 SBool -> SBool -> SBool
.|| SInteger
rE SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
0) SInteger
0
            (SInteger -> SInteger) -> SInteger -> SInteger
forall a b. (a -> b) -> a -> b
$ SBool -> SInteger -> SInteger -> SInteger
forall a. Mergeable a => SBool -> a -> a -> a
ite (SInteger
y SInteger -> SInteger -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.>  SInteger
0)              SInteger
1 (-SInteger
1)

-- | Euclidian division and modulus.
sEDivMod :: SInteger -> SInteger -> (SInteger, SInteger)
sEDivMod :: SInteger -> SInteger -> (SInteger, SInteger)
sEDivMod SInteger
a SInteger
b = (SInteger
a SInteger -> SInteger -> SInteger
`sEDiv` SInteger
b, SInteger
a SInteger -> SInteger -> SInteger
`sEMod` SInteger
b)

-- | Euclidian division.
sEDiv :: SInteger -> SInteger -> SInteger
sEDiv :: SInteger -> SInteger -> SInteger
sEDiv (SBV SVal
a) (SBV SVal
b) = SVal -> SInteger
forall a. SVal -> SBV a
SBV (SVal -> SInteger) -> SVal -> SInteger
forall a b. (a -> b) -> a -> b
$ SVal
a SVal -> SVal -> SVal
`svQuot` SVal
b

-- | Euclidian modulus.
sEMod :: SInteger -> SInteger -> SInteger
sEMod :: SInteger -> SInteger -> SInteger
sEMod (SBV SVal
a) (SBV SVal
b) = SVal -> SInteger
forall a. SVal -> SBV a
SBV (SVal -> SInteger) -> SVal -> SInteger
forall a b. (a -> b) -> a -> b
$ SVal
a SVal -> SVal -> SVal
`svRem` SVal
b

-- Quickcheck interface
instance (SymVal a, Arbitrary a) => Arbitrary (SBV a) where
  arbitrary :: Gen (SBV a)
arbitrary = a -> SBV a
forall a. SymVal a => a -> SBV a
literal (a -> SBV a) -> Gen a -> Gen (SBV a)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Gen a
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, Num (SBV 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
    | SBV b -> Bool
forall a. HasKind a => a -> Bool
isReal   SBV b
ind = String -> a
forall a. String -> a
bad String
"real"
    | SBV b -> Bool
forall a. HasKind a => a -> Bool
isFloat  SBV b
ind = String -> a
forall a. String -> a
bad String
"float"
    | SBV b -> Bool
forall a. HasKind a => a -> Bool
isDouble SBV b
ind = String -> a
forall a. String -> a
bad String
"double"
    | SBV b -> Bool
forall a. HasKind a => a -> Bool
hasSign  SBV b
ind = SBool -> a -> a -> a
forall a. Mergeable a => SBool -> a -> a -> a
ite (SBV b
ind SBV b -> SBV b -> SBool
forall a. OrdSymbolic a => a -> a -> SBool
.< SBV b
0) a
err ([a] -> SBV b -> a -> a
forall {a} {t}.
(Num a, Mergeable t, EqSymbolic a) =>
[t] -> a -> t -> t
walk [a]
xs SBV b
ind a
err)
    | Bool
True         =                     [a] -> SBV b -> a -> a
forall {a} {t}.
(Num a, Mergeable t, EqSymbolic a) =>
[t] -> a -> t -> t
walk [a]
xs SBV b
ind a
err
    where bad :: String -> a
bad String
w = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"SBV.select: unsupported " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" valued select/index expression"
          walk :: [t] -> a -> t -> t
walk []     a
_ t
acc = t
acc
          walk (t
e:[t]
es) a
i t
acc = [t] -> a -> t -> t
walk [t]
es (a
ia -> a -> a
forall a. Num a => a -> a -> a
-a
1) (SBool -> t -> t -> t
forall a. Mergeable a => SBool -> a -> a -> a
ite (a
i a -> a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== a
0) t
e t
acc)

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

-- | 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 <- SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
t = if Bool
r then a
a else a
b
  | Bool
True                  = Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
True SBool
t a
a a
b

-- | 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 <- SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
t = if Bool
r then a
a else a
b
  | Bool
True                  = Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
False SBool
t a
a a
b

-- | 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 -> String -> SBool -> SBV a -> SBV a
sAssert Maybe CallStack
cs String
msg SBool
cond SBV a
x
   | Just Bool
mustHold <- SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
cond
   = if Bool
mustHold
     then SBV a
x
     else String -> SBV a
forall a. HasCallStack => String -> a
error (String -> SBV a) -> String -> SBV a
forall a b. (a -> b) -> a -> b
$ SafeResult -> String
forall a. Show a => a -> String
show (SafeResult -> String) -> SafeResult -> String
forall a b. (a -> b) -> a -> b
$ (Maybe String, String, SMTResult) -> SafeResult
SafeResult (([(String, SrcLoc)] -> String
locInfo ([(String, SrcLoc)] -> String)
-> (CallStack -> [(String, SrcLoc)]) -> CallStack -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [(String, SrcLoc)]
getCallStack) (CallStack -> String) -> Maybe CallStack -> Maybe String
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Maybe CallStack
cs, String
msg, SMTConfig -> SMTModel -> SMTResult
Satisfiable SMTConfig
defaultSMTCfg ([(String, GeneralizedCV)]
-> Maybe [(NamedSymVar, CV)]
-> [(String, CV)]
-> [(String, (Bool, SBVType, Either String ([([CV], CV)], CV)))]
-> SMTModel
SMTModel [] Maybe [(NamedSymVar, CV)]
forall a. Maybe a
Nothing [] []))
   | Bool
True
   = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where k :: Kind
k     = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x
        r :: State -> IO SV
r State
st  = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
                   let pc :: SBool
pc = State -> SBool
getPathCondition State
st
                       -- 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 <- State -> SBool -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBool
mustNeverHappen
                   State -> Maybe CallStack -> String -> SV -> IO ()
addAssertion State
st Maybe CallStack
cs String
msg SV
cnd
                   SV -> IO SV
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SV
xsv

        locInfo :: [(String, SrcLoc)] -> String
locInfo [(String, SrcLoc)]
ps = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
",\n " (((String, SrcLoc) -> String) -> [(String, SrcLoc)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, SrcLoc) -> String
loc [(String, SrcLoc)]
ps)
          where loc :: (String, SrcLoc) -> String
loc (String
f, SrcLoc
sl) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [SrcLoc -> String
srcLocFile SrcLoc
sl, String
":", Int -> String
forall a. Show a => a -> String
show (SrcLoc -> Int
srcLocStartLine SrcLoc
sl), String
":", Int -> String
forall a. Show a => a -> String
show (SrcLoc -> Int
srcLocStartCol SrcLoc
sl), String
":", String
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) = SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Bool -> SVal -> SVal -> SVal -> SVal
svSymbolicMerge Kind
k Bool
force SVal
t SVal
a SVal
b)

instance SymVal a => Mergeable (SBV a) where
    symbolicMerge :: Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMerge Bool
force SBool
t SBV a
x SBV a
y
    -- Carefully use the kindOf instance to avoid strictness issues.
       | Bool
force = Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
forall a. Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMergeWithKind (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x)          Bool
True  SBool
t SBV a
x SBV a
y
       | Bool
True  = Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
forall a. Kind -> Bool -> SBool -> SBV a -> SBV a -> SBV a
symbolicMergeWithKind (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) Bool
False SBool
t SBV a
x SBV a
y
    -- 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, Num (SBV b)) =>
[SBV a] -> SBV a -> SBV b -> SBV a
select [SBV a]
xs SBV a
err SBV b
ind
      | SBV (SVal Kind
_ (Left CV
c)) <- SBV b
ind = case CV -> CVal
cvVal CV
c of
                                         CInteger Integer
i -> if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= [SBV a] -> Integer
forall i a. Num i => [a] -> i
genericLength [SBV a]
xs
                                                       then SBV a
err
                                                       else [SBV a]
xs [SBV a] -> Integer -> SBV a
forall i a. Integral i => [a] -> i -> a
`genericIndex` Integer
i
                                         CVal
_          -> String -> SBV a
forall a. HasCallStack => String -> a
error (String -> SBV a) -> String -> SBV a
forall a b. (a -> b) -> a -> b
$ String
"SBV.select: unsupported " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (SBV b -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV b
ind) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" valued select/index expression"
    select [SBV a]
xsOrig SBV a
err SBV b
ind = [SBV a]
xs [SBV a] -> SBV a -> SBV a
forall a b. a -> b -> b
`seq` SVal -> SBV a
forall a. SVal -> SBV a
SBV (Kind -> Either CV (Cached SV) -> SVal
SVal Kind
kElt (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r)))
      where kInd :: Kind
kInd = SBV b -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV b
ind
            kElt :: Kind
kElt = SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
err
            -- 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 SBV b -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV b
ind of
                     KBounded Bool
False Int
i -> Integer -> [SBV a] -> [SBV a]
forall i a. Integral i => i -> [a] -> [a]
genericTake ((Integer
2::Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i     :: Integer)) [SBV a]
xsOrig
                     KBounded Bool
True  Int
i -> Integer -> [SBV a] -> [SBV a]
forall i a. Integral i => i -> [a] -> [a]
genericTake ((Integer
2::Integer) Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: Integer)) [SBV a]
xsOrig
                     Kind
KUnbounded       -> [SBV a]
xsOrig
                     Kind
_                -> String -> [SBV a]
forall a. HasCallStack => String -> a
error (String -> [SBV a]) -> String -> [SBV a]
forall a b. (a -> b) -> a -> b
$ String
"SBV.select: unsupported " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
forall a. Show a => a -> String
show (SBV b -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV b
ind) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" valued select/index expression"
            r :: State -> IO SV
r State
st  = do [SV]
sws <- (SBV a -> IO SV) -> [SBV a] -> IO [SV]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st) [SBV a]
xs
                       SV
swe <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
err
                       if (SV -> Bool) -> [SV] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SV -> SV -> Bool
forall a. Eq a => a -> a -> Bool
== SV
swe) [SV]
sws  -- off-chance that all elts are the same. Note that this also correctly covers the case when list is empty.
                          then SV -> IO SV
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SV
swe
                          else do Int
idx <- State -> Kind -> Kind -> [SV] -> IO Int
getTableIndex State
st Kind
kInd Kind
kElt [SV]
sws
                                  SV
swi <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
ind
                                  let len :: Int
len = [SBV a] -> Int
forall a. [a] -> Int
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. String -> String -> String -> a
cannotMerge String
typ String
why String
hint = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
""
                                           , String
"*** Data.SBV.Mergeable: Cannot merge instances of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
                                           , String
"*** While trying to do a symbolic if-then-else with incompatible branch results."
                                           , String
"***"
                                           , String
"*** " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
why
                                           , String
"*** "
                                           , String
"*** Hint: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
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 =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
t String
st a -> a -> Bool
eq a
x a
y
  | a
x a -> a -> Bool
`eq` a
y = a
x
  | Bool
True     = String -> String -> String -> a
forall a. String -> String -> String -> a
cannotMerge String
t
                           (String
"Concrete values can only be merged when equal. Got: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" vs. " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y)
                           (String
"Use an " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
st String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" 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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lys = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t) [a]
xs [a]
ys
    | Bool
True       = String -> String -> String -> [a]
forall a. String -> String -> String -> a
cannotMerge String
"lists"
                               (String
"Branches produce different sizes: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lxs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" vs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lys String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Must have the same length.")
                               String
"Use the 'SList' type (and Data.SBV.List routines) to model fully symbolic lists."
    where (Int
lxs, Int
lys) = ([a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs, [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ys)

-- NonEmpty
instance Mergeable a => Mergeable (NonEmpty a) where
   symbolicMerge :: Bool -> SBool -> NonEmpty a -> NonEmpty a -> NonEmpty a
symbolicMerge Bool
f SBool
t NonEmpty a
xs NonEmpty a
ys
     | Int
lxs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lys = (a -> a -> a) -> NonEmpty a -> NonEmpty a -> NonEmpty a
forall a b c.
(a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c
NE.zipWith (Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t) NonEmpty a
xs NonEmpty a
ys
     | Bool
True       = String -> String -> String -> NonEmpty a
forall a. String -> String -> String -> a
cannotMerge String
"non-empty lists"
                                (String
"Branches produce different sizes: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lxs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" vs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
lys String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
". Must have the same length.")
                                String
"Use the 'SList' type (and Data.SBV.List routines) to model fully symbolic lists."
     where (Int
lxs, Int
lys) = (NonEmpty a -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty a
xs, NonEmpty a -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty 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)
    = [a] -> ZipList a
forall a. [a] -> ZipList a
ZipList (Bool -> SBool -> [a] -> [a] -> [a]
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
force SBool
test [a]
xs [a]
ys)

-- 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  = Maybe a
forall a. Maybe a
Nothing
  symbolicMerge Bool
f SBool
t (Just a
a) (Just a
b) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
a a
b
  symbolicMerge Bool
_ SBool
_ Maybe a
a Maybe a
b = String -> String -> String -> Maybe a
forall a. String -> String -> String -> a
cannotMerge String
"'Maybe' values"
                                      (String
"Branches produce different constructors: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a. Show a => a -> String
show (Maybe a -> String
forall {a}. Maybe a -> String
k Maybe a
a, Maybe a -> String
forall {a}. Maybe a -> String
k Maybe a
b))
                                      String
"Instead of an option type, try using a valid bit to indicate when a result is valid."
      where k :: Maybe a -> String
k Maybe a
Nothing = String
"Nothing"
            k Maybe a
_       = String
"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)  = a -> Either a b
forall a b. a -> Either a b
Left  (a -> Either a b) -> a -> Either a b
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
a a
b
  symbolicMerge Bool
f SBool
t (Right b
a) (Right b
b) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> b -> Either a b
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
a b
b
  symbolicMerge Bool
_ SBool
_ Either a b
a Either a b
b = String -> String -> String -> Either a b
forall a. String -> String -> String -> a
cannotMerge String
"'Either' values"
                                      (String
"Branches produce different constructors: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String, String) -> String
forall a. Show a => a -> String
show (Either a b -> String
forall {a} {b}. Either a b -> String
k Either a b
a, Either a b -> String
forall {a} {b}. Either a b -> String
k Either a b
b))
                                      String
"Consider using a product type by a tag instead."
     where k :: Either a b -> String
k (Left a
_)  = String
"Left"
           k (Right b
_) = String
"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 (a, a) -> (a, a) -> Bool
forall a. Eq a => a -> a -> Bool
== (a, a)
bb = (a, a) -> [b] -> Array a b
forall i e. Ix i => (i, i) -> [e] -> Array i e
DA.listArray (a, a)
ba ((b -> b -> b) -> [b] -> [b] -> [b]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t) (Array a b -> [b]
forall i e. Array i e -> [e]
elems Array a b
a) (Array a b -> [b]
forall i e. Array i e -> [e]
elems Array a b
b))
    | Bool
True     = String -> String -> String -> Array a b
forall a. String -> String -> String -> a
cannotMerge String
"'Array' values"
                             (String
"Branches produce different ranges: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show ((a, a) -> Int
k (a, a)
ba, (a, a) -> Int
k (a, a)
bb))
                             String
"Consider using SBV's native 'SArray' abstraction."
    where [(a, a)
ba, (a, a)
bb] = (Array a b -> (a, a)) -> [Array a b] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map Array a b -> (a, a)
forall i e. Array i e -> (i, i)
bounds [Array a b
a, Array a b
b]
          k :: (a, a) -> Int
k = (a, a) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize

-- 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 = Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t (a -> b
g a
x) (a -> b
h a
x)
  {- 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) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                        , Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                        )

  select :: forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[(a, b)] -> (a, b) -> SBV b -> (a, b)
select [(a, b)]
xs (a
err1, b
err2) SBV b
ind = ( [a] -> a -> SBV b -> a
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                               , [b] -> b -> SBV b -> b
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                               )
    where ([a]
as, [b]
bs) = [(a, b)] -> ([a], [b])
forall a b. [(a, b)] -> ([a], [b])
unzip [(a, b)]
xs

-- 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) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                , Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                , Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
                                                )

  select :: forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[(a, b, c)] -> (a, b, c) -> SBV b -> (a, b, c)
select [(a, b, c)]
xs (a
err1, b
err2, c
err3) SBV b
ind = ( [a] -> a -> SBV b -> a
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                     , [b] -> b -> SBV b -> b
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                     , [c] -> c -> SBV b -> c
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
                                     )

    where ([a]
as, [b]
bs, [c]
cs) = [(a, b, c)] -> ([a], [b], [c])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(a, b, c)]
xs

-- 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) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                        , Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                        , Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
                                                        , Bool -> SBool -> d -> d -> d
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
                                                        )

  select :: forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[(a, b, c, d)] -> (a, b, c, d) -> SBV b -> (a, b, c, d)
select [(a, b, c, d)]
xs (a
err1, b
err2, c
err3, d
err4) SBV b
ind = ( [a] -> a -> SBV b -> a
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                           , [b] -> b -> SBV b -> b
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                           , [c] -> c -> SBV b -> c
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
                                           , [d] -> d -> SBV b -> d
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[d] -> d -> SBV b -> d
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
                                           )
    where ([a]
as, [b]
bs, [c]
cs, [d]
ds) = [(a, b, c, d)] -> ([a], [b], [c], [d])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [(a, b, c, d)]
xs

-- 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) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                                , Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                                , Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
                                                                , Bool -> SBool -> d -> d -> d
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
                                                                , Bool -> SBool -> e -> e -> e
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t e
i4 e
j4
                                                                )

  select :: forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[(a, b, c, d, e)] -> (a, b, c, d, e) -> SBV b -> (a, b, c, d, e)
select [(a, b, c, d, e)]
xs (a
err1, b
err2, c
err3, d
err4, e
err5) SBV b
ind = ( [a] -> a -> SBV b -> a
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                                 , [b] -> b -> SBV b -> b
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                                 , [c] -> c -> SBV b -> c
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
                                                 , [d] -> d -> SBV b -> d
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[d] -> d -> SBV b -> d
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
                                                 , [e] -> e -> SBV b -> e
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[e] -> e -> SBV b -> e
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [e]
es e
err5 SBV b
ind
                                                 )
    where ([a]
as, [b]
bs, [c]
cs, [d]
ds, [e]
es) = [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
forall a b c d e. [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
unzip5 [(a, b, c, d, e)]
xs

-- 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) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                                        , Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                                        , Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
                                                                        , Bool -> SBool -> d -> d -> d
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
                                                                        , Bool -> SBool -> e -> e -> e
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t e
i4 e
j4
                                                                        , Bool -> SBool -> f -> f -> f
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t f
i5 f
j5
                                                                        )

  select :: forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[(a, b, c, d, e, f)]
-> (a, b, c, d, e, f) -> SBV b -> (a, b, c, d, e, f)
select [(a, b, c, d, e, f)]
xs (a
err1, b
err2, c
err3, d
err4, e
err5, f
err6) SBV b
ind = ( [a] -> a -> SBV b -> a
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                                       , [b] -> b -> SBV b -> b
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                                       , [c] -> c -> SBV b -> c
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
                                                       , [d] -> d -> SBV b -> d
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[d] -> d -> SBV b -> d
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
                                                       , [e] -> e -> SBV b -> e
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[e] -> e -> SBV b -> e
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [e]
es e
err5 SBV b
ind
                                                       , [f] -> f -> SBV b -> f
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[f] -> f -> SBV b -> f
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [f]
fs f
err6 SBV b
ind
                                                       )
    where ([a]
as, [b]
bs, [c]
cs, [d]
ds, [e]
es, [f]
fs) = [(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])
forall a b c d e f.
[(a, b, c, d, e, f)] -> ([a], [b], [c], [d], [e], [f])
unzip6 [(a, b, c, d, e, f)]
xs

-- 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) = ( Bool -> SBool -> a -> a -> a
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t a
i0 a
j0
                                                                                , Bool -> SBool -> b -> b -> b
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t b
i1 b
j1
                                                                                , Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t c
i2 c
j2
                                                                                , Bool -> SBool -> d -> d -> d
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t d
i3 d
j3
                                                                                , Bool -> SBool -> e -> e -> e
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t e
i4 e
j4
                                                                                , Bool -> SBool -> f -> f -> f
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t f
i5 f
j5
                                                                                , Bool -> SBool -> g -> g -> g
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
f SBool
t g
i6 g
j6
                                                                                )

  select :: forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[(a, b, c, d, e, f, g)]
-> (a, b, c, d, e, f, g) -> SBV b -> (a, b, c, d, e, f, g)
select [(a, b, c, d, e, f, g)]
xs (a
err1, b
err2, c
err3, d
err4, e
err5, f
err6, g
err7) SBV b
ind = ( [a] -> a -> SBV b -> a
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [a]
as a
err1 SBV b
ind
                                                             , [b] -> b -> SBV b -> b
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[b] -> b -> SBV b -> b
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [b]
bs b
err2 SBV b
ind
                                                             , [c] -> c -> SBV b -> c
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[c] -> c -> SBV b -> c
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [c]
cs c
err3 SBV b
ind
                                                             , [d] -> d -> SBV b -> d
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[d] -> d -> SBV b -> d
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [d]
ds d
err4 SBV b
ind
                                                             , [e] -> e -> SBV b -> e
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[e] -> e -> SBV b -> e
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [e]
es e
err5 SBV b
ind
                                                             , [f] -> f -> SBV b -> f
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[f] -> f -> SBV b -> f
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [f]
fs f
err6 SBV b
ind
                                                             , [g] -> g -> SBV b -> g
forall b.
(Ord b, SymVal b, Num b, Num (SBV b)) =>
[g] -> g -> SBV b -> g
forall a b.
(Mergeable a, Ord b, SymVal b, Num b, Num (SBV b)) =>
[a] -> a -> SBV b -> a
select [g]
gs g
err7 SBV b
ind
                                                             )
    where ([a]
as, [b]
bs, [c]
cs, [d]
ds, [e]
es, [f]
fs, [g]
gs) = [(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])
forall a b c d e f g.
[(a, b, c, d, e, f, g)] -> ([a], [b], [c], [d], [e], [f], [g])
unzip7 [(a, b, c, d, e, f, g)]
xs

-- Base types are mergeable so long as they are equal
instance Mergeable ()      where symbolicMerge :: Bool -> SBool -> () -> () -> ()
symbolicMerge Bool
_ SBool
_ = String -> String -> (() -> () -> Bool) -> () -> () -> ()
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"()"      String
"()"        () -> () -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Integer where symbolicMerge :: Bool -> SBool -> Integer -> Integer -> Integer
symbolicMerge Bool
_ SBool
_ = String
-> String
-> (Integer -> Integer -> Bool)
-> Integer
-> Integer
-> Integer
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Integer" String
"SInteger"  Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Bool    where symbolicMerge :: Bool -> SBool -> Bool -> Bool -> Bool
symbolicMerge Bool
_ SBool
_ = String -> String -> (Bool -> Bool -> Bool) -> Bool -> Bool -> Bool
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Bool"    String
"SBool"     Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Char    where symbolicMerge :: Bool -> SBool -> Char -> Char -> Char
symbolicMerge Bool
_ SBool
_ = String -> String -> (Char -> Char -> Bool) -> Char -> Char -> Char
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Char"    String
"SChar"     Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Float   where symbolicMerge :: Bool -> SBool -> Float -> Float -> Float
symbolicMerge Bool
_ SBool
_ = String
-> String -> (Float -> Float -> Bool) -> Float -> Float -> Float
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Float"   String
"SFloat"    Float -> Float -> Bool
forall a. RealFloat a => a -> a -> Bool
fpIsEqualObjectH
instance Mergeable Double  where symbolicMerge :: Bool -> SBool -> Double -> Double -> Double
symbolicMerge Bool
_ SBool
_ = String
-> String
-> (Double -> Double -> Bool)
-> Double
-> Double
-> Double
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Double"  String
"SDouble"   Double -> Double -> Bool
forall a. RealFloat a => a -> a -> Bool
fpIsEqualObjectH
instance Mergeable Word8   where symbolicMerge :: Bool -> SBool -> Word8 -> Word8 -> Word8
symbolicMerge Bool
_ SBool
_ = String
-> String -> (Word8 -> Word8 -> Bool) -> Word8 -> Word8 -> Word8
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Word8"   String
"SWord8"    Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Word16  where symbolicMerge :: Bool -> SBool -> Word16 -> Word16 -> Word16
symbolicMerge Bool
_ SBool
_ = String
-> String
-> (Word16 -> Word16 -> Bool)
-> Word16
-> Word16
-> Word16
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Word16"  String
"SWord16"   Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Word32  where symbolicMerge :: Bool -> SBool -> Word32 -> Word32 -> Word32
symbolicMerge Bool
_ SBool
_ = String
-> String
-> (Word32 -> Word32 -> Bool)
-> Word32
-> Word32
-> Word32
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Word32"  String
"SWord32"   Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Word64  where symbolicMerge :: Bool -> SBool -> Word64 -> Word64 -> Word64
symbolicMerge Bool
_ SBool
_ = String
-> String
-> (Word64 -> Word64 -> Bool)
-> Word64
-> Word64
-> Word64
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Word64"  String
"SWord64"   Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Int8    where symbolicMerge :: Bool -> SBool -> Int8 -> Int8 -> Int8
symbolicMerge Bool
_ SBool
_ = String -> String -> (Int8 -> Int8 -> Bool) -> Int8 -> Int8 -> Int8
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Int8"    String
"SInt8"     Int8 -> Int8 -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Int16   where symbolicMerge :: Bool -> SBool -> Int16 -> Int16 -> Int16
symbolicMerge Bool
_ SBool
_ = String
-> String -> (Int16 -> Int16 -> Bool) -> Int16 -> Int16 -> Int16
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Int16"   String
"SInt16"    Int16 -> Int16 -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Int32   where symbolicMerge :: Bool -> SBool -> Int32 -> Int32 -> Int32
symbolicMerge Bool
_ SBool
_ = String
-> String -> (Int32 -> Int32 -> Bool) -> Int32 -> Int32 -> Int32
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Int32"   String
"SInt32"    Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance Mergeable Int64   where symbolicMerge :: Bool -> SBool -> Int64 -> Int64 -> Int64
symbolicMerge Bool
_ SBool
_ = String
-> String -> (Int64 -> Int64 -> Bool) -> Int64 -> Int64 -> Int64
forall a.
Show a =>
String -> String -> (a -> a -> Bool) -> a -> a -> a
concreteMerge String
"Int64"   String
"SInt64"    Int64 -> Int64 -> Bool
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 = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
G.to (Rep a Any -> a) -> Rep a Any -> a
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> Rep a Any -> Rep a Any -> Rep a Any
forall a. Bool -> SBool -> Rep a a -> Rep a a -> Rep a a
forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
G.from a
x) (a -> Rep a Any
forall x. a -> Rep 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

{-
 - N.B. A V1 instance like the below would be wrong!
 - Why? Because inSBV, we use empty data to mean "uninterpreted" sort; not
 - something that has no constructors. Perhaps that was a bad design
 - decision. So, do not allow merging of such values!
instance GMergeable V1 where
  symbolicMerge' _ _ x _ = x
-}

instance GMergeable U1 where
  symbolicMerge' :: forall a. Bool -> SBool -> U1 a -> U1 a -> U1 a
symbolicMerge' Bool
_ SBool
_ U1 a
_ U1 a
_ = U1 a
forall k (p :: k). U1 p
U1

instance (Mergeable c) => GMergeable (K1 i c) where
  symbolicMerge' :: forall a. Bool -> SBool -> K1 i c a -> K1 i c a -> K1 i c a
symbolicMerge' Bool
force SBool
t (K1 c
x) (K1 c
y) = c -> K1 i c a
forall k i c (p :: k). c -> K1 i c p
K1 (c -> K1 i c a) -> c -> K1 i c a
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> c -> c -> c
forall a. Mergeable a => Bool -> SBool -> a -> a -> a
symbolicMerge Bool
force SBool
t c
x c
y

instance (GMergeable f) => GMergeable (M1 i c f) where
  symbolicMerge' :: forall a. Bool -> SBool -> M1 i c f a -> M1 i c f a -> M1 i c f a
symbolicMerge' Bool
force SBool
t (M1 f a
x) (M1 f a
y) = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i c f a) -> f a -> M1 i c f a
forall a b. (a -> b) -> a -> b
$ Bool -> SBool -> f a -> f a -> f a
forall a. Bool -> SBool -> f a -> f a -> f a
forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t f a
x f a
y

instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where
  symbolicMerge' :: forall a.
Bool -> SBool -> (:*:) f g a -> (:*:) f g a -> (:*:) f g a
symbolicMerge' Bool
force SBool
t (f a
x1 :*: g a
y1) (f a
x2 :*: g a
y2) = Bool -> SBool -> f a -> f a -> f a
forall a. Bool -> SBool -> f a -> f a -> f a
forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t f a
x1 f a
x2 f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: Bool -> SBool -> g a -> g a -> g a
forall a. Bool -> SBool -> g a -> g a -> g a
forall (f :: * -> *) a.
GMergeable f =>
Bool -> SBool -> f a -> f a -> f a
symbolicMerge' Bool
force SBool
t g a
y1 g a
y2

{- A mergeable instance for sum-types isn't possible. Why? It would something like:

instance (GMergeable f, GMergeable g) => GMergeable (f :+: g) where
  symbolicMerge' force t (L1 x) (L1 y) = L1 $ symbolicMerge' force t x y
  symbolicMerge' force t (R1 x) (R1 y) = R1 $ symbolicMerge' force t x y
  symbolicMerge' force t l r
    | Just tv <- unliteral t = if tv then l else r
    | True                   = ????

There's really no good code to put in ????. We have no way to ask the SMT solver to merge composite values that
have different constructors. Calling "error" here would pass the type-checker, but that simply postpones the problem
to run-time. If you need mergeable on sum-types, you better write one yourself, possibly using the SEither type yourself.
As we have it, you'll get a type-error; which can be hard to read, but is preferable.

NB. This isn't a problem with the generic version of symbolic equality; since we can simply return sFalse if we
see different constructors. Such isn't the case when merging.
-}

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

-- Haskell and SMTLib differ in their default char ranges. In Haskell, maxbound is a lot larger.
-- But in SMTLib, we only go upto 0x2FFFF. So, we adopt the SMTLib variant here. This is hardly
-- an issue in practice, but the discrepancy is disconcerting.
instance {-# OVERLAPPING #-} Bounded SChar where
  minBound :: SBV Char
minBound = Char -> SBV Char
forall a. SymVal a => a -> SBV a
literal (Int -> Char
chr Int
0)
  maxBound :: SBV Char
maxBound = Char -> SBV Char
forall a. SymVal a => a -> SBV a
literal (Int -> Char
chr Int
0x2FFFF)

-- | Choose a value that satisfies the given predicate. This is Hillbert's choice, essentially. Note that
-- if the predicate given is not satisfiable (for instance @const sFalse@), then the element returned will be arbitrary.
-- The only guarantee is that if there's at least one element that satisfies the predicate, then the returned
-- element will be one of those that do. The returned element is not guaranteed to be unique, least, greatest etc, unless
-- there happens to be exactly one satisfying element.
some :: forall a. (SymVal a, HasKind a) => String -> (SBV a -> SBool) -> SBV a
some :: forall a.
(SymVal a, HasKind a) =>
String -> (SBV a -> SBool) -> SBV a
some String
inpName SBV a -> SBool
cond = (State -> IO SV) -> SBV a
mk State -> IO SV
f
  where mk :: (State -> IO SV) -> SBV a
mk = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a)
-> ((State -> IO SV) -> SVal) -> (State -> IO SV) -> SBV a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> ((State -> IO SV) -> Either CV (Cached SV))
-> (State -> IO SV)
-> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> ((State -> IO SV) -> Cached SV)
-> (State -> IO SV)
-> Either CV (Cached SV)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache

        k :: Kind
k = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)


        f :: State -> IO SV
f State
st = do Int
ctr <- State -> IO Int
incrementFreshNameCounter State
st
                  let pre :: String
pre = Proxy a -> String -> String
forall a. Typeable a => Proxy a -> String -> String
atProxy (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) String
inpName
                      nm :: String
nm  | Int
ctr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = String
pre
                          | Bool
True     = String
pre String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ctr
                  String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st (String -> UIName
UIGiven String
nm) Maybe [String]
forall a. Maybe a
Nothing ([Kind] -> SBVType
SBVType [Kind
k]) (Bool -> UICodeKind
UINone Bool
False)
                  SV
chosen <- State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') []
                  let ifExists :: SBool
ifExists  = (Exists Any a -> SBool) -> SBool
forall a. QuantifiedBool a => a -> SBool
quantifiedBool ((Exists Any a -> SBool) -> SBool)
-> (Exists Any a -> SBool) -> SBool
forall a b. (a -> b) -> a -> b
$ \(Exists SBV a
ex) -> SBV a -> SBool
cond SBV a
ex
                  State -> Bool -> [(String, String)] -> SVal -> IO ()
internalConstraint State
st Bool
False [] (SBool -> SVal
forall a. SBV a -> SVal
unSBV (SBool
ifExists SBool -> SBool -> SBool
.=> SBV a -> SBool
cond ((State -> IO SV) -> SBV a
mk (IO SV -> State -> IO SV
forall a. a -> State -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SV -> IO SV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SV
chosen)))))
                  SV -> IO SV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SV
chosen

-- | SMT definable constants and functions, which can also be uninterpeted.
-- This class captures functions that we can generate standalone-code for
-- in the SMT solver. Note that we also allow uninterpreted constants and
-- functions too. 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: 'sbvDefineValue'. However, most instances in
-- practice are already provided by SBV, so end-users should not need to define their
-- own instances.
class SMTDefinable a where
  -- | Generate the code for this value as an SMTLib function, instead of
  -- the usual unrolling semantics. This is useful for generating sub-functions
  -- in generated SMTLib problem, or handling recursive (and mutually-recursive)
  -- definitions that wouldn't terminate in an unrolling symbolic simulation context.
  --
  -- __IMPORTANT NOTE__ The string argument names this function. Note that SBV will identify
  -- this function with that name, i.e., if you use this function twice (or use it recursively),
  -- it will simply assume this name uniquely identifies the function being defined. Hence,
  -- the user has to assure that this string is unique amongst all the functions you use.
  -- Furthermore, if the call to 'smtFunction' happens in the scope of a parameter, you
  -- must make sure the string is chosen to keep it unique per parameter value. For instance,
  -- if you have:
  --
  -- @
  --   bar :: SInteger -> SInteger -> SInteger
  --   bar k = smtFunction "bar" (\x -> x+k)   -- Note the capture of k!
  -- @
  --
  -- and you call @bar 2@ and @bar 3@, you *will* get the same SMTLib function. Obviously
  -- this is unsound. The reason is that the parameter value isn't captured by the name. In general,
  -- you should simply not do this, but if you must, have a concrete argument to make sure you can
  -- create a unique name. Something like:
  --
  -- @
  --   bar :: String -> SInteger -> SInteger -> SInteger
  --   bar tag k = smtFunction ("bar_" ++ tag) (\x -> x+k)   -- Tag should make the name unique!
  -- @
  --
  -- Then, make sure you use @bar "two" 2@ and @bar "three" 3@ etc. to preserve the invariant.
  --
  -- Furthermore, the function argument must not capture any non-constant variables in the context.
  -- You can also define higher-order functions, see 'smtHOFunction' for that purpose.
  --
  -- Note that this is a design choice, to keep function creation as easy to use as possible. SBV
  -- could've made 'smtFunction' a monadic call and generated the name itself to avoid all these issues.
  -- But the ergonomics of that is worse, and doesn't fit with the general design philosophy. If you
  -- can think of a solution (perhaps using some nifty GHC tricks?) to avoid this issue without making
  -- 'smtFunction' return a monadic result, please get in touch!
  smtFunction :: (Typeable a, Lambda Symbolic a) => String -> a -> a

  -- | Register a function. This function is typically not needed as SBV will register functions used
  -- automatically upon first use. However, there are scenarios (in particular query contexts)
  -- where the definition isn't used before query-mode starts, and SBV (for historical reasons)
  -- requires functions to be known before query-mode starts executing. In such cases, use this function
  -- to register them with the system.
  registerFunction :: a -> Symbolic ()

  -- | Uninterpret a value, i.e., add this value as a completely undefined value/function that
  -- the solver is free to instantiate to satisfy other constraints.
  --
  -- __Known issues__
  --
  -- Usually using an uninterpret function will register itself to the solver, but sometimes the lazyness
  -- of the evaluation might render this unreliable.
  --
  -- For example, when working with quantifiers and uninterpreted functions with the following code:
  --
  -- > runSMTWith z3 $ do
  -- >   let f = uninterpret "f" :: SInteger -> SInteger
  -- >   query $ do
  -- >     constrain $ \(Forall (b :: SInteger)) -> f b .== f b
  -- >     checkSat
  --
  -- The solver will complain about the unknown constant @f (Int)@.
  --
  -- A workaround of this is to explicit register them with 'Data.SBV.Control.registerUISMTFunction':
  --
  -- > runSMTWith z3 $ do
  -- >   let f = uninterpret "f" :: SInteger -> SInteger
  -- >   registerUISMTFunction f
  -- >   query $ do
  -- >     constrain $ \(Forall (b :: SInteger)) -> f b .== f b
  -- >     checkSat
  --
  -- See https://github.com/LeventErkok/sbv/issues/711 for more info.
  uninterpret :: String -> a

  -- | Uninterpret a value, with named arguments in case of functions. SBV will use these
  -- names when it shows the values for the arguments. If the given names are more than needed
  -- we ignore the excess. If not enough, we add from a stock set of variables.
  uninterpretWithArgs :: String -> [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.
  sbvDefineValue :: UIName -> Maybe [String] -> UIKind a -> 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

  -- | Render an uninterpeted value as an SMTLib definition
  sbv2smt :: ExtractIO m => a -> m String

  {-# MINIMAL sbvDefineValue, sbv2smt #-}

  -- defaults:
  uninterpret         String
nm         = UIName -> Maybe [String] -> UIKind a -> a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue (String -> UIName
UIGiven String
nm) Maybe [String]
forall a. Maybe a
Nothing   (UIKind a -> a) -> UIKind a -> a
forall a b. (a -> b) -> a -> b
$ Bool -> UIKind a
forall a. Bool -> UIKind a
UIFree Bool
True
  uninterpretWithArgs String
nm  [String]
as     = UIName -> Maybe [String] -> UIKind a -> a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue (String -> UIName
UIGiven String
nm) ([String] -> Maybe [String]
forall a. a -> Maybe a
Just [String]
as) (UIKind a -> a) -> UIKind a -> a
forall a b. (a -> b) -> a -> b
$ Bool -> UIKind a
forall a. Bool -> UIKind a
UIFree Bool
True
  cgUninterpret       String
nm  [String]
code a
v = UIName -> Maybe [String] -> UIKind a -> a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue (String -> UIName
UIGiven String
nm) Maybe [String]
forall a. Maybe a
Nothing   (UIKind a -> a) -> UIKind a -> a
forall a b. (a -> b) -> a -> b
$ (a, [String]) -> UIKind a
forall a. (a, [String]) -> UIKind a
UICodeC (a
v, [String]
code)
  sym                            = String -> a
forall a. SMTDefinable a => String -> a
uninterpret

  smtFunction String
nm a
v = UIName -> Maybe [String] -> UIKind a -> a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue (String -> UIName
UIGiven (Proxy a -> String -> String
forall a. Typeable a => Proxy a -> String -> String
atProxy (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) String
nm)) Maybe [String]
forall a. Maybe a
Nothing (UIKind a -> a) -> UIKind a -> a
forall a b. (a -> b) -> a -> b
$ (a, State -> Kind -> IO SMTDef) -> UIKind a
forall a. (a, State -> Kind -> IO SMTDef) -> UIKind a
UIFun (a
v, \State
st Kind
fk -> State -> LambdaScope -> Kind -> a -> IO SMTDef
forall (m :: * -> *) a.
(MonadIO m, Lambda (SymbolicT m) a) =>
State -> LambdaScope -> Kind -> a -> m SMTDef
lambda State
st LambdaScope
TopLevel Kind
fk a
v)

  default registerFunction :: forall b c. (a ~ (SBV b -> c), SymVal b, SMTDefinable c) => a -> Symbolic ()
  registerFunction a
f = do let k :: Kind
k = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                          State
st <- SymbolicT IO State
forall (m :: * -> *). MonadSymbolic m => m State
symbolicEnv
                          SV
v <- IO SV -> SymbolicT IO SV
forall a. IO a -> SymbolicT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SV -> SymbolicT IO SV) -> IO SV -> SymbolicT IO SV
forall a b. (a -> b) -> a -> b
$ State -> Kind -> IO SV
newInternalVariable State
st Kind
k
                          let b :: SBV b
b = SVal -> SBV b
forall a. SVal -> SBV a
SBV (SVal -> SBV b) -> SVal -> SBV b
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache (IO SV -> State -> IO SV
forall a b. a -> b -> a
const (SV -> IO SV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SV
v))
                          c -> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction (c -> Symbolic ()) -> c -> Symbolic ()
forall a b. (a -> b) -> a -> b
$ a
SBV b -> c
f SBV b
b


-- | Kind of uninterpretation
data UIKind a = UIFree  Bool                            -- ^ completely uninterpreted. If Bool is true, then this is curried.
              | UIFun   (a, State -> Kind -> IO SMTDef) -- ^ has code for SMTLib, with final type of kind (note this is the result
                                                        -- , not the arguments), which can be generated by calling the function on the state.
              | UICodeC (a, [String])                   -- ^ has code for code-generation, i.e., C
              deriving (forall a b. (a -> b) -> UIKind a -> UIKind b)
-> (forall a b. a -> UIKind b -> UIKind a) -> Functor UIKind
forall a b. a -> UIKind b -> UIKind a
forall a b. (a -> b) -> UIKind a -> UIKind b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> UIKind a -> UIKind b
fmap :: forall a b. (a -> b) -> UIKind a -> UIKind b
$c<$ :: forall a b. a -> UIKind b -> UIKind a
<$ :: forall a b. a -> UIKind b -> UIKind a
Functor

-- Get the code associated with the UI, unless we've already did this once. (To support recursive defs.)
retrieveUICode :: UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode :: forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
_             State
_  Kind
_  (UIFree  Bool
c)      = UICodeKind -> IO UICodeKind
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UICodeKind -> IO UICodeKind) -> UICodeKind -> IO UICodeKind
forall a b. (a -> b) -> a -> b
$ Bool -> UICodeKind
UINone Bool
c
retrieveUICode (UIGiven  String
nm) State
st Kind
fk (UIFun   (a
_, State -> Kind -> IO SMTDef
f)) = do Set String
userFuncs <- IORef (Set String) -> IO (Set String)
forall a. IORef a -> IO a
readIORef (State -> IORef (Set String)
rUserFuncs State
st)
                                                         if String
nm String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set String
userFuncs
                                                            then UICodeKind -> IO UICodeKind
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UICodeKind -> IO UICodeKind) -> UICodeKind -> IO UICodeKind
forall a b. (a -> b) -> a -> b
$ Bool -> UICodeKind
UINone Bool
True
                                                            else do State
-> (State -> IORef (Set String))
-> (Set String -> Set String)
-> IO ()
-> IO ()
forall a. State -> (State -> IORef a) -> (a -> a) -> IO () -> IO ()
modifyState State
st State -> IORef (Set String)
rUserFuncs (String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert String
nm) (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
                                                                    SMTDef -> UICodeKind
UISMT (SMTDef -> UICodeKind) -> IO SMTDef -> IO UICodeKind
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> State -> Kind -> IO SMTDef
f State
st Kind
fk
retrieveUICode UIName
_             State
_  Kind
_  (UICodeC (a
_, [String]
c)) = UICodeKind -> IO UICodeKind
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UICodeKind -> IO UICodeKind) -> UICodeKind -> IO UICodeKind
forall a b. (a -> b) -> a -> b
$ [String] -> UICodeKind
UICgC [String]
c

-- Get the constant value associated with the UI
retrieveConstCode :: UIKind a -> Maybe a
retrieveConstCode :: forall a. UIKind a -> Maybe a
retrieveConstCode UIFree{}         = Maybe a
forall a. Maybe a
Nothing
retrieveConstCode (UIFun   (a
v, State -> Kind -> IO SMTDef
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
v
retrieveConstCode (UICodeC (a
v, [String]
_)) = a -> Maybe a
forall a. a -> Maybe a
Just a
v

-- Plain constants
instance (SymVal a, HasKind a) => SMTDefinable (SBV a) where
  sbv2smt :: forall (m :: * -> *). ExtractIO m => SBV a -> m String
sbv2smt SBV a
a = do State
st <- SMTConfig -> SBVRunMode -> m State
forall (m :: * -> *).
MonadIO m =>
SMTConfig -> SBVRunMode -> m State
mkNewState SMTConfig
defaultSMTCfg (Maybe Int -> SBVRunMode
LambdaGen (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0))
                 SMTLambda
s <- State -> LambdaScope -> Kind -> SBV a -> m SMTLambda
forall (m :: * -> *) a.
(MonadIO m, Lambda (SymbolicT m) a) =>
State -> LambdaScope -> Kind -> a -> m SMTLambda
lambdaStr State
st LambdaScope
TopLevel (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
a) SBV a
a
                 String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [ String
"; Automatically generated by SBV. Do not modify!"
                                         , String
"; Type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Kind -> String
smtType (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
a)
                                         , SMTLambda -> String
forall a. Show a => a -> String
show SMTLambda
s
                                         ]

  registerFunction :: SBV a -> Symbolic ()
registerFunction SBV a
x = SBool -> Symbolic ()
forall a. QuantifiedBool a => a -> Symbolic ()
forall (m :: * -> *) a.
(SolverContext m, QuantifiedBool a) =>
a -> m ()
constrain (SBool -> Symbolic ()) -> SBool -> Symbolic ()
forall a b. (a -> b) -> a -> b
$ SBV a
x SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a
x

  sbvDefineValue :: UIName -> Maybe [String] -> UIKind (SBV a) -> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind (SBV a)
uiKind
     | Just SBV a
v <- UIKind (SBV a) -> Maybe (SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind (SBV a)
uiKind
     = SBV a
v
     | Bool
True
     = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
    where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
          result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                         case (Bool
isSMT, UIKind (SBV a)
uiKind) of
                           (Bool
True, UICodeC (SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
v
                           (Bool, UIKind (SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName -> State -> Kind -> UIKind (SBV a) -> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind (SBV a)
uiKind
                                                        State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') []

-- Functions of one argument
instance (SymVal b, SymVal a, HasKind a) => SMTDefinable (SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *). ExtractIO m => (SBV b -> SBV a) -> m String
sbv2smt SBV b -> SBV a
fn = (SBV b -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV b -> SBool) -> m String) -> (SBV b -> SBool) -> m String
forall a b. (a -> b) -> a -> b
$ \SBV b
b -> SBV b -> SBV a
fn SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV b -> SBV a
fn SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String] -> UIKind (SBV b -> SBV a) -> SBV b -> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind (SBV b -> SBV a)
uiKind = SBV b -> SBV a
f
    where f :: SBV b -> SBV a
f SBV b
arg0
           | Just SBV b -> SBV a
v <- UIKind (SBV b -> SBV a) -> Maybe (SBV b -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind (SBV b -> SBV a)
uiKind, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg0
           = SBV b -> SBV a
v SBV b
arg0
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind (SBV b -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV b -> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV b -> SBV a
v SBV b
arg0)
                                  (Bool, UIKind (SBV b -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName -> State -> Kind -> UIKind (SBV b -> SBV a) -> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind (SBV b -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg0
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0]

-- Functions of two arguments
instance (SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable (SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV c -> SBV b -> SBV a) -> m String
sbv2smt SBV c -> SBV b -> SBV a
fn = (SBV c -> SBV b -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV c -> SBV b -> SBool) -> m String)
-> (SBV c -> SBV b -> SBool) -> m String
forall a b. (a -> b) -> a -> b
$ \SBV c
c SBV b
b -> SBV c -> SBV b -> SBV a
fn SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV c -> SBV b -> SBV a
fn SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind (SBV c -> SBV b -> SBV a)
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind (SBV c -> SBV b -> SBV a)
uiKind = SBV c -> SBV b -> SBV a
f
    where f :: SBV c -> SBV b -> SBV a
f SBV c
arg0 SBV b
arg1
           | Just SBV c -> SBV b -> SBV a
v <- UIKind (SBV c -> SBV b -> SBV a) -> Maybe (SBV c -> SBV b -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind (SBV c -> SBV b -> SBV a)
uiKind, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg0, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg1
           = SBV c -> SBV b -> SBV a
v SBV c
arg0 SBV b
arg1
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind (SBV c -> SBV b -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV c -> SBV b -> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV c -> SBV b -> SBV a
v SBV c
arg0 SBV b
arg1)
                                  (Bool, UIKind (SBV c -> SBV b -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind (SBV c -> SBV b -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind (SBV c -> SBV b -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg0
                                                               SV
sw1 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg1
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0, SV
sw1]

-- Functions of three arguments
instance (SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable (SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV d -> SBV c -> SBV b -> SBV a) -> m String
sbv2smt SBV d -> SBV c -> SBV b -> SBV a
fn = (SBV d -> SBV c -> SBV b -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV d -> SBV c -> SBV b -> SBool) -> m String)
-> (SBV d -> SBV c -> SBV b -> SBool) -> m String
forall a b. (a -> b) -> a -> b
$ \SBV d
d SBV c
c SBV b
b -> SBV d -> SBV c -> SBV b -> SBV a
fn SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV d -> SBV c -> SBV b -> SBV a
fn SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind (SBV d -> SBV c -> SBV b -> SBV a)
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind (SBV d -> SBV c -> SBV b -> SBV a)
uiKind = 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 SBV d -> SBV c -> SBV b -> SBV a
v <- UIKind (SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe (SBV d -> SBV c -> SBV b -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind (SBV d -> SBV c -> SBV b -> SBV a)
uiKind, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg0, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg1, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg2
           = SBV d -> SBV c -> SBV b -> SBV a
v SBV d
arg0 SBV c
arg1 SBV b
arg2
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind (SBV d -> SBV c -> SBV b -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV d -> SBV c -> SBV b -> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV d -> SBV c -> SBV b -> SBV a
v SBV d
arg0 SBV c
arg1 SBV b
arg2)
                                  (Bool, UIKind (SBV d -> SBV c -> SBV b -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind (SBV d -> SBV c -> SBV b -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind (SBV d -> SBV c -> SBV b -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg0
                                                               SV
sw1 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg1
                                                               SV
sw2 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg2
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0, SV
sw1, SV
sw2]

-- Functions of four arguments
instance (SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable (SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV e -> SBV d -> SBV c -> SBV b -> SBV a) -> m String
sbv2smt SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn = (SBV e -> SBV d -> SBV c -> SBV b -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV e -> SBV d -> SBV c -> SBV b -> SBool) -> m String)
-> (SBV e -> SBV d -> SBV c -> SBV b -> SBool) -> m String
forall a b. (a -> b) -> a -> b
$ \SBV e
e SBV d
d SBV c
c SBV b
b -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn SBV e
e SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn SBV e
e SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind = 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 SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v <- UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg0, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg1, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg2, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg3
           = SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV e
arg0 SBV d
arg1 SBV c
arg2 SBV b
arg3
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV e
arg0 SBV d
arg1 SBV c
arg2 SBV b
arg3)
                                  (Bool, UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg0
                                                               SV
sw1 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg1
                                                               SV
sw2 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg2
                                                               SV
sw3 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg3
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0, SV
sw1, SV
sw2, SV
sw3]

-- Functions of five arguments
instance (SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) -> m String
sbv2smt SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn = (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBool) -> m String)
-> (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBool) -> m String
forall a b. (a -> b) -> a -> b
$ \SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind = 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 SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v <- UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg0, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg1, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg2, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg3, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg4
           = SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV f
arg0 SBV e
arg1 SBV d
arg2 SBV c
arg3 SBV b
arg4
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV f
arg0 SBV e
arg1 SBV d
arg2 SBV c
arg3 SBV b
arg4)
                                  (Bool, UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg0
                                                               SV
sw1 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg1
                                                               SV
sw2 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg2
                                                               SV
sw3 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg3
                                                               SV
sw4 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg4
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
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, SymVal a, HasKind a) => SMTDefinable (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> m String
sbv2smt SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn = (SBV f -> SBV g -> SBV e -> SBV d -> SBV c -> SBV b -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV f -> SBV g -> SBV e -> SBV d -> SBV c -> SBV b -> SBool)
 -> m String)
-> (SBV f -> SBV g -> SBV e -> SBV d -> SBV c -> SBV b -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \SBV f
f SBV g
g SBV e
e SBV d
d SBV c
c SBV b
b -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind = 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 SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v <- UIKind
  (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe
     (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind
  (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind, SBV g -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg0, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg1, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg2, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg3, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg4, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg5
           = SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV g
arg0 SBV f
arg1 SBV e
arg2 SBV d
arg3 SBV c
arg4 SBV b
arg5
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
                 kg :: Kind
kg = Proxy g -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind
  (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV g
arg0 SBV f
arg1 SBV e
arg2 SBV d
arg3 SBV c
arg4 SBV b
arg5)
                                  (Bool,
 UIKind
   (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
kg, Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind
     (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind
  (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV g -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg0
                                                               SV
sw1 <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg1
                                                               SV
sw2 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg2
                                                               SV
sw3 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg3
                                                               SV
sw4 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg4
                                                               SV
sw5 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg5
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
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, SymVal a, HasKind a)
            => SMTDefinable (SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV h
 -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> m String
sbv2smt SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn = (SBV h
 -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV h
  -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBool)
 -> m String)
-> (SBV h
    -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b -> SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
fn SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     (SBV h
      -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  (SBV h
   -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind = 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 SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v <- UIKind
  (SBV h
   -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Maybe
     (SBV h
      -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind
  (SBV h
   -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind, SBV h -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV h
arg0, SBV g -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg1, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg2, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg3, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg4, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg5, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg6
           = SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV h
arg0 SBV g
arg1 SBV f
arg2 SBV e
arg3 SBV d
arg4 SBV c
arg5 SBV b
arg6
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
                 kg :: Kind
kg = Proxy g -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g)
                 kh :: Kind
kh = Proxy h -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind
  (SBV h
   -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
v SBV h
arg0 SBV g
arg1 SBV f
arg2 SBV e
arg3 SBV d
arg4 SBV c
arg5 SBV b
arg6)
                                  (Bool,
 UIKind
   (SBV h
    -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
kh, Kind
kg, Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind
     (SBV h
      -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind
  (SBV h
   -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV h -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV h
arg0
                                                               SV
sw1 <- State -> SBV g -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg1
                                                               SV
sw2 <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg2
                                                               SV
sw3 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg3
                                                               SV
sw4 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg4
                                                               SV
sw5 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg5
                                                               SV
sw6 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg6
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6]

-- Functions of eight arguments
instance (SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, SymVal a, HasKind a)
            => SMTDefinable (SBV i -> SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> m String
sbv2smt SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn = (SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBool)
 -> m String)
-> (SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b -> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     (SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  (SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind = SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f
    where f :: SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f SBV i
arg0 SBV h
arg1 SBV g
arg2 SBV f
arg3 SBV e
arg4 SBV d
arg5 SBV c
arg6 SBV b
arg7
           | Just SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v <- UIKind
  (SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
-> Maybe
     (SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind
  (SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind, SBV i -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV i
arg0, SBV h -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV h
arg1, SBV g -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg2, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg3, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg4, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg5, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg6, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg7
           = SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV i
arg0 SBV h
arg1 SBV g
arg2 SBV f
arg3 SBV e
arg4 SBV d
arg5 SBV c
arg6 SBV b
arg7
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
                 kg :: Kind
kg = Proxy g -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g)
                 kh :: Kind
kh = Proxy h -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h)
                 ki :: Kind
ki = Proxy i -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind
  (SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV i
arg0 SBV h
arg1 SBV g
arg2 SBV f
arg3 SBV e
arg4 SBV d
arg5 SBV c
arg6 SBV b
arg7)
                                  (Bool,
 UIKind
   (SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
ki, Kind
kh, Kind
kg, Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind
     (SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind
  (SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV i -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV i
arg0
                                                               SV
sw1 <- State -> SBV h -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV h
arg1
                                                               SV
sw2 <- State -> SBV g -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg2
                                                               SV
sw3 <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg3
                                                               SV
sw4 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg4
                                                               SV
sw5 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg5
                                                               SV
sw6 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg6
                                                               SV
sw7 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg7
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7]

-- Functions of nine arguments
instance (SymVal j, SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a)
            => SMTDefinable (SBV j -> SBV i -> SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> m String
sbv2smt SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn = (SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV j
  -> SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBool)
 -> m String)
-> (SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b -> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     (SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  (SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind = SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f
    where f :: SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f SBV j
arg0 SBV i
arg1 SBV h
arg2 SBV g
arg3 SBV f
arg4 SBV e
arg5 SBV d
arg6 SBV c
arg7 SBV b
arg8
           | Just SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v <- UIKind
  (SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
-> Maybe
     (SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind
  (SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind, SBV j -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV j
arg0, SBV i -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV i
arg1, SBV h -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV h
arg2, SBV g -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg3, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg4, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg5, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg6, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg7, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg8
           = SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV j
arg0 SBV i
arg1 SBV h
arg2 SBV g
arg3 SBV f
arg4 SBV e
arg5 SBV d
arg6 SBV c
arg7 SBV b
arg8
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
                 kg :: Kind
kg = Proxy g -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g)
                 kh :: Kind
kh = Proxy h -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h)
                 ki :: Kind
ki = Proxy i -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
                 kj :: Kind
kj = Proxy j -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @j)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind
  (SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV j
arg0 SBV i
arg1 SBV h
arg2 SBV g
arg3 SBV f
arg4 SBV e
arg5 SBV d
arg6 SBV c
arg7 SBV b
arg8)
                                  (Bool,
 UIKind
   (SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
kj, Kind
ki, Kind
kh, Kind
kg, Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind
     (SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind
  (SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV j -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV j
arg0
                                                               SV
sw1 <- State -> SBV i -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV i
arg1
                                                               SV
sw2 <- State -> SBV h -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV h
arg2
                                                               SV
sw3 <- State -> SBV g -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg3
                                                               SV
sw4 <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg4
                                                               SV
sw5 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg5
                                                               SV
sw6 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg6
                                                               SV
sw7 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg7
                                                               SV
sw8 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg8
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7, SV
sw8]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7, SV
sw8]

-- Functions of ten arguments
instance (SymVal k, SymVal j, SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a)
            => SMTDefinable (SBV k -> SBV j -> SBV i -> SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> m String
sbv2smt SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn = (SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV k
  -> SBV j
  -> SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBool)
 -> m String)
-> (SBV k
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \SBV k
k SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b -> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV k
k SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV k
k SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     (SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  (SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind = SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f
    where f :: SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f SBV k
arg0 SBV j
arg1 SBV i
arg2 SBV h
arg3 SBV g
arg4 SBV f
arg5 SBV e
arg6 SBV d
arg7 SBV c
arg8 SBV b
arg9
           | Just SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v <- UIKind
  (SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
-> Maybe
     (SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind
  (SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind, SBV k -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV k
arg0, SBV j -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV j
arg1, SBV i -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV i
arg2, SBV h -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV h
arg3, SBV g -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg4, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg5, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg6, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg7, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg8, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg9
           = SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV k
arg0 SBV j
arg1 SBV i
arg2 SBV h
arg3 SBV g
arg4 SBV f
arg5 SBV e
arg6 SBV d
arg7 SBV c
arg8 SBV b
arg9
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
                 kg :: Kind
kg = Proxy g -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g)
                 kh :: Kind
kh = Proxy h -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h)
                 ki :: Kind
ki = Proxy i -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
                 kj :: Kind
kj = Proxy j -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @j)
                 kk :: Kind
kk = Proxy k -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @k)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind
  (SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV k
arg0 SBV j
arg1 SBV i
arg2 SBV h
arg3 SBV g
arg4 SBV f
arg5 SBV e
arg6 SBV d
arg7 SBV c
arg8 SBV b
arg9)
                                  (Bool,
 UIKind
   (SBV k
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
kk, Kind
kj, Kind
ki, Kind
kh, Kind
kg, Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind
     (SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind
  (SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind
                                                               SV
sw0 <- State -> SBV k -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV k
arg0
                                                               SV
sw1 <- State -> SBV j -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV j
arg1
                                                               SV
sw2 <- State -> SBV i -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV i
arg2
                                                               SV
sw3 <- State -> SBV h -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV h
arg3
                                                               SV
sw4 <- State -> SBV g -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg4
                                                               SV
sw5 <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg5
                                                               SV
sw6 <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg6
                                                               SV
sw7 <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg7
                                                               SV
sw8 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg8
                                                               SV
sw9 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg9
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7, SV
sw8, SV
sw9]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7, SV
sw8, SV
sw9]

-- Functions of eleven arguments
instance (SymVal l, SymVal k, SymVal j, SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a)
            => SMTDefinable (SBV l -> SBV k -> SBV j -> SBV i -> SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> m String
sbv2smt SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn = (SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV l
  -> SBV k
  -> SBV j
  -> SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBool)
 -> m String)
-> (SBV l
    -> SBV k
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \SBV l
l SBV k
k SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b -> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV l
l SBV k
k SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV l
l SBV k
k SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     (SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  (SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind = SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f
    where f :: SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f SBV l
arg0 SBV k
arg1 SBV j
arg2 SBV i
arg3 SBV h
arg4 SBV g
arg5 SBV f
arg6 SBV e
arg7 SBV d
arg8 SBV c
arg9 SBV b
arg10
           | Just SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v <- UIKind
  (SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
-> Maybe
     (SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind
  (SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind, SBV l -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV l
arg0, SBV k -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV k
arg1, SBV j -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV j
arg2, SBV i -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV i
arg3, SBV h -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV h
arg4, SBV g -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg5, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg6, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg7, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg8, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg9, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg10
           = SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV l
arg0 SBV k
arg1 SBV j
arg2 SBV i
arg3 SBV h
arg4 SBV g
arg5 SBV f
arg6 SBV e
arg7 SBV d
arg8 SBV c
arg9 SBV b
arg10
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
                 kg :: Kind
kg = Proxy g -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g)
                 kh :: Kind
kh = Proxy h -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h)
                 ki :: Kind
ki = Proxy i -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
                 kj :: Kind
kj = Proxy j -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @j)
                 kk :: Kind
kk = Proxy k -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @k)
                 kl :: Kind
kl = Proxy l -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @l)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind
  (SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV l
arg0 SBV k
arg1 SBV j
arg2 SBV i
arg3 SBV h
arg4 SBV g
arg5 SBV f
arg6 SBV e
arg7 SBV d
arg8 SBV c
arg9 SBV b
arg10)
                                  (Bool,
 UIKind
   (SBV l
    -> SBV k
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
kl, Kind
kk, Kind
kj, Kind
ki, Kind
kh, Kind
kg, Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind
     (SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind
  (SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind
                                                               SV
sw0  <- State -> SBV l -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV l
arg0
                                                               SV
sw1  <- State -> SBV k -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV k
arg1
                                                               SV
sw2  <- State -> SBV j -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV j
arg2
                                                               SV
sw3  <- State -> SBV i -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV i
arg3
                                                               SV
sw4  <- State -> SBV h -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV h
arg4
                                                               SV
sw5  <- State -> SBV g -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg5
                                                               SV
sw6  <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg6
                                                               SV
sw7  <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg7
                                                               SV
sw8  <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg8
                                                               SV
sw9  <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg9
                                                               SV
sw10 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg10
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7, SV
sw8, SV
sw9, SV
sw10]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7, SV
sw8, SV
sw9, SV
sw10]

-- Functions of twelve arguments
instance (SymVal m, SymVal l, SymVal k, SymVal j, SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a)
            => SMTDefinable (SBV m -> SBV l -> SBV k -> SBV j -> SBV i -> SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
(SBV m
 -> SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> m String
sbv2smt SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn = (SBV m
 -> SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt ((SBV m
  -> SBV l
  -> SBV k
  -> SBV j
  -> SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBool)
 -> m String)
-> (SBV m
    -> SBV l
    -> SBV k
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \SBV m
m SBV l
l SBV k
k SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b -> SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV m
m SBV l
l SBV k
k SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
fn SBV m
m SBV l
l SBV k
k SBV j
j SBV i
i SBV h
h SBV g
g SBV f
f SBV e
e SBV d
d SBV c
c SBV b
b

  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     (SBV m
      -> SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  (SBV m
   -> SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind = SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f
    where f :: SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f SBV m
arg0 SBV l
arg1 SBV k
arg2 SBV j
arg3 SBV i
arg4 SBV h
arg5 SBV g
arg6 SBV f
arg7 SBV e
arg8 SBV d
arg9 SBV c
arg10 SBV b
arg11
           | Just SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v <- UIKind
  (SBV m
   -> SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
-> Maybe
     (SBV m
      -> SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall a. UIKind a -> Maybe a
retrieveConstCode UIKind
  (SBV m
   -> SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind, SBV m -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV m
arg0, SBV l -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV l
arg1, SBV k -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV k
arg2, SBV j -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV j
arg3, SBV i -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV i
arg4, SBV h -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV h
arg5, SBV g -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV g
arg6, SBV f -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV f
arg7, SBV e -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV e
arg8, SBV d -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV d
arg9, SBV c -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV c
arg10, SBV b -> Bool
forall a. SymVal a => SBV a -> Bool
isConcrete SBV b
arg11
           = SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV m
arg0 SBV l
arg1 SBV k
arg2 SBV j
arg3 SBV i
arg4 SBV h
arg5 SBV g
arg6 SBV f
arg7 SBV e
arg8 SBV d
arg9 SBV c
arg10 SBV b
arg11
           | Bool
True
           = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
ka (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
result
           where ka :: Kind
ka = Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)
                 kb :: Kind
kb = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
                 kc :: Kind
kc = Proxy c -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @c)
                 kd :: Kind
kd = Proxy d -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d)
                 ke :: Kind
ke = Proxy e -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @e)
                 kf :: Kind
kf = Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f)
                 kg :: Kind
kg = Proxy g -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @g)
                 kh :: Kind
kh = Proxy h -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h)
                 ki :: Kind
ki = Proxy i -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @i)
                 kj :: Kind
kj = Proxy j -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @j)
                 kk :: Kind
kk = Proxy k -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @k)
                 kl :: Kind
kl = Proxy l -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @l)
                 km :: Kind
km = Proxy m -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
                 result :: State -> IO SV
result State
st = do Bool
isSMT <- State -> IO Bool
inSMTMode State
st
                                case (Bool
isSMT, UIKind
  (SBV m
   -> SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind) of
                                  (Bool
True, UICodeC (SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v, [String]
_)) -> State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
v SBV m
arg0 SBV l
arg1 SBV k
arg2 SBV j
arg3 SBV i
arg4 SBV h
arg5 SBV g
arg6 SBV f
arg7 SBV e
arg8 SBV d
arg9 SBV c
arg10 SBV b
arg11)
                                  (Bool,
 UIKind
   (SBV m
    -> SBV l
    -> SBV k
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a))
_                      -> do String
nm' <- State
-> UIName -> Maybe [String] -> SBVType -> UICodeKind -> IO String
newUninterpreted State
st UIName
nm Maybe [String]
mbArgs ([Kind] -> SBVType
SBVType [Kind
km, Kind
kl, Kind
kk, Kind
kj, Kind
ki, Kind
kh, Kind
kg, Kind
kf, Kind
ke, Kind
kd, Kind
kc, Kind
kb, Kind
ka]) (UICodeKind -> IO String) -> IO UICodeKind -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< UIName
-> State
-> Kind
-> UIKind
     (SBV m
      -> SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> IO UICodeKind
forall a. UIName -> State -> Kind -> UIKind a -> IO UICodeKind
retrieveUICode UIName
nm State
st Kind
ka UIKind
  (SBV m
   -> SBV l
   -> SBV k
   -> SBV j
   -> SBV i
   -> SBV h
   -> SBV g
   -> SBV f
   -> SBV e
   -> SBV d
   -> SBV c
   -> SBV b
   -> SBV a)
uiKind
                                                               SV
sw0  <- State -> SBV m -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV m
arg0
                                                               SV
sw1  <- State -> SBV l -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV l
arg1
                                                               SV
sw2  <- State -> SBV k -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV k
arg2
                                                               SV
sw3  <- State -> SBV j -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV j
arg3
                                                               SV
sw4  <- State -> SBV i -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV i
arg4
                                                               SV
sw5  <- State -> SBV h -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV h
arg5
                                                               SV
sw6  <- State -> SBV g -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV g
arg6
                                                               SV
sw7  <- State -> SBV f -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV f
arg7
                                                               SV
sw8  <- State -> SBV e -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV e
arg8
                                                               SV
sw9  <- State -> SBV d -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV d
arg9
                                                               SV
sw10 <- State -> SBV c -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV c
arg10
                                                               SV
sw11 <- State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
arg11
                                                               (SV -> IO ()) -> [SV] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SV -> IO ()
forceSVArg [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7, SV
sw8, SV
sw9, SV
sw10, SV
sw11]
                                                               State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
ka (SBVExpr -> IO SV) -> SBVExpr -> IO SV
forall a b. (a -> b) -> a -> b
$ Op -> [SV] -> SBVExpr
SBVApp (String -> Op
Uninterpreted String
nm') [SV
sw0, SV
sw1, SV
sw2, SV
sw3, SV
sw4, SV
sw5, SV
sw6, SV
sw7, SV
sw8, SV
sw9, SV
sw10, SV
sw11]

-- Mark the UIKind as uncurried
mkUncurried :: UIKind a -> UIKind a
mkUncurried :: forall a. UIKind a -> UIKind a
mkUncurried (UIFree  Bool
_) = Bool -> UIKind a
forall a. Bool -> UIKind a
UIFree  Bool
False
mkUncurried (UIFun   (a, State -> Kind -> IO SMTDef)
a) = (a, State -> Kind -> IO SMTDef) -> UIKind a
forall a. (a, State -> Kind -> IO SMTDef) -> UIKind a
UIFun   (a, State -> Kind -> IO SMTDef)
a
mkUncurried (UICodeC (a, [String])
a) = (a, [String]) -> UIKind a
forall a. (a, [String]) -> UIKind a
UICodeC (a, [String])
a

-- Uncurried functions of two arguments
instance (SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV c, SBV b) -> SBV a) -> m String
sbv2smt (SBV c, SBV b) -> SBV a
fn                      = ((SBV c, SBV b) -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV c, SBV b) -> SBool) -> m String)
-> ((SBV c, SBV b) -> SBool) -> m String
forall a b. (a -> b) -> a -> b
$ \(SBV c, SBV b)
p -> (SBV c, SBV b) -> SBV a
fn (SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV c, SBV b) -> SBV a
fn (SBV c, SBV b)
p
  registerFunction :: ((SBV c, SBV b) -> SBV a) -> Symbolic ()
registerFunction                = (SBV c -> SBV b -> SBV a) -> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV c -> SBV b -> SBV a) -> Symbolic ())
-> (((SBV c, SBV b) -> SBV a) -> SBV c -> SBV b -> SBV a)
-> ((SBV c, SBV b) -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV c, SBV b) -> SBV a) -> SBV c -> SBV b -> SBV a
forall a b z. ((a, b) -> z) -> a -> b -> z
curry2
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind ((SBV c, SBV b) -> SBV a)
-> (SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind ((SBV c, SBV b) -> SBV a)
uiKind = let f :: SBV c -> SBV b -> SBV a
f = UIName
-> Maybe [String]
-> UIKind (SBV c -> SBV b -> SBV a)
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV c, SBV b) -> SBV a) -> SBV c -> SBV b -> SBV a
forall a b z. ((a, b) -> z) -> a -> b -> z
curry2 (((SBV c, SBV b) -> SBV a) -> SBV c -> SBV b -> SBV a)
-> UIKind ((SBV c, SBV b) -> SBV a)
-> UIKind (SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind ((SBV c, SBV b) -> SBV a)
-> UIKind ((SBV c, SBV b) -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind ((SBV c, SBV b) -> SBV a)
uiKind) in (SBV c -> SBV b -> SBV a) -> (SBV c, SBV b) -> SBV a
forall a b z. (a -> b -> z) -> (a, b) -> z
uncurry2 SBV c -> SBV b -> SBV a
f

-- Uncurried functions of three arguments
instance (SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV d, SBV c, SBV b) -> SBV a) -> m String
sbv2smt (SBV d, SBV c, SBV b) -> SBV a
fn                      = ((SBV d, SBV c, SBV b) -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV d, SBV c, SBV b) -> SBool) -> m String)
-> ((SBV d, SBV c, SBV b) -> SBool) -> m String
forall a b. (a -> b) -> a -> b
$ \(SBV d, SBV c, SBV b)
p -> (SBV d, SBV c, SBV b) -> SBV a
fn (SBV d, SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV d, SBV c, SBV b) -> SBV a
fn (SBV d, SBV c, SBV b)
p
  registerFunction :: ((SBV d, SBV c, SBV b) -> SBV a) -> Symbolic ()
registerFunction                = (SBV d -> SBV c -> SBV b -> SBV a) -> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV d -> SBV c -> SBV b -> SBV a) -> Symbolic ())
-> (((SBV d, SBV c, SBV b) -> SBV a)
    -> SBV d -> SBV c -> SBV b -> SBV a)
-> ((SBV d, SBV c, SBV b) -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV d, SBV c, SBV b) -> SBV a)
-> SBV d -> SBV c -> SBV b -> SBV a
forall a b c z. ((a, b, c) -> z) -> a -> b -> c -> z
curry3
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind ((SBV d, SBV c, SBV b) -> SBV a)
-> (SBV d, SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind ((SBV d, SBV c, SBV b) -> SBV a)
uiKind = let f :: SBV d -> SBV c -> SBV b -> SBV a
f = UIName
-> Maybe [String]
-> UIKind (SBV d -> SBV c -> SBV b -> SBV a)
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV d, SBV c, SBV b) -> SBV a)
-> SBV d -> SBV c -> SBV b -> SBV a
forall a b c z. ((a, b, c) -> z) -> a -> b -> c -> z
curry3 (((SBV d, SBV c, SBV b) -> SBV a)
 -> SBV d -> SBV c -> SBV b -> SBV a)
-> UIKind ((SBV d, SBV c, SBV b) -> SBV a)
-> UIKind (SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind ((SBV d, SBV c, SBV b) -> SBV a)
-> UIKind ((SBV d, SBV c, SBV b) -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind ((SBV d, SBV c, SBV b) -> SBV a)
uiKind) in (SBV d -> SBV c -> SBV b -> SBV a)
-> (SBV d, SBV c, SBV b) -> SBV a
forall a b c z. (a -> b -> c -> z) -> (a, b, c) -> z
uncurry3 SBV d -> SBV c -> SBV b -> SBV a
f

-- Uncurried functions of four arguments
instance (SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV e, SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV e, SBV d, SBV c, SBV b) -> SBV a) -> m String
sbv2smt (SBV e, SBV d, SBV c, SBV b) -> SBV a
fn                      = ((SBV e, SBV d, SBV c, SBV b) -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV e, SBV d, SBV c, SBV b) -> SBool) -> m String)
-> ((SBV e, SBV d, SBV c, SBV b) -> SBool) -> m String
forall a b. (a -> b) -> a -> b
$ \(SBV e, SBV d, SBV c, SBV b)
p -> (SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV e, SBV d, SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV e, SBV d, SBV c, SBV b)
p
  registerFunction :: ((SBV e, SBV d, SBV c, SBV b) -> SBV a) -> Symbolic ()
registerFunction                = (SBV e -> SBV d -> SBV c -> SBV b -> SBV a) -> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV e -> SBV d -> SBV c -> SBV b -> SBV a) -> Symbolic ())
-> (((SBV e, SBV d, SBV c, SBV b) -> SBV a)
    -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> ((SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
forall a b c d z. ((a, b, c, d) -> z) -> a -> b -> c -> d -> z
curry4
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind ((SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> (SBV e, SBV d, SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind ((SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind = let f :: SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f = UIName
-> Maybe [String]
-> UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
forall a b c d z. ((a, b, c, d) -> z) -> a -> b -> c -> d -> z
curry4 (((SBV e, SBV d, SBV c, SBV b) -> SBV a)
 -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> UIKind ((SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind ((SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind ((SBV e, SBV d, SBV c, SBV b) -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind ((SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind) in (SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> (SBV e, SBV d, SBV c, SBV b) -> SBV a
forall a b c d z. (a -> b -> c -> d -> z) -> (a, b, c, d) -> z
uncurry4 SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f

-- Uncurried functions of five arguments
instance (SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) -> m String
sbv2smt (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn                      = ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool) -> m String)
-> ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool) -> m String
forall a b. (a -> b) -> a -> b
$ \(SBV f, SBV e, SBV d, SBV c, SBV b)
p -> (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV f, SBV e, SBV d, SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV f, SBV e, SBV d, SBV c, SBV b)
p
  registerFunction :: ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) -> Symbolic ()
registerFunction                = (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) -> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
 -> Symbolic ())
-> (((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
    -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
forall a b c d e z.
((a, b, c, d, e) -> z) -> a -> b -> c -> d -> e -> z
curry5
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> (SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind = let f :: SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f = UIName
-> Maybe [String]
-> UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
forall a b c d e z.
((a, b, c, d, e) -> z) -> a -> b -> c -> d -> e -> z
curry5 (((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
 -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> UIKind ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind) in (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> (SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
forall a b c d e z.
(a -> b -> c -> d -> e -> z) -> (a, b, c, d, e) -> z
uncurry5 SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f

-- Uncurried functions of six arguments
instance (SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) -> m String
sbv2smt (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn                      = ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool) -> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool) -> m String)
-> ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \(SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p -> (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p
  registerFunction :: ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Symbolic ()
registerFunction                = (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
 -> Symbolic ())
-> (((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
    -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
forall a b c d e f z.
((a, b, c, d, e, f) -> z) -> a -> b -> c -> d -> e -> f -> z
curry6
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind = let f :: SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f = UIName
-> Maybe [String]
-> UIKind
     (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
forall a b c d e f z.
((a, b, c, d, e, f) -> z) -> a -> b -> c -> d -> e -> f -> z
curry6 (((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
 -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> UIKind ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind
     (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind) in (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> (SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
forall a b c d e f z.
(a -> b -> c -> d -> e -> f -> z) -> (a, b, c, d, e, f) -> z
uncurry6 SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f

-- Uncurried functions of seven arguments
instance (SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> m String
sbv2smt (SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn                      = ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool)
 -> m String)
-> ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \(SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p -> (SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p
  registerFunction :: ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Symbolic ()
registerFunction                = (SBV h
 -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV h
  -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
 -> Symbolic ())
-> (((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a)
-> ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g z.
((a, b, c, d, e, f, g) -> z)
-> a -> b -> c -> d -> e -> f -> g -> z
curry7
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> (SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind = let f :: SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f = UIName
-> Maybe [String]
-> UIKind
     (SBV h
      -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g z.
((a, b, c, d, e, f, g) -> z)
-> a -> b -> c -> d -> e -> f -> g -> z
curry7 (((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> UIKind
     ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind
     (SBV h
      -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind
     ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind) in (SBV h
 -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a)
-> (SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
forall a b c d e f g z.
(a -> b -> c -> d -> e -> f -> g -> z)
-> (a, b, c, d, e, f, g) -> z
uncurry7 SBV h
-> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a
f

-- Uncurried functions of eight arguments
instance (SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> m String
sbv2smt (SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn                      = ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
  -> SBool)
 -> m String)
-> ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \(SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p -> (SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a
fn (SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p
  registerFunction :: ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> Symbolic ()
registerFunction                = (SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBV a)
 -> Symbolic ())
-> (((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
     -> SBV a)
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a)
-> ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
    -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h z.
((a, b, c, d, e, f, g, h) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> z
curry8
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> (SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind = let f :: SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f = UIName
-> Maybe [String]
-> UIKind
     (SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h z.
((a, b, c, d, e, f, g, h) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> z
curry8 (((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
  -> SBV a)
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> UIKind
     ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind
     (SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind
  ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
-> UIKind
     ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind
  ((SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a)
uiKind) in (SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> (SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
forall a b c d e f g h z.
(a -> b -> c -> d -> e -> f -> g -> h -> z)
-> (a, b, c, d, e, f, g, h) -> z
uncurry8 SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f

-- Uncurried functions of nine arguments
instance (SymVal j, SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
 -> SBV a)
-> m String
sbv2smt (SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
fn                      = ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
 -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
  -> SBool)
 -> m String)
-> ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \(SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p -> (SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
fn (SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
fn (SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
p
  registerFunction :: ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
 -> SBV a)
-> Symbolic ()
registerFunction                = (SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV j
  -> SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBV a)
 -> Symbolic ())
-> (((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
      SBV b)
     -> SBV a)
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a)
-> ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
    -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
 -> SBV a)
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h i z.
((a, b, c, d, e, f, g, h, i) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> z
curry9
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
      -> SBV a)
-> (SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
   -> SBV a)
uiKind = let f :: SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f = UIName
-> Maybe [String]
-> UIKind
     (SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
 -> SBV a)
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h i z.
((a, b, c, d, e, f, g, h, i) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> z
curry9 (((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
  -> SBV a)
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> UIKind
     ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
      -> SBV a)
-> UIKind
     (SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind
  ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
   -> SBV a)
-> UIKind
     ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
      -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind
  ((SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
   -> SBV a)
uiKind) in (SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> (SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b)
-> SBV a
forall a b c d e f g h i z.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> z)
-> (a, b, c, d, e, f, g, h, i) -> z
uncurry9 SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f

-- Uncurried functions of ten arguments
instance (SymVal k, SymVal j, SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
  SBV b)
 -> SBV a)
-> m String
sbv2smt (SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
 SBV b)
-> SBV a
fn                      = ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
  SBV b)
 -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
   SBV b)
  -> SBool)
 -> m String)
-> ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
     SBV b)
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \(SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
 SBV b)
p -> (SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
 SBV b)
-> SBV a
fn (SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
 SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
 SBV b)
-> SBV a
fn (SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
 SBV b)
p
  registerFunction :: ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
  SBV b)
 -> SBV a)
-> Symbolic ()
registerFunction                = (SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV k
  -> SBV j
  -> SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBV a)
 -> Symbolic ())
-> (((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
      SBV c, SBV b)
     -> SBV a)
    -> SBV k
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a)
-> ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
     SBV b)
    -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
  SBV b)
 -> SBV a)
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h i j z.
((a, b, c, d, e, f, g, h, i, j) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> z
curry10
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
       SBV b)
      -> SBV a)
-> (SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
    SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
    SBV b)
   -> SBV a)
uiKind = let f :: SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f = UIName
-> Maybe [String]
-> UIKind
     (SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
  SBV b)
 -> SBV a)
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h i j z.
((a, b, c, d, e, f, g, h, i, j) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> z
curry10 (((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
   SBV b)
  -> SBV a)
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> UIKind
     ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
       SBV b)
      -> SBV a)
-> UIKind
     (SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind
  ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
    SBV b)
   -> SBV a)
-> UIKind
     ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
       SBV b)
      -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind
  ((SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
    SBV b)
   -> SBV a)
uiKind) in (SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> (SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c,
    SBV b)
-> SBV a
forall a b c d e f g h i j z.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> z)
-> (a, b, c, d, e, f, g, h, i, j) -> z
uncurry10 SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f

-- Uncurried functions of eleven arguments
instance (SymVal l, SymVal k, SymVal j, SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
  SBV c, SBV b)
 -> SBV a)
-> m String
sbv2smt (SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
 SBV c, SBV b)
-> SBV a
fn                      = ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
  SBV c, SBV b)
 -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
   SBV c, SBV b)
  -> SBool)
 -> m String)
-> ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
     SBV c, SBV b)
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \(SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
 SBV c, SBV b)
p -> (SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
 SBV c, SBV b)
-> SBV a
fn (SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
 SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
 SBV c, SBV b)
-> SBV a
fn (SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
 SBV c, SBV b)
p
  registerFunction :: ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
  SBV c, SBV b)
 -> SBV a)
-> Symbolic ()
registerFunction                = (SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV l
  -> SBV k
  -> SBV j
  -> SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBV a)
 -> Symbolic ())
-> (((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
      SBV d, SBV c, SBV b)
     -> SBV a)
    -> SBV l
    -> SBV k
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a)
-> ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
     SBV c, SBV b)
    -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
  SBV c, SBV b)
 -> SBV a)
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h i j k z.
((a, b, c, d, e, f, g, h, i, j, k) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> z
curry11
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
       SBV c, SBV b)
      -> SBV a)
-> (SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
    SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
    SBV c, SBV b)
   -> SBV a)
uiKind = let f :: SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f = UIName
-> Maybe [String]
-> UIKind
     (SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
  SBV c, SBV b)
 -> SBV a)
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h i j k z.
((a, b, c, d, e, f, g, h, i, j, k) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> z
curry11 (((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
   SBV c, SBV b)
  -> SBV a)
 -> SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> UIKind
     ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
       SBV c, SBV b)
      -> SBV a)
-> UIKind
     (SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind
  ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
    SBV c, SBV b)
   -> SBV a)
-> UIKind
     ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
       SBV c, SBV b)
      -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind
  ((SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
    SBV c, SBV b)
   -> SBV a)
uiKind) in (SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> (SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d,
    SBV c, SBV b)
-> SBV a
forall a b c d e f g h i j k z.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> z)
-> (a, b, c, d, e, f, g, h, i, j, k) -> z
uncurry11 SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f

-- Uncurried functions of twelve arguments
instance (SymVal m, SymVal l, SymVal k, SymVal j, SymVal i, SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, SymVal a, HasKind a) => SMTDefinable ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where
  sbv2smt :: forall (m :: * -> *).
ExtractIO m =>
((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
  SBV d, SBV c, SBV b)
 -> SBV a)
-> m String
sbv2smt (SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
 SBV d, SBV c, SBV b)
-> SBV a
fn                      = ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
  SBV d, SBV c, SBV b)
 -> SBool)
-> m String
forall (m :: * -> *) a. SatisfiableM m a => a -> m String
defs2smt (((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
   SBV d, SBV c, SBV b)
  -> SBool)
 -> m String)
-> ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
     SBV d, SBV c, SBV b)
    -> SBool)
-> m String
forall a b. (a -> b) -> a -> b
$ \(SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
 SBV d, SBV c, SBV b)
p -> (SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
 SBV d, SBV c, SBV b)
-> SBV a
fn (SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
 SBV d, SBV c, SBV b)
p SBV a -> SBV a -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
 SBV d, SBV c, SBV b)
-> SBV a
fn (SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
 SBV d, SBV c, SBV b)
p
  registerFunction :: ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
  SBV d, SBV c, SBV b)
 -> SBV a)
-> Symbolic ()
registerFunction                = (SBV m
 -> SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> Symbolic ()
forall a. SMTDefinable a => a -> Symbolic ()
registerFunction ((SBV m
  -> SBV l
  -> SBV k
  -> SBV j
  -> SBV i
  -> SBV h
  -> SBV g
  -> SBV f
  -> SBV e
  -> SBV d
  -> SBV c
  -> SBV b
  -> SBV a)
 -> Symbolic ())
-> (((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f,
      SBV e, SBV d, SBV c, SBV b)
     -> SBV a)
    -> SBV m
    -> SBV l
    -> SBV k
    -> SBV j
    -> SBV i
    -> SBV h
    -> SBV g
    -> SBV f
    -> SBV e
    -> SBV d
    -> SBV c
    -> SBV b
    -> SBV a)
-> ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
     SBV d, SBV c, SBV b)
    -> SBV a)
-> Symbolic ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
  SBV d, SBV c, SBV b)
 -> SBV a)
-> SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h i j k l z.
((a, b, c, d, e, f, g, h, i, j, k, l) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> z
curry12
  sbvDefineValue :: UIName
-> Maybe [String]
-> UIKind
     ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
       SBV d, SBV c, SBV b)
      -> SBV a)
-> (SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
    SBV d, SBV c, SBV b)
-> SBV a
sbvDefineValue UIName
nm Maybe [String]
mbArgs UIKind
  ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
    SBV d, SBV c, SBV b)
   -> SBV a)
uiKind = let f :: SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f = UIName
-> Maybe [String]
-> UIKind
     (SBV m
      -> SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
-> SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a.
SMTDefinable a =>
UIName -> Maybe [String] -> UIKind a -> a
sbvDefineValue UIName
nm Maybe [String]
mbArgs (((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
  SBV d, SBV c, SBV b)
 -> SBV a)
-> SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
forall a b c d e f g h i j k l z.
((a, b, c, d, e, f, g, h, i, j, k, l) -> z)
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> z
curry12 (((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
   SBV d, SBV c, SBV b)
  -> SBV a)
 -> SBV m
 -> SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> UIKind
     ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
       SBV d, SBV c, SBV b)
      -> SBV a)
-> UIKind
     (SBV m
      -> SBV l
      -> SBV k
      -> SBV j
      -> SBV i
      -> SBV h
      -> SBV g
      -> SBV f
      -> SBV e
      -> SBV d
      -> SBV c
      -> SBV b
      -> SBV a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UIKind
  ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
    SBV d, SBV c, SBV b)
   -> SBV a)
-> UIKind
     ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
       SBV d, SBV c, SBV b)
      -> SBV a)
forall a. UIKind a -> UIKind a
mkUncurried UIKind
  ((SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
    SBV d, SBV c, SBV b)
   -> SBV a)
uiKind) in (SBV m
 -> SBV l
 -> SBV k
 -> SBV j
 -> SBV i
 -> SBV h
 -> SBV g
 -> SBV f
 -> SBV e
 -> SBV d
 -> SBV c
 -> SBV b
 -> SBV a)
-> (SBV m, SBV l, SBV k, SBV j, SBV i, SBV h, SBV g, SBV f, SBV e,
    SBV d, SBV c, SBV b)
-> SBV a
forall a b c d e f g h i j k l z.
(a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> z)
-> (a, b, c, d, e, f, g, h, i, j, k, l) -> z
uncurry12 SBV m
-> SBV l
-> SBV k
-> SBV j
-> SBV i
-> SBV h
-> SBV g
-> SBV f
-> SBV e
-> SBV d
-> SBV c
-> SBV b
-> SBV a
f

-- | Symbolic computations provide a context for writing symbolic programs.
instance MonadIO m => SolverContext (SymbolicT m) where
   constrain :: forall a. QuantifiedBool a => a -> SymbolicT m ()
constrain                   = Bool -> [(String, String)] -> SVal -> SymbolicT m ()
forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [(String, String)] -> SVal -> m ()
imposeConstraint Bool
False []               (SVal -> SymbolicT m ()) -> (a -> SVal) -> a -> SymbolicT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBool -> SVal
forall a. SBV a -> SVal
unSBV (SBool -> SVal) -> (a -> SBool) -> a -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SBool
forall a. QuantifiedBool a => a -> SBool
quantifiedBool
   softConstrain :: forall a. QuantifiedBool a => a -> SymbolicT m ()
softConstrain               = Bool -> [(String, String)] -> SVal -> SymbolicT m ()
forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [(String, String)] -> SVal -> m ()
imposeConstraint Bool
True  []               (SVal -> SymbolicT m ()) -> (a -> SVal) -> a -> SymbolicT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBool -> SVal
forall a. SBV a -> SVal
unSBV (SBool -> SVal) -> (a -> SBool) -> a -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SBool
forall a. QuantifiedBool a => a -> SBool
quantifiedBool
   namedConstraint :: forall a. QuantifiedBool a => String -> a -> SymbolicT m ()
namedConstraint        String
nm   = Bool -> [(String, String)] -> SVal -> SymbolicT m ()
forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [(String, String)] -> SVal -> m ()
imposeConstraint Bool
False [(String
":named", String
nm)] (SVal -> SymbolicT m ()) -> (a -> SVal) -> a -> SymbolicT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBool -> SVal
forall a. SBV a -> SVal
unSBV (SBool -> SVal) -> (a -> SBool) -> a -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SBool
forall a. QuantifiedBool a => a -> SBool
quantifiedBool
   constrainWithAttribute :: forall a.
QuantifiedBool a =>
[(String, String)] -> a -> SymbolicT m ()
constrainWithAttribute [(String, String)]
atts = Bool -> [(String, String)] -> SVal -> SymbolicT m ()
forall (m :: * -> *).
MonadSymbolic m =>
Bool -> [(String, String)] -> SVal -> m ()
imposeConstraint Bool
False [(String, String)]
atts             (SVal -> SymbolicT m ()) -> (a -> SVal) -> a -> SymbolicT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBool -> SVal
forall a. SBV a -> SVal
unSBV (SBool -> SVal) -> (a -> SBool) -> a -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SBool
forall a. QuantifiedBool a => a -> SBool
quantifiedBool

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

   internalVariable :: forall a. Kind -> SymbolicT m (SBV a)
internalVariable Kind
k = SymbolicT m State
forall (m :: * -> *). SolverContext m => m State
contextState SymbolicT m State
-> (State -> SymbolicT m (SBV a)) -> SymbolicT m (SBV a)
forall a b. SymbolicT m a -> (a -> SymbolicT m b) -> SymbolicT m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \State
st -> IO (SBV a) -> SymbolicT m (SBV a)
forall a. IO a -> SymbolicT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SBV a) -> SymbolicT m (SBV a))
-> IO (SBV a) -> SymbolicT m (SBV a)
forall a b. (a -> b) -> a -> b
$ do
                           SV
sv <- State -> Kind -> IO SV
newInternalVariable State
st Kind
k
                           SBV a -> IO (SBV a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SBV a -> IO (SBV a)) -> SBV a -> IO (SBV a)
forall a b. (a -> b) -> a -> b
$ SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache (IO SV -> State -> IO SV
forall a b. a -> b -> a
const (SV -> IO SV
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SV
sv))))

-- | Generalization of 'Data.SBV.assertWithPenalty'
assertWithPenalty :: MonadSymbolic m => String -> SBool -> Penalty -> m ()
assertWithPenalty :: forall (m :: * -> *).
MonadSymbolic m =>
String -> SBool -> Penalty -> m ()
assertWithPenalty String
nm SBool
o Penalty
p = Objective SVal -> m ()
forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal (Objective SVal -> m ()) -> Objective SVal -> m ()
forall a b. (a -> b) -> a -> b
$ SBool -> SVal
forall a. SBV a -> SVal
unSBV (SBool -> SVal) -> Objective SBool -> Objective SVal
forall a b. (a -> b) -> Objective a -> Objective b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> SBool -> Penalty -> Objective SBool
forall a. String -> a -> Penalty -> Objective a
AssertWithPenalty String
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'/'annotateForMS', 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

  -- | Annotate for the metric space, to clarify the new name. If this result is not identity,
  -- we will add an sObserve on the original.
  annotateForMS :: Proxy a -> String -> String

  -- | Minimizing a metric space
  msMinimize :: (MonadSymbolic m, SolverContext m) => String -> SBV a -> m ()
  msMinimize String
nm SBV a
o = do let nm' :: String
nm' = Proxy a -> String -> String
forall a. Metric a => Proxy a -> String -> String
annotateForMS (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) String
nm
                       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
nm' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
nm) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> SVal -> m ()
forall (m :: * -> *). MonadSymbolic m => String -> SVal -> m ()
sObserve String
nm (SBV a -> SVal
forall a. SBV a -> SVal
unSBV SBV a
o)
                       Objective SVal -> m ()
forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal (Objective SVal -> m ()) -> Objective SVal -> m ()
forall a b. (a -> b) -> a -> b
$ SBV (MetricSpace a) -> SVal
forall a. SBV a -> SVal
unSBV (SBV (MetricSpace a) -> SVal)
-> Objective (SBV (MetricSpace a)) -> Objective SVal
forall a b. (a -> b) -> Objective a -> Objective b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> SBV (MetricSpace a) -> Objective (SBV (MetricSpace a))
forall a. String -> a -> Objective a
Minimize String
nm' (SBV a -> SBV (MetricSpace a)
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 String
nm SBV a
o = do let nm' :: String
nm' = Proxy a -> String -> String
forall a. Metric a => Proxy a -> String -> String
annotateForMS (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) String
nm
                       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
nm' String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
nm) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> SVal -> m ()
forall (m :: * -> *). MonadSymbolic m => String -> SVal -> m ()
sObserve String
nm (SBV a -> SVal
forall a. SBV a -> SVal
unSBV SBV a
o)
                       Objective SVal -> m ()
forall (m :: * -> *). MonadSymbolic m => Objective SVal -> m ()
addSValOptGoal (Objective SVal -> m ()) -> Objective SVal -> m ()
forall a b. (a -> b) -> a -> b
$ SBV (MetricSpace a) -> SVal
forall a. SBV a -> SVal
unSBV (SBV (MetricSpace a) -> SVal)
-> Objective (SBV (MetricSpace a)) -> Objective SVal
forall a b. (a -> b) -> Objective a -> Objective b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> SBV (MetricSpace a) -> Objective (SBV (MetricSpace a))
forall a. String -> a -> Objective a
Maximize String
nm' (SBV a -> SBV (MetricSpace a)
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 = SBV a -> SBV a
SBV a -> SBV (MetricSpace a)
forall a. a -> a
id

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

  -- Annotations to indicate if the metric space transition was needed
  default annotateForMS :: (a ~ MetricSpace a) => Proxy a -> String -> String
  annotateForMS Proxy a
_ String
s = String
s

-- Booleans assume True is greater than False
instance Metric Bool where
  type MetricSpace Bool = Word8
  toMetricSpace :: SBool -> SBV (MetricSpace Bool)
toMetricSpace SBool
t   = SBool -> SBV Word8 -> SBV Word8 -> SBV Word8
forall a. Mergeable a => SBool -> a -> a -> a
ite SBool
t SBV Word8
1 SBV Word8
0
  fromMetricSpace :: SBV (MetricSpace Bool) -> SBool
fromMetricSpace SBV (MetricSpace Bool)
w = SBV Word8
SBV (MetricSpace Bool)
w SBV Word8 -> SBV Word8 -> SBool
forall a. EqSymbolic a => a -> a -> SBool
./= SBV Word8
0
  annotateForMS :: Proxy Bool -> String -> String
annotateForMS Proxy Bool
_ String
s = String
"toMetricSpace(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- | 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) =>
String -> SBV a -> m ()
minimize = String -> SBV a -> m ()
forall a (m :: * -> *).
(Metric a, MonadSymbolic m, SolverContext m) =>
String -> SBV a -> m ()
forall (m :: * -> *).
(MonadSymbolic m, SolverContext m) =>
String -> 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) =>
String -> SBV a -> m ()
maximize = String -> SBV a -> m ()
forall a (m :: * -> *).
(Metric a, MonadSymbolic m, SolverContext m) =>
String -> SBV a -> m ()
forall (m :: * -> *).
(MonadSymbolic m, SolverContext m) =>
String -> 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 :: SBV Int8 -> SBV (MetricSpace Int8)
toMetricSpace   SBV Int8
x = SBV Int8 -> SBV Word8
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV Int8
x SBV Word8 -> SBV Word8 -> SBV Word8
forall a. Num a => a -> a -> a
+ SBV Word8
128  -- 2^7
  fromMetricSpace :: SBV (MetricSpace Int8) -> SBV Int8
fromMetricSpace SBV (MetricSpace Int8)
x = SBV Word8 -> SBV Int8
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV Word8
SBV (MetricSpace Int8)
x SBV Int8 -> SBV Int8 -> SBV Int8
forall a. Num a => a -> a -> a
- SBV Int8
128
  annotateForMS :: Proxy Int8 -> String -> String
annotateForMS Proxy Int8
_ String
s = String
"toMetricSpace(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance Metric Int16 where
  type MetricSpace Int16 = Word16
  toMetricSpace :: SBV Int16 -> SBV (MetricSpace Int16)
toMetricSpace   SBV Int16
x = SBV Int16 -> SBV Word16
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV Int16
x SBV Word16 -> SBV Word16 -> SBV Word16
forall a. Num a => a -> a -> a
+ SBV Word16
32768  -- 2^15
  fromMetricSpace :: SBV (MetricSpace Int16) -> SBV Int16
fromMetricSpace SBV (MetricSpace Int16)
x = SBV Word16 -> SBV Int16
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV Word16
SBV (MetricSpace Int16)
x SBV Int16 -> SBV Int16 -> SBV Int16
forall a. Num a => a -> a -> a
- SBV Int16
32768
  annotateForMS :: Proxy Int16 -> String -> String
annotateForMS Proxy Int16
_ String
s = String
"toMetricSpace(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance Metric Int32 where
  type MetricSpace Int32 = Word32
  toMetricSpace :: SBV Int32 -> SBV (MetricSpace Int32)
toMetricSpace   SBV Int32
x = SBV Int32 -> SBV Word32
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV Int32
x SBV Word32 -> SBV Word32 -> SBV Word32
forall a. Num a => a -> a -> a
+ SBV Word32
2147483648 -- 2^31
  fromMetricSpace :: SBV (MetricSpace Int32) -> SBV Int32
fromMetricSpace SBV (MetricSpace Int32)
x = SBV Word32 -> SBV Int32
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV Word32
SBV (MetricSpace Int32)
x SBV Int32 -> SBV Int32 -> SBV Int32
forall a. Num a => a -> a -> a
- SBV Int32
2147483648
  annotateForMS :: Proxy Int32 -> String -> String
annotateForMS Proxy Int32
_ String
s = String
"toMetricSpace(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

instance Metric Int64 where
  type MetricSpace Int64 = Word64
  toMetricSpace :: SBV Int64 -> SBV (MetricSpace Int64)
toMetricSpace   SBV Int64
x = SBV Int64 -> SBV Word64
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV Int64
x SBV Word64 -> SBV Word64 -> SBV Word64
forall a. Num a => a -> a -> a
+ SBV Word64
9223372036854775808  -- 2^63
  fromMetricSpace :: SBV (MetricSpace Int64) -> SBV Int64
fromMetricSpace SBV (MetricSpace Int64)
x = SBV Word64 -> SBV Int64
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV Word64
SBV (MetricSpace Int64)
x SBV Int64 -> SBV Int64 -> SBV Int64
forall a. Num a => a -> a -> a
- SBV Int64
9223372036854775808
  annotateForMS :: Proxy Int64 -> String -> String
annotateForMS Proxy Int64
_ String
s = String
"toMetricSpace(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- | Optimizing 'WordN'
instance (KnownNat n, BVIsNonZero n) => Metric (WordN n)

-- | Optimizing 'IntN'
instance (KnownNat n, BVIsNonZero n) => Metric (IntN n) where
  type MetricSpace (IntN n) = WordN n
  toMetricSpace :: SBV (IntN n) -> SBV (MetricSpace (IntN n))
toMetricSpace   SBV (IntN n)
x = SBV (IntN n) -> SBV (WordN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV (IntN n)
x SBV (WordN n) -> SBV (WordN n) -> SBV (WordN n)
forall a. Num a => a -> a -> a
+ SBV (WordN n)
2 SBV (WordN n) -> Int -> SBV (WordN n)
forall a b. (Num a, Integral b) => a -> b -> a
^ (Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  fromMetricSpace :: SBV (MetricSpace (IntN n)) -> SBV (IntN n)
fromMetricSpace SBV (MetricSpace (IntN n))
x = SBV (WordN n) -> SBV (IntN n)
forall a b.
(Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b,
 SymVal b) =>
SBV a -> SBV b
sFromIntegral SBV (WordN n)
SBV (MetricSpace (IntN n))
x SBV (IntN n) -> SBV (IntN n) -> SBV (IntN n)
forall a. Num a => a -> a -> a
- SBV (IntN n)
2 SBV (IntN n) -> Int -> SBV (IntN n)
forall a b. (Num a, Integral b) => a -> b -> a
^ (Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  annotateForMS :: Proxy (IntN n) -> String -> String
annotateForMS Proxy (IntN n)
_ String
s = String
"toMetricSpace(" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"

-- Quickcheck interface on symbolic-booleans..
instance Testable SBool where
  property :: SBool -> Property
property (SBV (SVal Kind
_ (Left CV
b))) = Bool -> Property
forall prop. Testable prop => prop -> Property
property (CV -> Bool
cvToBool CV
b)
  property SBool
s                       = String -> Property
forall a. String -> a
cantQuickCheck (String -> Property) -> String -> Property
forall a b. (a -> b) -> a -> b
$ String
"Result did not evaluate to a concrete boolean: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SBool -> String
forall a. Show a => a -> String
show SBool
s

instance Testable (Symbolic SBool) where
   property :: Symbolic SBool -> Property
property Symbolic SBool
prop = PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
QC.monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$ do (Bool
cond, Bool
r, [(String, CV)]
modelVals) <- IO (Bool, Bool, [(String, CV)])
-> PropertyM IO (Bool, Bool, [(String, CV)])
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QC.run IO (Bool, Bool, [(String, CV)])
test
                                     Bool -> PropertyM IO ()
forall (m :: * -> *). Monad m => Bool -> PropertyM m ()
QC.pre Bool
cond
                                     Bool -> PropertyM IO () -> PropertyM IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
r Bool -> Bool -> Bool
|| [(String, CV)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(String, CV)]
modelVals) (PropertyM IO () -> PropertyM IO ())
-> PropertyM IO () -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$ (Property -> Property) -> PropertyM IO ()
forall (m :: * -> *).
Monad m =>
(Property -> Property) -> PropertyM m ()
QC.monitor (String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
QC.counterexample ([(String, CV)] -> String
complain [(String, CV)]
modelVals))
                                     Bool -> PropertyM IO ()
forall (m :: * -> *). Monad m => Bool -> PropertyM m ()
QC.assert Bool
r
     where test :: IO (Bool, Bool, [(String, CV)])
test = do (SBool
r, Result{resTraces :: Result -> [(String, CV)]
resTraces=[(String, CV)]
tvals, resObservables :: Result -> [(String, CV -> Bool, SV)]
resObservables=[(String, CV -> Bool, SV)]
ovals, resConsts :: Result -> (CnstMap, [(SV, CV)])
resConsts=(CnstMap
_, [(SV, CV)]
cs), resConstraints :: Result -> Seq (Bool, [(String, String)], SV)
resConstraints=Seq (Bool, [(String, String)], SV)
cstrs, resUIConsts :: Result -> [(String, (Bool, Maybe [String], SBVType))]
resUIConsts=[(String, (Bool, Maybe [String], SBVType))]
unints}) <- 
                                 IO (SBool, Result)
-> (SomeException -> IO (SBool, Result)) -> IO (SBool, Result)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
C.catch (SMTConfig -> SBVRunMode -> Symbolic SBool -> IO (SBool, Result)
forall (m :: * -> *) a.
MonadIO m =>
SMTConfig -> SBVRunMode -> SymbolicT m a -> m (a, Result)
runSymbolic SMTConfig
defaultSMTCfg (Maybe (Bool, [(NamedSymVar, CV)]) -> SBVRunMode
Concrete Maybe (Bool, [(NamedSymVar, CV)])
forall a. Maybe a
Nothing) Symbolic SBool
prop)
                                         (\(SomeException
e :: C.SomeException) -> String -> IO (SBool, Result)
forall a. String -> a
cantQuickCheck (SomeException -> String
forall a. Show a => a -> String
show SomeException
e))


                     let cval :: SV -> CV
cval = CV -> Maybe CV -> CV
forall a. a -> Maybe a -> a
fromMaybe (String -> CV
forall a. String -> a
cantQuickCheck String
"A constraint did not evaluate to a concrete boolean") (Maybe CV -> CV) -> (SV -> Maybe CV) -> SV -> CV
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SV -> [(SV, CV)] -> Maybe CV
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(SV, CV)]
cs)
                         cond :: Bool
cond = -- Only pick-up "hard" constraints, as indicated by False in the fist component
                                [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [CV -> Bool
cvToBool (SV -> CV
cval SV
v) | (Bool
False, [(String, String)]
_, SV
v) <- Seq (Bool, [(String, String)], SV)
-> [(Bool, [(String, String)], SV)]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq (Bool, [(String, String)], SV)
cstrs]

                         getObservable :: (String, CV -> Bool, SV) -> Maybe (String, CV)
getObservable (String
nm, CV -> Bool
f, SV
v) = case SV
v SV -> [(SV, CV)] -> Maybe CV
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(SV, CV)]
cs of
                                                      Just CV
cv -> if CV -> Bool
f CV
cv then (String, CV) -> Maybe (String, CV)
forall a. a -> Maybe a
Just (String
nm, CV
cv) else Maybe (String, CV)
forall a. Maybe a
Nothing
                                                      Maybe CV
Nothing -> String -> Maybe (String, CV)
forall a. String -> a
cantQuickCheck String
"An observable did not evaluate to a concrete value"

                     case ((String, (Bool, Maybe [String], SBVType)) -> String)
-> [(String, (Bool, Maybe [String], SBVType))] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Bool, Maybe [String], SBVType)) -> String
forall a b. (a, b) -> a
fst [(String, (Bool, Maybe [String], SBVType))]
unints of
                       [] -> case SBool -> Maybe Bool
forall a. SymVal a => SBV a -> Maybe a
unliteral SBool
r of
                               Maybe Bool
Nothing -> String -> IO (Bool, Bool, [(String, CV)])
forall a. String -> a
cantQuickCheck String
"The result did not evaluate to a concrete value"
                               Just Bool
b  -> (Bool, Bool, [(String, CV)]) -> IO (Bool, Bool, [(String, CV)])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
cond, Bool
b, [(String, CV)]
tvals [(String, CV)] -> [(String, CV)] -> [(String, CV)]
forall a. [a] -> [a] -> [a]
++ ((String, CV -> Bool, SV) -> Maybe (String, CV))
-> [(String, CV -> Bool, SV)] -> [(String, CV)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, CV -> Bool, SV) -> Maybe (String, CV)
getObservable [(String, CV -> Bool, SV)]
ovals)
                       [String]
uis -> String -> IO (Bool, Bool, [(String, CV)])
forall a. String -> a
cantQuickCheck (String -> IO (Bool, Bool, [(String, CV)]))
-> String -> IO (Bool, Bool, [(String, CV)])
forall a b. (a -> b) -> a -> b
$ String
"Uninterpreted constants remain: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
uis

           complain :: [(String, CV)] -> String
complain [(String, CV)]
qcInfo = SMTConfig -> SMTModel -> String
showModel SMTConfig
defaultSMTCfg ([(String, GeneralizedCV)]
-> Maybe [(NamedSymVar, CV)]
-> [(String, CV)]
-> [(String, (Bool, SBVType, Either String ([([CV], CV)], CV)))]
-> SMTModel
SMTModel [] Maybe [(NamedSymVar, CV)]
forall a. Maybe a
Nothing [(String, CV)]
qcInfo [])

-- Complain if what we got isn't something we can quick-check
cantQuickCheck :: String -> a
cantQuickCheck :: forall a. String -> a
cantQuickCheck String
why = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
"*** Data.SBV: Cannot quickcheck the given property."
                                     , String
"***"
                                     , String
"*** Certain SBV properties cannot be quick-checked. In particular,"
                                     , String
"*** SBV can't quick-check in the presence of:"
                                     , String
"***"
                                     , String
"***   - Uninterpreted constants."
                                     , String
"***   - Uninterpreted types."
                                     , String
"***   - Floating point operations with rounding modes other than RNE."
                                     , String
"***   - Floating point FMA operation, regardless of rounding mode."
                                     , String
"***   - Quantified booleans, i.e., uses of Forall/Exists/ExistsUnique."
                                     , String
"***   - Uses of quantifiedBool"
                                     , String
"***   - Calls to 'observe' (use 'sObserve' instead)"
                                     , String
"***"
                                     , String
"*** If you can't avoid the above features or run into an issue with"
                                     , String
"*** quickcheck even though you haven't used these features, please report this as a bug!"
                                     , String
"***"
                                     , String
"*** Origin:"
                                     , String
"***"
                                     , String
why
                                     ]

-- | 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 (Result -> Bool) -> IO Result -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Symbolic SBool -> IO Result
forall prop. Testable prop => prop -> IO Result
QC.quickCheckResult Symbolic SBool
prop

-- 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 = Symbolic SBool -> Property
forall prop. Testable prop => prop -> Property
property (Symbolic SBool -> Property) -> Symbolic SBool -> Property
forall a b. (a -> b) -> a -> b
$ do SVal
s <- Symbolic SVal
m
                             Bool -> Symbolic () -> Symbolic ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SVal -> Kind
forall a. HasKind a => a -> Kind
kindOf SVal
s Kind -> Kind -> Bool
forall a. Eq a => a -> a -> Bool
/= Kind
KBool) (Symbolic () -> Symbolic ()) -> Symbolic () -> Symbolic ()
forall a b. (a -> b) -> a -> b
$ String -> Symbolic ()
forall a. HasCallStack => String -> a
error String
"Cannot quickcheck non-boolean value"
                             SBool -> Symbolic SBool
forall a. a -> SymbolicT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SVal -> SBool
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 = SVal -> SBV b
forall a. SVal -> SBV a
SBV (SVal -> SBV b) -> SVal -> SBV b
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
    where k :: Kind
k    = Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)
          r :: State -> IO SV
r State
st = do SV
xsv <- State -> SBV a -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV a
x
                    let xsbv :: SBV a
xsbv = SVal -> SBV a
forall a. SVal -> SBV a
SBV (SVal -> SBV a) -> SVal -> SBV a
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal (SBV a -> Kind
forall a. HasKind a => a -> Kind
kindOf SBV a
x) (Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right ((State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache (IO SV -> State -> IO SV
forall a b. a -> b -> a
const (SV -> IO SV
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SV
xsv))))
                        res :: SBV b
res  = SBV a -> SBV b
f SBV a
xsbv
                    State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV b
res

-- | Class of things that we can logically reduce to a boolean, by saturating and then asserting equivalance to itself
class QSaturate m a where
  qSaturate :: a -> m ()

-- | Base case; simple variable in the symbolic monad
instance SolverContext m => QSaturate m SBool where
  qSaturate :: SBool -> m ()
qSaturate SBool
b = SBool -> m ()
forall a. QuantifiedBool a => a -> m ()
forall (m :: * -> *) a.
(SolverContext m, QuantifiedBool a) =>
a -> m ()
constrain (SBool -> m ()) -> SBool -> m ()
forall a b. (a -> b) -> a -> b
$ SBool
b SBool -> SBool -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBool
b

-- | Saturate over a universal quantifier
instance (HasKind a, Monad m, SolverContext m, QSaturate m r) => QSaturate m (Forall nm a -> r) where
  qSaturate :: (Forall nm a -> r) -> m ()
qSaturate Forall nm a -> r
f = r -> m ()
forall (m :: * -> *) a. QSaturate m a => a -> m ()
qSaturate (r -> m ()) -> (SBV a -> r) -> SBV a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Forall nm a -> r
f (Forall nm a -> r) -> (SBV a -> Forall nm a) -> SBV a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBV a -> Forall nm a
forall (nm :: Symbol) a. SBV a -> Forall nm a
Forall (SBV a -> m ()) -> m (SBV a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Kind -> m (SBV a)
forall a. Kind -> m (SBV a)
forall (m :: * -> *) a. SolverContext m => Kind -> m (SBV a)
internalVariable (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))

-- | Saturate over a pair of universal quantifiers
instance (HasKind a, HasKind b, Monad m, SolverContext m, QSaturate m r) => QSaturate m ((Forall na a, Forall nb b) -> r) where
  qSaturate :: ((Forall na a, Forall nb b) -> r) -> m ()
qSaturate = (Forall na a -> Forall nb b -> r) -> m ()
forall (m :: * -> *) a. QSaturate m a => a -> m ()
qSaturate ((Forall na a -> Forall nb b -> r) -> m ())
-> (((Forall na a, Forall nb b) -> r)
    -> Forall na a -> Forall nb b -> r)
-> ((Forall na a, Forall nb b) -> r)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Forall na a, Forall nb b) -> r)
-> Forall na a -> Forall nb b -> r
forall a b z. ((a, b) -> z) -> a -> b -> z
curry

-- | Saturate over a pair of existential quantifiers
instance (HasKind a, HasKind b, Monad m, SolverContext m, QSaturate m r) => QSaturate m ((Exists na a, Exists nb b) -> r) where
  qSaturate :: ((Exists na a, Exists nb b) -> r) -> m ()
qSaturate = (Exists na a -> Exists nb b -> r) -> m ()
forall (m :: * -> *) a. QSaturate m a => a -> m ()
qSaturate ((Exists na a -> Exists nb b -> r) -> m ())
-> (((Exists na a, Exists nb b) -> r)
    -> Exists na a -> Exists nb b -> r)
-> ((Exists na a, Exists nb b) -> r)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Exists na a, Exists nb b) -> r)
-> Exists na a -> Exists nb b -> r
forall a b z. ((a, b) -> z) -> a -> b -> z
curry

-- | Saturate over a number of universal quantifiers
instance (KnownNat n, HasKind a, Monad m, SolverContext m, QSaturate m r) => QSaturate m (ForallN n nm a -> r) where
  qSaturate :: (ForallN n nm a -> r) -> m ()
qSaturate ForallN n nm a -> r
f = r -> m ()
forall (m :: * -> *) a. QSaturate m a => a -> m ()
qSaturate (r -> m ()) -> ([SBV a] -> r) -> [SBV a] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForallN n nm a -> r
f (ForallN n nm a -> r)
-> ([SBV a] -> ForallN n nm a) -> [SBV a] -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SBV a] -> ForallN n nm a
forall (n :: Nat) (nm :: Symbol) a. [SBV a] -> ForallN n nm a
ForallN ([SBV a] -> m ()) -> m [SBV a] -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> m (SBV a) -> m [SBV a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)) (Kind -> m (SBV a)
forall a. Kind -> m (SBV a)
forall (m :: * -> *) a. SolverContext m => Kind -> m (SBV a)
internalVariable (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)))

-- | Saturate over an existential quantifier
instance (HasKind a, Monad m, SolverContext m, QSaturate m r) => QSaturate m (Exists nm a -> r) where
  qSaturate :: (Exists nm a -> r) -> m ()
qSaturate Exists nm a -> r
f = r -> m ()
forall (m :: * -> *) a. QSaturate m a => a -> m ()
qSaturate (r -> m ()) -> (SBV a -> r) -> SBV a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exists nm a -> r
f (Exists nm a -> r) -> (SBV a -> Exists nm a) -> SBV a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBV a -> Exists nm a
forall (nm :: Symbol) a. SBV a -> Exists nm a
Exists (SBV a -> m ()) -> m (SBV a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Kind -> m (SBV a)
forall a. Kind -> m (SBV a)
forall (m :: * -> *) a. SolverContext m => Kind -> m (SBV a)
internalVariable (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))

-- | Saturate over an a number of existential quantifiers
instance (KnownNat n, HasKind a, Monad m, SolverContext m, QSaturate m r) => QSaturate m (ExistsN n nm a -> r) where
  qSaturate :: (ExistsN n nm a -> r) -> m ()
qSaturate ExistsN n nm a -> r
f = r -> m ()
forall (m :: * -> *) a. QSaturate m a => a -> m ()
qSaturate (r -> m ()) -> ([SBV a] -> r) -> [SBV a] -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistsN n nm a -> r
f (ExistsN n nm a -> r)
-> ([SBV a] -> ExistsN n nm a) -> [SBV a] -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SBV a] -> ExistsN n nm a
forall (n :: Nat) (nm :: Symbol) a. [SBV a] -> ExistsN n nm a
ExistsN ([SBV a] -> m ()) -> m [SBV a] -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> m (SBV a) -> m [SBV a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Proxy n -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
intOfProxy (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @n)) (Kind -> m (SBV a)
forall a. Kind -> m (SBV a)
forall (m :: * -> *) a. SolverContext m => Kind -> m (SBV a)
internalVariable (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)))

-- | Saturate over a unique-exists variable
instance (HasKind a, Monad m, SolverContext m, QSaturate m r) => QSaturate m (ExistsUnique nm a -> r) where
  qSaturate :: (ExistsUnique nm a -> r) -> m ()
qSaturate ExistsUnique nm a -> r
f = r -> m ()
forall (m :: * -> *) a. QSaturate m a => a -> m ()
qSaturate (r -> m ()) -> (SBV a -> r) -> SBV a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExistsUnique nm a -> r
f (ExistsUnique nm a -> r)
-> (SBV a -> ExistsUnique nm a) -> SBV a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SBV a -> ExistsUnique nm a
forall (nm :: Symbol) a. SBV a -> ExistsUnique nm a
ExistsUnique (SBV a -> m ()) -> m (SBV a) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Kind -> m (SBV a)
forall a. Kind -> m (SBV a)
forall (m :: * -> *) a. SolverContext m => Kind -> m (SBV a)
internalVariable (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a))

-- | Saturate a predicate, but save/restore observables so they're not messed up.
qSaturateSavingObservables :: (Monad m, MonadIO m, SolverContext m, QSaturate m a) => a -> m ()
qSaturateSavingObservables :: forall (m :: * -> *) a.
(Monad m, MonadIO m, SolverContext m, QSaturate m a) =>
a -> m ()
qSaturateSavingObservables a
p = do State{IORef (Seq (Name, CV -> Bool, SV))
rObservables :: IORef (Seq (Name, CV -> Bool, SV))
rObservables :: State -> IORef (Seq (Name, CV -> Bool, SV))
rObservables} <- m State
forall (m :: * -> *). SolverContext m => m State
contextState
                                  Seq (Name, CV -> Bool, SV)
curObservables <- IO (Seq (Name, CV -> Bool, SV)) -> m (Seq (Name, CV -> Bool, SV))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Seq (Name, CV -> Bool, SV)) -> m (Seq (Name, CV -> Bool, SV)))
-> IO (Seq (Name, CV -> Bool, SV))
-> m (Seq (Name, CV -> Bool, SV))
forall a b. (a -> b) -> a -> b
$ IORef (Seq (Name, CV -> Bool, SV))
-> IO (Seq (Name, CV -> Bool, SV))
forall a. IORef a -> IO a
readIORef IORef (Seq (Name, CV -> Bool, SV))
rObservables
                                  a -> m ()
forall (m :: * -> *) a. QSaturate m a => a -> m ()
qSaturate a
p
                                  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IORef (Seq (Name, CV -> Bool, SV))
-> Seq (Name, CV -> Bool, SV) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Seq (Name, CV -> Bool, SV))
rObservables Seq (Name, CV -> Bool, SV)
curObservables

-- | 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 = (SBV a -> SBool) -> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBool) -> IO ThmResult)
-> (SBV a -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a -> SBV a -> z
k SBV a
a z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> z
l SBV a
a

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, EqSymbolic z) => Equality (SBV a -> SBV b -> z) where
  SBV a -> SBV b -> z
k === :: (SBV a -> SBV b -> z) -> (SBV a -> SBV b -> z) -> IO ThmResult
=== SBV a -> SBV b -> z
l = (SBV a -> SBV b -> SBool) -> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b -> SBV a -> SBV b -> z
k SBV a
a SBV b
b z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> z
l SBV a
a SBV b
b

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, EqSymbolic z) => Equality ((SBV a, SBV b) -> z) where
  (SBV a, SBV b) -> z
k === :: ((SBV a, SBV b) -> z) -> ((SBV a, SBV b) -> z) -> IO ThmResult
=== (SBV a, SBV b) -> z
l = (SBV a -> SBV b -> SBool) -> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b -> (SBV a, SBV b) -> z
k (SBV a
a, SBV b
b) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b) -> z
l (SBV a
a, SBV b
b)

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> z) where
  SBV a -> SBV b -> SBV c -> z
k === :: (SBV a -> SBV b -> SBV c -> z)
-> (SBV a -> SBV b -> SBV c -> z) -> IO ThmResult
=== SBV a -> SBV b -> SBV c -> z
l = (SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c -> SBV a -> SBV b -> SBV c -> z
k SBV a
a SBV b
b SBV c
c z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> z
l SBV a
a SBV b
b SBV c
c

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c) -> z) where
  (SBV a, SBV b, SBV c) -> z
k === :: ((SBV a, SBV b, SBV c) -> z)
-> ((SBV a, SBV b, SBV c) -> z) -> IO ThmResult
=== (SBV a, SBV b, SBV c) -> z
l = (SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c -> (SBV a, SBV b, SBV c) -> z
k (SBV a
a, SBV b
b, SBV c
c) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c) -> z
l (SBV a
a, SBV b
b, SBV c
c)

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> z) where
  SBV a -> SBV b -> SBV c -> SBV d -> z
k === :: (SBV a -> SBV b -> SBV c -> SBV d -> z)
-> (SBV a -> SBV b -> SBV c -> SBV d -> z) -> IO ThmResult
=== SBV a -> SBV b -> SBV c -> SBV d -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d -> SBV a -> SBV b -> SBV c -> SBV d -> z
k SBV a
a SBV b
b SBV c
c SBV d
d z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> SBV d -> z
l SBV a
a SBV b
b SBV c
c SBV d
d

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d) -> z) where
  (SBV a, SBV b, SBV c, SBV d) -> z
k === :: ((SBV a, SBV b, SBV c, SBV d) -> z)
-> ((SBV a, SBV b, SBV c, SBV d) -> z) -> IO ThmResult
=== (SBV a, SBV b, SBV c, SBV d) -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBool) -> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d -> (SBV a, SBV b, SBV c, SBV d) -> z
k (SBV a
a, SBV b
b, SBV c
c, SBV d
d) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c, SBV d) -> z
l (SBV a
a, SBV b
b, SBV c
c, SBV d
d)

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z) where
  SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z
k === :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z) -> IO ThmResult
=== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
 -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e -> SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z
k SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z
l SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d, SBV e) -> z) where
  (SBV a, SBV b, SBV c, SBV d, SBV e) -> z
k === :: ((SBV a, SBV b, SBV c, SBV d, SBV e) -> z)
-> ((SBV a, SBV b, SBV c, SBV d, SBV e) -> z) -> IO ThmResult
=== (SBV a, SBV b, SBV c, SBV d, SBV e) -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
 -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e -> (SBV a, SBV b, SBV c, SBV d, SBV e) -> z
k (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c, SBV d, SBV e) -> z
l (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e)

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z) where
  SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z
k === :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z)
-> IO ThmResult
=== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
 -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f -> SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z
k SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z
l SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f

instance {-# OVERLAPPABLE #-}
 (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z) where
  (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z
k === :: ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z)
-> ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z)
-> IO ThmResult
=== (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z
l = (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
 -> IO ThmResult)
-> (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f -> (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z
k (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e, SBV f
f) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z
l (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e, SBV f
f)

instance {-# OVERLAPPABLE #-}
 (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z) where
  SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z
k === :: (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z)
-> (SBV a
    -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z)
-> IO ThmResult
=== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z
l = (SBV a
 -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a
  -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
 -> IO ThmResult)
-> (SBV a
    -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f SBV g
g -> SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z
k SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f SBV g
g z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z
l SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f SBV g
g

instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z) where
  (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z
k === :: ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z)
-> ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z)
-> IO ThmResult
=== (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z
l = (SBV a
 -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult
forall (m :: * -> *) a. ProvableM m a => a -> m ThmResult
prove ((SBV a
  -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
 -> IO ThmResult)
-> (SBV a
    -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> SBool)
-> IO ThmResult
forall a b. (a -> b) -> a -> b
$ \SBV a
a SBV b
b SBV c
c SBV d
d SBV e
e SBV f
f SBV g
g -> (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z
k (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e, SBV f
f, SBV g
g) z -> z -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z
l (SBV a
a, SBV b
b, SBV c
c, SBV d
d, SBV e
e, SBV f
f, SBV g
g)

-- | Reading a value from an array.
readArray :: forall key val. (Eq key, SymVal key, SymVal val, HasKind val) => SArray key val -> SBV key -> SBV val
readArray :: forall key val.
(Eq key, SymVal key, SymVal val, HasKind val) =>
SArray key val -> SBV key -> SBV val
readArray SArray key val
array SBV key
key
   | Kind -> Bool
eqCheckIsObjectEq Kind
ka, Just (ArrayModel [(key, val)]
tbl val
def) <- SArray key val -> Maybe (ArrayModel key val)
forall a. SymVal a => SBV a -> Maybe a
unliteral SArray key val
array, Just key
k <- SBV key -> Maybe key
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV key
key
   = val -> SBV val
forall a. SymVal a => a -> SBV a
literal (val -> SBV val) -> val -> SBV val
forall a b. (a -> b) -> a -> b
$ val -> Maybe val -> val
forall a. a -> Maybe a -> a
fromMaybe val
def (key
k key -> [(key, val)] -> Maybe val
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(key, val)]
tbl) -- return the first value, since we don't bother deleting previous writes
   | Bool
True
   = SBV val
symRes
   where symRes :: SBV val
symRes = SVal -> SBV val
forall a. SVal -> SBV a
SBV (SVal -> SBV val) -> (Cached SV -> SVal) -> Cached SV -> SBV val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
kb (Either CV (Cached SV) -> SVal)
-> (Cached SV -> Either CV (Cached SV)) -> Cached SV -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> SBV val) -> Cached SV -> SBV val
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
g
         ka :: Kind
ka = Proxy key -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @key)
         kb :: Kind
kb = Proxy val -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val)
         g :: State -> IO SV
g State
st = do SV
f <- State -> SArray key val -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SArray key val
array
                   SV
k <- State -> SBV key -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV key
key
                   State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
kb (Op -> [SV] -> SBVExpr
SBVApp Op
ReadArray [SV
f, SV
k])

-- | Writing a value to an array. For the concrete case, we don't bother deleting earlier entries, we keep a history. The earlier a value is in the list, the "later" it happened; in a stack fashion.
writeArray :: forall key val. (HasKind key, SymVal key, SymVal val, HasKind val) => SArray key val -> SBV key -> SBV val -> SArray key val
writeArray :: forall key val.
(HasKind key, SymVal key, SymVal val, HasKind val) =>
SArray key val -> SBV key -> SBV val -> SArray key val
writeArray SArray key val
array SBV key
key SBV val
value
   | Just (ArrayModel [(key, val)]
tbl val
def) <- SArray key val -> Maybe (ArrayModel key val)
forall a. SymVal a => SBV a -> Maybe a
unliteral SArray key val
array, Just key
keyVal <- SBV key -> Maybe key
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV key
key, Just val
val <- SBV val -> Maybe val
forall a. SymVal a => SBV a -> Maybe a
unliteral SBV val
value
   = ArrayModel key val -> SArray key val
forall a. SymVal a => a -> SBV a
literal (ArrayModel key val -> SArray key val)
-> ArrayModel key val -> SArray key val
forall a b. (a -> b) -> a -> b
$ [(key, val)] -> val -> ArrayModel key val
forall a b. [(a, b)] -> b -> ArrayModel a b
ArrayModel ((key
keyVal, val
val) (key, val) -> [(key, val)] -> [(key, val)]
forall a. a -> [a] -> [a]
: [(key, val)]
tbl) val
def  -- It's important that we "cons" the value here, since it takes precedence in a read
   | Bool
True
   = SVal -> SArray key val
forall a. SVal -> SBV a
SBV (SVal -> SArray key val)
-> (Cached SV -> SVal) -> Cached SV -> SArray key val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> (Cached SV -> Either CV (Cached SV)) -> Cached SV -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> SArray key val) -> Cached SV -> SArray key val
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
g
   where k :: Kind
k  = Kind -> Kind -> Kind
KArray (Proxy key -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @key)) (Proxy val -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @val))

         g :: State -> IO SV
g State
st = do SV
arr    <- State -> SArray key val -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SArray key val
array
                   SV
keyVal <- State -> SBV key -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV key
key
                   SV
val    <- State -> SBV val -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st SBV val
value
                   State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp Op
WriteArray [SV
arr, SV
keyVal, SV
val])

-- | Using a lambda as an array.
lambdaArray :: forall a b. (SymVal a, HasKind b) => (SBV a -> SBV b) -> SArray a b
lambdaArray :: forall a b. (SymVal a, HasKind b) => (SBV a -> SBV b) -> SArray a b
lambdaArray SBV a -> SBV b
f = SVal -> SBV (ArrayModel a b)
forall a. SVal -> SBV a
SBV (SVal -> SBV (ArrayModel a b))
-> (Cached SV -> SVal) -> Cached SV -> SBV (ArrayModel a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Kind -> Either CV (Cached SV) -> SVal
SVal Kind
k (Either CV (Cached SV) -> SVal)
-> (Cached SV -> Either CV (Cached SV)) -> Cached SV -> SVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> SBV (ArrayModel a b))
-> Cached SV -> SBV (ArrayModel a b)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
g
  where k :: Kind
k = Kind -> Kind -> Kind
KArray (Proxy a -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)) (Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b))

        g :: State -> IO SV
g State
st = do SMTLambda
def <- State -> LambdaScope -> Kind -> (SBV a -> SBV b) -> IO SMTLambda
forall (m :: * -> *) a.
(MonadIO m, Lambda (SymbolicT m) a) =>
State -> LambdaScope -> Kind -> a -> m SMTLambda
lambdaStr State
st LambdaScope
TopLevel (Proxy b -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @b)) SBV a -> SBV b
f
                  State -> Kind -> SBVExpr -> IO SV
newExpr State
st Kind
k (Op -> [SV] -> SBVExpr
SBVApp (SMTLambda -> Op
ArrayLambda SMTLambda
def) [])

-- | Turn a constant association-list and a default into a symbolic array.
listArray :: (SymVal a, SymVal b) => [(a, b)] -> b -> SArray a b
listArray :: forall a b. (SymVal a, SymVal b) => [(a, b)] -> b -> SArray a b
listArray [(a, b)]
ascs b
def = ArrayModel a b -> SBV (ArrayModel a b)
forall a. SymVal a => a -> SBV a
literal (ArrayModel a b -> SBV (ArrayModel a b))
-> ArrayModel a b -> SBV (ArrayModel a b)
forall a b. (a -> b) -> a -> b
$ [(a, b)] -> b -> ArrayModel a b
forall a b. [(a, b)] -> b -> ArrayModel a b
ArrayModel [(a, b)]
ascs b
def

-- | Create a closure, wrapping the free variables together with the function. When using higher-order functions
-- in SBV (like map), the function passed must be closed, i.e., not have any free variables. If you need to call
-- such a function with a function capturing a free variable, you should create a closure instead.
data Closure env a = Closure { forall env a. Closure env a -> env
closureEnv :: env
                             , forall env a. Closure env a -> env -> a
closureFun :: env -> a
                             }

-- | Define a higher-order function. Similar to 'smtFunction', but when we have a higher-order argument. Note that
-- the higher-order argument cannot have free variables. Also, if the function is recursive, you should call
-- the first argument of the defining function, which SBV uses to tie the recursive knot. (Note that recursive
-- functions defined via 'smtFunction' don't have this latter requirement as they can figure out the recursion
-- automatically. Higher-order functions, unfortunately, can't do this: They firstify their high-order argument,
-- giving the whole function a unique name; captured via the call to the recursive definition.)
smtHOFunction :: forall a b f.
                 ( SMTDefinable (a -> SBV b)
                 , Lambda Symbolic f
                 , Lambda Symbolic (a -> SBV b)
                 , HasKind b
                 , HasKind f
                 , Typeable a
                 , Typeable b
                 , Typeable f
                 ) => String       -- prefix to use
                   -> f            -- The higher-order argument. We're very generic here!
                   -> (a -> SBV b) -- The ho-function we're modeling
                   ->  a -> SBV b  -- The resulting function, that can be used as is, and will be rendered in SMTLib without unfolding
smtHOFunction :: forall a b f.
(SMTDefinable (a -> SBV b), Lambda (SymbolicT IO) f,
 Lambda (SymbolicT IO) (a -> SBV b), HasKind b, HasKind f,
 Typeable a, Typeable b, Typeable f) =>
String -> f -> (a -> SBV b) -> a -> SBV b
smtHOFunction String
nm f
f a -> SBV b
hof a
arg = SVal -> SBV b
forall a. SVal -> SBV a
SBV (SVal -> SBV b) -> SVal -> SBV b
forall a b. (a -> b) -> a -> b
$ Kind -> Either CV (Cached SV) -> SVal
SVal (Proxy (SBV b) -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SBV b))) (Either CV (Cached SV) -> SVal) -> Either CV (Cached SV) -> SVal
forall a b. (a -> b) -> a -> b
$ Cached SV -> Either CV (Cached SV)
forall a b. b -> Either a b
Right (Cached SV -> Either CV (Cached SV))
-> Cached SV -> Either CV (Cached SV)
forall a b. (a -> b) -> a -> b
$ (State -> IO SV) -> Cached SV
forall a. (State -> IO a) -> Cached a
cache State -> IO SV
r
  where r :: State -> IO SV
r State
st = do SMTLambda String
lam <- State -> LambdaScope -> Kind -> f -> IO SMTLambda
forall (m :: * -> *) a.
(MonadIO m, Lambda (SymbolicT m) a) =>
State -> LambdaScope -> Kind -> a -> m SMTLambda
lambdaStr State
st LambdaScope
HigherOrderArg (Kind -> Kind
resKindOf (Proxy f -> Kind
forall a. HasKind a => a -> Kind
kindOf (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f))) f
f
                  let uniqLen :: Int
uniqLen = SMTConfig -> Int
firstifyUniqueLen (SMTConfig -> Int) -> SMTConfig -> Int
forall a b. (a -> b) -> a -> b
$ State -> SMTConfig
stCfg State
st
                      uniq :: String
uniq    = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
uniqLen (ByteString -> String
BC.unpack (ByteString -> ByteString
B.encode (ByteString -> ByteString
hash (String -> ByteString
BC.pack ([String] -> String
unwords (String -> [String]
words String
lam))))))
                  State -> SBV b -> IO SV
forall a. State -> SBV a -> IO SV
sbvToSV State
st (String -> (a -> SBV b) -> a -> SBV b
forall a.
(SMTDefinable a, Typeable a, Lambda (SymbolicT IO) a) =>
String -> a -> a
smtFunction (Proxy f -> String -> String
forall a. Typeable a => Proxy a -> String -> String
atProxy (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @f) String
nm String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
uniq) a -> SBV b
hof a
arg)

        -- we get the functions as arrays here, so chase to find the result
        resKindOf :: Kind -> Kind
resKindOf (KArray Kind
_ Kind
k) = Kind -> Kind
resKindOf Kind
k
        resKindOf Kind
k            = Kind
k

{- HLint ignore module "Reduce duplication"   -}
{- HLint ignore module "Eta reduce"           -}
{- HLint ignore module "Avoid NonEmpty.unzip" -}
{- HLint ignore module "Redundant id"         -}