packages feed

sbv 7.13 → 8.0

raw patch · 394 files changed

+10642/−6686 lines, 394 filesdep +transformerssetup-changed

Dependencies added: transformers

Files

CHANGES.md view
@@ -1,8 +1,118 @@ * Hackage: <http://hackage.haskell.org/package/sbv> * GitHub:  <http://leventerkok.github.com/sbv/> -* Latest Hackage released version: 7.13, 2018-12-16+* Latest Hackage released version: 8.0, 2019-01-14 +### Version 8.0, 2019-01-14++  * This is a major release of SBV, with several BACKWARDS COMPATIBILITY breaking+    changes. Lots of reworking of the internals to modernize the SBV code base.+    A few external API changes happened as well, mainly in terms of renamed+    types/operators to reflect the current state of things. I expect most end user+    programs to carry over unchanged, perhaps needing a bunch of renames. See below+    for details.++  * Transformer stack and `SymbolicT`: This major internal revamping was contributed+    by Brian Schroeder. Brian reworked the internals of SBV to allow for custom monad+    stacks. In particular, there is now a `SymbolicT` monad transformer, which+    generalizes the `Symbolic` monad over an arbitrary base type, allowing users to+    build SBV based symbolic execution engines on top of their own monad infrastructure.++    Brian took the pains to ensure existing users (or those who do not have their+    own monad stack), the transformer capabilities remain transparent. That is,+    your existing code should recompile as is, or perhaps with minor aesthetic+    changes. Please report if you find otherwise, or need help.++    See `Documentation.SBV.Examples.Transformers.SymbolicEval` for an example of+    how to use the transformer based code.++    Thanks to Brian Schroeder for this massive effort to modernize the SBV code-base!++  * Support for tuples: Thanks to Joel Burget, SBV now supports tuple types (up-to+    8-tuples), and allows mixing and matching of lists and tuples arbitrarily+    as symbolic values. For instance `SBV [(Integer, String)]` is a valid type as+    is `SBV [(Integer, [(Char, (Float, String))])]`, with each component symbolically+    represented. There are new type synonyms for `STupleN` for `N` between 2 to 8,+    along with `untuple` destructor, and field accessors similar to lens: For instance+    `p^._4` would project the 4th element of a tuple that has at least 4 fields.+    The mixing and matching of field types and nesting allows for very rich+    symbolic value representations. See `Documentation.SBV.Examples.Misc.Tuple` for+    an example.++  * [BACKWARDS COMPATIBILITY] The `Boolean` class is removed, which used to abstract+    over logical connectives. Previously, this class handled 'SBool' and 'Bool', but+    the generality was hardly ever used and caused typing ambiguities. The new+    implementation simplifies boolean operators to simply operate on the `SBool`+    type. Also changed the operator names to fit with all the others by starting+    them with dots. A simple conversion guide:++        * Literal True : true    became   sTrue+        * Literal False: false   became   sFalse+        * Negation     : bNot    became   sNot+        * Conjunction  : &&&     became   .&&+        * Disjunction  : |||     became   .||+        * XOr          : <+>     became   .<+>+        * Nand         : ~&      became   .~&+        * Nor          : ~|      became   .~|+        * Implication  : ==>     became   .=>+        * Iff          : <=>     became   .<=>+        * Aggregate and: bAnd    became   sAnd+        * Aggregate or : bOr     became   sOr+        * Existential  : bAny    became   sAny+        * Universal    : bAll    became   sAll++  * [BACKWARDS COMPATIBILITY, INTERNAL] Hostorically, SBV focused on bit-vectors and machine+    words, which meant lots of internal types were named suggestive of this heritage.+    With the addition of `SInteger`, `SReal`, `SFloat`, `SDouble` we have expanded+    this, but still remained focused on atomic types. But, thanks largely to+    Joel Burget, SBV now supports symbolic characters, strings, lists, and now+    tuples, and nested tuples/lists, which makes this word-oriented naming confusing.+    To reflect, we made the following internal renamings:++        * SymWord     became      SymVal+        * SW          became      SV+        * CW          became      CV+        * CWVal       became      CVal++    Along with these, many of the internal constructor/variable names also changed in+    a similar fashion.++    For most casual users, these changes should not require any changes. But if you were+    developing libraries on top of SBV, then you will have to adapt to the new schema.+    Please report if there are any gotchas we have forgotten about.++  * [BACKWARDS COMPATIBILITY] When user queries are present, SBV now picks the logic+    "ALL" (as opposed to a suitable variant of bit-vectors as in the past versions).+    This can be overridden by the 'setLogic' command as usual of course. While the new+    choice breaks backwards compatibility, I expect the impact will be minimal, and+    the new behavior matches better with user expectations on how external queries are+    usually employed.++  * [BACKWARDS COMPATIBILITY] Renamed the module `Data.SBV.List.Bounded` to+    `Data.SBV.Tools.BoundedList`.++  * Introduced a `Queriable` class, which simplifies symbolic programming with composite+    user types. See `Documentation.SBV.Examples.ProofTools` directory for several+    use cases and examples.++  * Added function `observeIf`, companion to `observe`. Allows observing of values+    if they satisfy a given predicate.++  * Added function `ensureSat`, which makes sure the solver context is satisfiable+    when called in the query mode. If not, an error will be thrown. Simplifies+    programming when we expect a satisfiable result and want to bail out if otherwise.++  * Added `nil` to `Data.SBV.List`. Added `nil` and `uncons` to `Data.SBV.String`.+    These were inadvertently left out previously.++  * Add `Data.SBV.Tools.BMC` module, which provides a BMC (bounded-model+    checking engine) for traditional state transition systems. See+    `Documentation.SBV.Examples.ProofTools.BMC` for example uses.++  * Add `Data.SBV.Tools.Induction` module, which provides an induction engine+    for traditional state transition systems. Also added several example use+    cases in the directory `Documentation.SBV.Examples.ProofTools`.+ ### Version 7.13, 2018-12-16    * Generalize the types of `bminimum` and `bmaximum` by removing the `Num`@@ -44,7 +154,7 @@     in this range and have issues.)    * Improve the BoundedMutex example to show a non-fair trace.-    See "Documentation/SBV/Examples/Lists/BoundedMutex.hs".+    See `Documentation/SBV/Examples/Lists/BoundedMutex.hs`.    * Improve Haddock documentation links throughout. @@ -55,14 +165,14 @@     This is building on top of Joel Burget's initial work for supporting symbolic     strings and sequences, as supported by Z3. Note that the list theory solvers     are incomplete, so some queries might receive an unknown answer. See-    "Documentation/SBV/Examples/Lists/Fibonacci.hs" for an example, and the-    module "Data.SBV.List" for details.+    `Documentation/SBV/Examples/Lists/Fibonacci.hs` for an example, and the+    module `Data.SBV.List` for details. -  * A new module 'Data.SBV.List.Bounded' provides extra functions to manipulate+  * A new module `Data.SBV.List.Bounded` provides extra functions to manipulate     lists with given concrete bounds. Note that SMT solvers cannot deal with     recursive functions/inductive proofs in general, so the utilities in this     file can come in handy when expressing bounded-model-checking style-    algorithms. See "Documentation/SBV/Examples/Lists/BoundedMutex.hs" for a+    algorithms. See `Documentation/SBV/Examples/Lists/BoundedMutex.hs` for a     simple mutex algorithm proof.    * Remove dependency on data-binary-ieee754 package; which is no longer@@ -97,12 +207,12 @@     better reflects the nature of this function. Also add extra checks to warn     the user if optimization constraints are present in a regular sat/prove call. -  * Implement 'softConstrain': Similar to 'constrain', except the solver is+  * Implement `softConstrain`: Similar to 'constrain', except the solver is     free to leave it unsatisfied (i.e., leave it false) if necessary to     find a satisfying solution. Useful in modeling conditions that are     "nice-to-have" but not "required." Note that this is similar to     'assertWithPenalty', except it works in non-optimization contexts.-    See "Documentation.SBV.Examples.Misc.SoftConstrain" for a simple example.+    See `Documentation.SBV.Examples.Misc.SoftConstrain` for a simple example.    * Add 'CheckedArithmetic' class, which provides bit-vector arithmetic     operations that do automatic underflow/overflow checking. The operations@@ -115,7 +225,7 @@   * Similar to above, add 'sFromIntegralChecked', providing overflow/underflow     checks for cast operations. -  * Add "Documentation.SBV.Examples.BitPrecise.BrokenSearch" module to show the+  * Add `Documentation.SBV.Examples.BitPrecise.BrokenSearch` module to show the     use of overflow checking utilities, using the classic broken binary search     example from http://ai.googleblog.com/2006/06/extra-extra-read-all-about-it-nearly.html @@ -162,7 +272,7 @@     both signed and unsigned bit-vector values. The implementation is based on     http://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/z3prefix.pdf,     and can be used to detect overflow caused bugs in machine arithmetic.-    See "Data.SBV.Tools.Overflow" for details.+    See `Data.SBV.Tools.Overflow` for details.    * Add 'sFromIntegralO', which is the overflow/underflow detecting variant     of 'sFromIntegral'. This function returns (along with the converted@@ -208,7 +318,7 @@     -min_value as a valid literal!  Instead we use the macros provided in     stdint.h. Thanks to Matt Peddie for reporting this corner case. -  * Fix translation of the "abs" function in C code generation, making+  * Fix translation of the `abs` function in C code generation, making     sure we use the correct variant. Thanks to Matt Peddie for reporting.    * Fix handling of tables and arrays in pushed-contexts. Previously,@@ -444,7 +554,7 @@     The motivation is to allow the end-users to send/receive arbitrary SMTLib     commands to the solver, instead of the cooked-up recipes. SBV still provides     all the recipes for its existing functionality, but users can now interact-    with the solver directly. See the module "Data.SBV.Control" for the main+    with the solver directly. See the module `Data.SBV.Control` for the main     API, together with the new functions 'runSMT' and 'runSMTWith'.    * The 'Tactic' based solver control (introduced in v6.0) is completely removed, and@@ -482,7 +592,7 @@     is an infinite number of them.    * Extraction of unsat-cores has changed. To use this feature, we now use-    custom queries. See "Data.SBV.Examples.Misc.UnsatCore" for an example.+    custom queries. See `Data.SBV.Examples.Misc.UnsatCore` for an example.     Old style of unsat-core extraction is no longer supported.    * The 'timing' option of SMTConfig has been reworked. Since we now start the@@ -531,7 +641,7 @@     and has an accurate account of precisely what SBV sent.    * Enumerations are now much easier to use symbolically, with the addition-    of the template-haskell splice mkSymbolicEnumeration. See "Data/SBV/Examples/Misc/Enumerate.hs"+    of the template-haskell splice mkSymbolicEnumeration. See `Data/SBV/Examples/Misc/Enumerate.hs`     for an example.    * Thanks to Kanishka Azimi, our external test suite is now run by@@ -808,7 +918,7 @@     to take into account certain variables from a model-building     perspective. This comes handy in doing an `allSat` calls where     there might be witness variables that we do not care the uniqueness-    for. See "Data/SBV/Examples/Misc/Auxiliary.hs" for an example, and+    for. See `Data/SBV/Examples/Misc/Auxiliary.hs` for an example, and     the discussion in https://github.com/LeventErkok/sbv/issues/208 for     motivation. @@ -951,12 +1061,12 @@     used, and required a very old version of Yices that was no longer supported by SRI and has     lacked in other features. So, in reality this change should hardly matter for end-users. -  * Added function "label", which is useful in emitting comments around expressions. It is essentially+  * Added function `label`, which is useful in emitting comments around expressions. It is essentially     a no-op, but does generate a comment with the given text in the SMT-Lib and C output, for diagnostic     purposes. -  * Added "sFromIntegral": Conversions from all integral types (SInteger, SWord/SInts) between-    each other. Similar to the "fromIntegral" function of Haskell. These generate simple casts when+  * Added `sFromIntegral`: Conversions from all integral types (SInteger, SWord/SInts) between+    each other. Similar to the `fromIntegral` function of Haskell. These generate simple casts when     used in code-generation to C, and thus are very efficient.    * SBV no longer supports the functions sBranch/sAssert, as we realized these functions can cause@@ -1091,7 +1201,7 @@   * Introduce Data.SBV.Dynamic, by Brian Huffman. This is mostly an internal     reorg of the SBV codebase, and end-users should not be impacted by the     changes. The introduction of the Dynamic SBV variant (i.e., one that does-    not mandate a phantom type as in "SBV Word8" etc. allows library writers+    not mandate a phantom type as in `SBV Word8` etc. allows library writers     more flexibility as they deal with arbitrary bit-vector sizes. The main     customer of these changes are the Cryptol language and the associated     toolset, but other developers building on top of SBV can find it useful@@ -1179,7 +1289,7 @@    * Allow Floating-Point RoundingMode to be symbolic as well -  * Improve the example "Data/SBV/Examples/Misc/Floating.hs" to include+  * Improve the example `Data/SBV/Examples/Misc/Floating.hs` to include     rounding-mode based addition example.    * Changes required to make SBV compile with GHC 7.10; mostly around instance@@ -1199,8 +1309,8 @@    * Modifications to support arbitrary bit-sized vectors;     These changes have been contributed by Brian Huffman-    of Galois.. Thanks Brian.-  * A new example "Data/SBV/Examples/Misc/Word4.hs" showing+    of Galois. Thanks Brian.+  * A new example `Data/SBV/Examples/Misc/Word4.hs` showing     how users can add new symbolic types.   * Support for rotate-left/rotate-right with variable     rotation amounts. (From Brian Huffman.)@@ -1328,7 +1438,7 @@        to Philipp Meyer for the fine report.  * Misc:      * Add missing SFloat/SDouble instances for SatModel class-     * Explicitly support KBool as a kind, separating it from "KUnbounded False 1".+     * Explicitly support KBool as a kind, separating it from `KUnbounded False 1`.        Thanks to Brian Huffman for contributing the changes. This should have no        user-visible impact, but comes in handy for internal reasons. 
@@ -1,4 +1,4 @@-Copyright (c) 2010-2018, Levent Erkok (erkokl@gmail.com)+Copyright (c) 2010-2019, Levent Erkok (erkokl@gmail.com) All rights reserved.  The sbv library is distributed with the BSD3 license. See the LICENSE file
Data/SBV.hs view
@@ -1,10 +1,10 @@----------------------------------------------------------------------------------+----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- (The sbv library is hosted at <http://github.com/LeventErkok/sbv>. -- Comments, bug reports, and patches are always welcome.)@@ -110,14 +110,7 @@ -- -- Support for other compliant solvers can be added relatively easily, please -- get in touch if there is a solver you'd like to see included.------------------------------------------------------------------------------------{-# LANGUAGE    FlexibleInstances   #-}-{-# LANGUAGE    QuasiQuotes         #-}-{-# LANGUAGE    TemplateHaskell     #-}-{-# LANGUAGE    ScopedTypeVariables #-}-{-# LANGUAGE    StandaloneDeriving  #-}-{-# OPTIONS_GHC -fno-warn-orphans  #-}+-----------------------------------------------------------------------------  module Data.SBV (   -- $progIntro@@ -125,11 +118,11 @@   -- * Symbolic types    -- ** Booleans-    SBool, oneIf-  -- *** The Boolean class-  , Boolean(..)-  -- *** Logical operations-  , bAnd, bOr, bAny, bAll+    SBool+  -- *** Boolean values and functions+  , sTrue, sFalse, sNot, (.&&), (.||), (.<+>), (.~&), (.~|), (.=>), (.<=>), fromBool, oneIf+  -- *** Logical aggregations+  , sAnd, sOr, sAny, sAll   -- ** Bit-vectors   -- *** Unsigned bit-vectors   , SWord8, SWord16, SWord32, SWord64@@ -150,17 +143,20 @@   -- ** Symbolic lists   -- $lists   , SList+  -- ** Tuples+  -- $tuples+  , STuple2, STuple3, STuple4, STuple5, STuple6, STuple7, STuple8   -- * Arrays of symbolic values-  , SymArray(newArray_, newArray, readArray, writeArray), SArray, SFunArray+  , SymArray(readArray, writeArray, mergeArrays), newArray_, newArray, SArray, SFunArray    -- * Creating symbolic values   -- ** Single value   -- $createSym-  , sBool, sWord8, sWord16, sWord32, sWord64, sInt8, sInt16, sInt32, sInt64, sInteger, sReal, sFloat, sDouble, sChar, sString, sList+  , sBool, sWord8, sWord16, sWord32, sWord64, sInt8, sInt16, sInt32, sInt64, sInteger, sReal, sFloat, sDouble, sChar, sString, sList, sTuple    -- ** List of values   -- $createSyms-  , sBools, sWord8s, sWord16s, sWord32s, sWord64s, sInt8s, sInt16s, sInt32s, sInt64s, sIntegers, sReals, sFloats, sDoubles, sChars, sStrings, sLists+  , sBools, sWord8s, sWord16s, sWord32s, sWord64s, sInt8s, sInt16s, sInt32s, sInt64s, sIntegers, sReals, sFloats, sDoubles, sChars, sStrings, sLists, sTuples    -- * Symbolic Equality and Comparisons   , EqSymbolic(..), OrdSymbolic(..), Equality(..)@@ -204,7 +200,13 @@   -- $proveIntro   -- $noteOnNestedQuantifiers   -- $multiIntro-  , Predicate, Goal, Provable(..), solve+  , Predicate, Goal+  , Provable, forAll_, forAll, forSome_, forSome, prove, proveWith, sat+  , satWith, allSat, allSatWith, optimize, optimizeWith, isVacuous+  , isVacuousWith, isTheorem, isTheoremWith, isSatisfiable, isSatisfiableWith+  , proveWithAll, proveWithAny, satWithAll+  , satWithAny, generateSMTBenchmark+  , solve   -- * Constraints   -- $constrainIntro   -- ** General constraints@@ -227,7 +229,7 @@    -- * Checking safety   -- $safeIntro-  , sAssert, isSafe, SExecutable(..)+  , sAssert, isSafe, SExecutable, sName_, sName, safe, safeWith    -- * Quick-checking   , sbvQuickCheck@@ -239,13 +241,14 @@   -- $multiOpt   , OptimizeStyle(..)   -- ** Objectives-  , Objective(..), Metric(..)+  , Objective(..)+  , Metric, minimize, maximize   -- ** Soft assertions   -- $softAssertions   , assertWithPenalty , Penalty(..)   -- ** Field extensions-  -- | If an optimization results in an infinity/epsilon value, the returned `CW` value will be in the corresponding extension field.-  , ExtCW(..), GeneralizedCW(..)+  -- | If an optimization results in an infinity/epsilon value, the returned `CV` value will be in the corresponding extension field.+  , ExtCV(..), GeneralizedCV(..)    -- * Model extraction   -- $modelExtraction@@ -256,7 +259,7 @@    -- ** Observing expressions   -- $observeInternal-  , observe+  , observe, observeIf    -- ** Programmable model extraction   -- $programmableExtraction@@ -277,8 +280,11 @@   , SBVException(..)    -- * Abstract SBV type-  , SBV, HasKind(..), Kind(..), SymWord(..)-  , Symbolic, label, output, runSMT, runSMTWith+  , SBV, HasKind(..), Kind(..)+  , SymVal, forall, forall_, mkForallVars, exists, exists_, mkExistVars, free+  , free_, mkFreeVars, symbolic, symbolics, literal, unliteral, fromCV+  , isConcrete, isSymbolic, isConcretely, mkSymVal+  , MonadSymbolic(..), Symbolic, SymbolicT, label, output, runSMT, runSMTWith    -- * Module exports   -- $moduleExportIntro@@ -289,136 +295,47 @@   , module Data.Ratio   ) where -import Control.Monad (filterM)--import qualified Control.Exception as C- import Data.SBV.Core.AlgReals-import Data.SBV.Core.Data-import Data.SBV.Core.Model+import Data.SBV.Core.Data       hiding (addAxiom, forall, forall_,+                                        mkForallVars, exists, exists_,+                                        mkExistVars, free, free_, mkFreeVars,+                                        output, symbolic, symbolics, mkSymVal,+                                        newArray, newArray_)+import Data.SBV.Core.Model      hiding (assertWithPenalty, minimize, maximize,+                                        forall, forall_, exists, exists_,+                                        solve, sBool, sBools, sChar, sChars,+                                        sDouble, sDoubles, sFloat, sFloats,+                                        sInt8, sInt8s, sInt16, sInt16s, sInt32, sInt32s,+                                        sInt64, sInt64s, sInteger, sIntegers,+                                        sList, sLists, sTuple, sTuples,+                                        sReal, sReals, sString, sStrings,+                                        sWord8, sWord8s, sWord16, sWord16s,+                                        sWord32, sWord32s, sWord64, sWord64s) import Data.SBV.Core.Floating import Data.SBV.Core.Splittable+import Data.SBV.Core.Symbolic   (MonadSymbolic(..), SymbolicT) -import Data.SBV.Provers.Prover+import Data.SBV.Provers.Prover hiding (forAll_, forAll, forSome_, forSome,+                                       prove, proveWith, sat, satWith, allSat,+                                       allSatWith, optimize, optimizeWith,+                                       isVacuous, isVacuousWith, isTheorem,+                                       isTheoremWith, isSatisfiable,+                                       isSatisfiableWith, runSMT, runSMTWith,+                                       sName_, sName, safe, safeWith) -import Data.SBV.Utils.Boolean-import Data.SBV.Utils.TDiff   (Timing(..))+import Data.SBV.Client+import Data.SBV.Client.BaseIO +import Data.SBV.Utils.TDiff (Timing(..))+ import Data.Bits import Data.Int import Data.Ratio import Data.Word -import qualified Language.Haskell.TH as TH-import Data.Generics- import Data.SBV.SMT.Utils (SBVException(..))-import Data.SBV.Control.Utils (SMTValue (..)) import Data.SBV.Control.Types (SMTReasonUnknown(..), Logic(..)) --- | Form the symbolic conjunction of a given list of boolean conditions. Useful in expressing--- problems with constraints, like the following:------ @---   sat $ do [x, y, z] <- sIntegers [\"x\", \"y\", \"z\"]---            solve [x .> 5, y + z .< x]--- @-solve :: [SBool] -> Symbolic SBool-solve = return . bAnd---- | Check whether the given solver is installed and is ready to go. This call does a--- simple call to the solver to ensure all is well.-sbvCheckSolverInstallation :: SMTConfig -> IO Bool-sbvCheckSolverInstallation cfg = check `C.catch` (\(_ :: C.SomeException) -> return False)-  where check = do ThmResult r <- proveWith cfg $ \x -> (x+x) .== ((x*2) :: SWord8)-                   case r of-                     Unsatisfiable{} -> return True-                     _               -> return False---- | The default configs corresponding to supported SMT solvers-defaultSolverConfig :: Solver -> SMTConfig-defaultSolverConfig Z3        = z3-defaultSolverConfig Yices     = yices-defaultSolverConfig Boolector = boolector-defaultSolverConfig CVC4      = cvc4-defaultSolverConfig MathSAT   = mathSAT-defaultSolverConfig ABC       = abc---- | Return the known available solver configs, installed on your machine.-sbvAvailableSolvers :: IO [SMTConfig]-sbvAvailableSolvers = filterM sbvCheckSolverInstallation (map defaultSolverConfig [minBound .. maxBound])---- If we get a program producing nothing (i.e., Symbolic ()), pretend it simply returns True.--- This is useful since min/max calls and constraints will provide the context-instance Provable Goal where-  forAll_    a = forAll_    ((a >> return true) :: Predicate)-  forAll ns  a = forAll ns  ((a >> return true) :: Predicate)-  forSome_   a = forSome_   ((a >> return true) :: Predicate)-  forSome ns a = forSome ns ((a >> return true) :: Predicate)---- | 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 #-} (SymWord a, EqSymbolic z) => Equality (SBV a -> z) where-  k === l = prove $ \a -> k a .== l a--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, EqSymbolic z) => Equality (SBV a -> SBV b -> z) where-  k === l = prove $ \a b -> k a b .== l a b--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, EqSymbolic z) => Equality ((SBV a, SBV b) -> z) where-  k === l = prove $ \a b -> k (a, b) .== l (a, b)--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, SymWord c, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> z) where-  k === l = prove $ \a b c -> k a b c .== l a b c--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, SymWord c, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c) -> z) where-  k === l = prove $ \a b c -> k (a, b, c) .== l (a, b, c)--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, SymWord c, SymWord d, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> z) where-  k === l = prove $ \a b c d -> k a b c d .== l a b c d--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, SymWord c, SymWord d, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d) -> z) where-  k === l = prove $ \a b c d -> k (a, b, c, d) .== l (a, b, c, d)--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> z) where-  k === l = prove $ \a b c d e -> k a b c d e .== l a b c d e--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d, SBV e) -> z) where-  k === l = prove $ \a b c d e -> k (a, b, c, d, e) .== l (a, b, c, d, e)--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, SymWord f, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> z) where-  k === l = prove $ \a b c d e f -> k a b c d e f .== l a b c d e f--instance {-# OVERLAPPABLE #-}- (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, SymWord f, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> z) where-  k === l = prove $ \a b c d e f -> k (a, b, c, d, e, f) .== l (a, b, c, d, e, f)--instance {-# OVERLAPPABLE #-}- (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, SymWord f, SymWord g, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> SBV e -> SBV f -> SBV g -> z) where-  k === l = prove $ \a b c d e f g -> k a b c d e f g .== l a b c d e f g--instance {-# OVERLAPPABLE #-} (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, SymWord f, SymWord g, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> z) where-  k === l = prove $ \a b c d e f g -> k (a, b, c, d, e, f, g) .== l (a, b, c, d, e, f, g)---- | Make an enumeration a symbolic type.-mkSymbolicEnumeration :: TH.Name -> TH.Q [TH.Dec]-mkSymbolicEnumeration typeName = do-    let typeCon = TH.conT typeName-    [d| deriving instance Eq       $(typeCon)-        deriving instance Show     $(typeCon)-        deriving instance Ord      $(typeCon)-        deriving instance Read     $(typeCon)-        deriving instance Data     $(typeCon)-        deriving instance SymWord  $(typeCon)-        deriving instance HasKind  $(typeCon)-        deriving instance SMTValue $(typeCon)-        deriving instance SatModel $(typeCon)-      |]- -- Haddock section documentation {- $progIntro The SBV library is really two things:@@ -501,8 +418,8 @@  >>> safe (sub :: SInt8 -> SInt8 -> SInt8) [sub: x >= y must hold!: Violated. Model:-  s0 = 6 :: Int8-  s1 = 8 :: Int8]+  s0 = 0 :: Int8+  s1 = 1 :: Int8]  What happens if we make sure to arrange for this invariant? Consider this version: @@ -730,6 +647,10 @@ See "Data.SBV.List" for related functions. -} +{- $tuples+Tuples can be used as symbolic values. This is useful in combination with lists, for example @SBV [(Integer, String)]@ is a valid type. These types can be arbitrarily nested, eg @SBV [(Integer, [(Char, (Integer, String))])]@. Instances of upto 8-tuples are provided.+-}+ {- $shiftRotate Symbolic words (both signed and unsigned) are an instance of Haskell's 'Bits' class, so regular bitwise operations are automatically available for them. Shifts and rotates, however, require@@ -800,7 +721,7 @@  Also note that this semantics imply that test case generation ('Data.SBV.Tools.GenTest.genTest') and quick-check can take arbitrarily long in the presence of constraints, if the random input values generated-rarely satisfy the constraints. (As an extreme case, consider @'constrain' 'false'@.)+rarely satisfy the constraints. (As an extreme case, consider @'constrain' 'sFalse'@.) -}  {- $constraintVacuity@@ -864,7 +785,7 @@ following example demonstrates:    @-     data B = B () deriving (Eq, Ord, Show, Read, Data, SymWord, HasKind, SatModel)+     data B = B () deriving (Eq, Ord, Show, Read, Data, SymVal, HasKind, SatModel)   @  (Note that you'll also need to use the language pragmas @DeriveDataTypeable@, @DeriveAnyClass@, and import @Data.Generics@ for the above to work.)@@ -960,7 +881,7 @@     > sum (map (\b -> ite b 1 0) [b0, b1, b2, b3]) .<= 2 -and they both express that at most /two/ of @b0@, @b1@, @b2@, and @b3@ can be 'true'.+and they both express that at most /two/ of @b0@, @b1@, @b2@, and @b3@ can be 'sTrue'. However, the equivalent forms give rise to long formulas and the cardinality constraint can get lost in the translation. The idea here is that if you use these functions instead, SBV will produce better translations to SMTLib for more efficient solving of cardinality constraints, assuming@@ -992,16 +913,19 @@            a2 <- free "i2"            let spec, res :: SWord8                spec = a1 + a2-               res  = ite (a1 .== 12 &&& a2 .== 22)   -- insert a malicious bug!+               res  = ite (a1 .== 12 .&& a2 .== 22)   -- insert a malicious bug!                           1                           (a1 + a2)            return $ observe "Expected" spec .== observe "Result" res :} Falsifiable. Counter-example:-  i1       = 12 :: Word8-  i2       = 22 :: Word8   Expected = 34 :: Word8   Result   =  1 :: Word8+  i1       = 12 :: Word8+  i2       = 22 :: Word8++The 'observeIf' variant allows the user to specify a boolean condition when the value is interesting to observe. Useful when+you have lots of "debugging" points, but not all are of interest. -}  {-# ANN module ("HLint: ignore Use import/export shortcut" :: String) #-}
Data/SBV/Char.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Char--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Char+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A collection of character utilities, follows the namings -- in "Data.Char" and is intended to be imported qualified.@@ -20,9 +20,9 @@ -- For details, see: <http://smtlib.cs.uiowa.edu/theories-UnicodeStrings.shtml> ----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE Rank2Types          #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings   #-}  module Data.SBV.Char (         -- * Occurrence in a string@@ -44,7 +44,6 @@  import Data.SBV.Core.Data import Data.SBV.Core.Model-import Data.SBV.Utils.Boolean  import qualified Data.Char as C @@ -61,23 +60,23 @@ -- >>> :set -XOverloadedStrings -- >>> prove $ \c -> c `elem` singleton c -- Q.E.D.--- >>> prove $ \c -> bnot (c `elem` "")+-- >>> prove $ \c -> sNot (c `elem` "") -- Q.E.D. elem :: SChar -> SString -> SBool c `elem` s  | Just cs <- unliteral s, Just cc <- unliteral c  = literal (cc `P.elem` cs)  | Just cs <- unliteral s                            -- If only the second string is concrete, element-wise checking is still much better!- = bAny (c .==) $ map literal cs+ = sAny (c .==) $ map literal cs  | True  = singleton c `isInfixOf` s  -- | Is the character not in the string? ----- >>> prove $ \c s -> c `elem` s <=> bnot (c `notElem` s)+-- >>> prove $ \c s -> c `elem` s .<=> sNot (c `notElem` s) -- Q.E.D. notElem :: SChar -> SString -> SBool-c `notElem` s = bnot (c `elem` s)+c `notElem` s = sNot (c `elem` s)  -- | The 'ord' of a character. ord :: SChar -> SInteger@@ -88,12 +87,12 @@  = SBV $ SVal kTo $ Right $ cache r  where kFrom = KBounded False 8        kTo   = KUnbounded-       r st = do csw <- sbvToSW st c-                 newExpr st kTo (SBVApp (KindCast kFrom kTo) [csw])+       r st = do csv <- sbvToSV st c+                 newExpr st kTo (SBVApp (KindCast kFrom kTo) [csv])  -- | Conversion from an integer to a character. ----- >>> prove $ \x -> 0 .<= x &&& x .< 256 ==> ord (chr x) .== x+-- >>> prove $ \x -> 0 .<= x .&& x .< 256 .=> ord (chr x) .== x -- Q.E.D. -- >>> prove $ \x -> chr (ord x) .== x -- Q.E.D.@@ -105,14 +104,14 @@  = SBV $ SVal KChar $ Right $ cache r  where w8 :: SWord8        w8 = sFromIntegral w-       r st = do SW _ n <- sbvToSW st w8-                 return $ SW KChar n+       r st = do SV _ n <- sbvToSV st w8+                 return $ SV KChar n  -- | Convert to lower-case. -- -- >>> prove $ \c -> toLower (toLower c) .== toLower c -- Q.E.D.--- >>> prove $ \c -> isLower c ==> toLower (toUpper c) .== c+-- >>> prove $ \c -> isLower c .=> toLower (toUpper c) .== c -- Q.E.D. toLower :: SChar -> SChar toLower c = ite (isUpper c) (chr (ord c + 32)) c@@ -131,17 +130,17 @@ -- -- >>> prove $ \c -> toUpper (toUpper c) .== toUpper c -- Q.E.D.--- >>> prove $ \c -> isUpper c ==> toUpper (toLower c) .== c+-- >>> prove $ \c -> isUpper c .=> toUpper (toLower c) .== c -- Q.E.D. toUpper :: SChar -> SChar-toUpper c = ite (isLower c &&& c `notElem` "\181\223\255") (chr (ord c - 32)) c+toUpper c = ite (isLower c .&& c `notElem` "\181\223\255") (chr (ord c - 32)) c  -- | Convert a digit to an integer. Works for hexadecimal digits too. If the input isn't a digit, -- then return -1. ----- >>> prove $ \c -> isDigit c ||| isHexDigit c ==> digitToInt c .>= 0 &&& digitToInt c .<= 15+-- >>> prove $ \c -> isDigit c .|| isHexDigit c .=> digitToInt c .>= 0 .&& digitToInt c .<= 15 -- Q.E.D.--- >>> prove $ \c -> bnot (isDigit c ||| isHexDigit c) ==> digitToInt c .== -1+-- >>> prove $ \c -> sNot (isDigit c .|| isHexDigit c) .=> digitToInt c .== -1 -- Q.E.D. digitToInt :: SChar -> SInteger digitToInt c = ite (uc `elem` "0123456789") (sFromIntegral (o - ord (literal '0')))@@ -154,15 +153,15 @@ -- bounds, we return the arbitrarily chosen space character. Note that for hexadecimal -- letters, we return the corresponding lowercase letter. ----- >>> prove $ \i -> i .>= 0 &&& i .<= 15 ==> digitToInt (intToDigit i) .== i+-- >>> prove $ \i -> i .>= 0 .&& i .<= 15 .=> digitToInt (intToDigit i) .== i -- Q.E.D.--- >>> prove $ \i -> i .<  0 ||| i .>  15 ==> digitToInt (intToDigit i) .== -1+-- >>> prove $ \i -> i .<  0 .|| i .>  15 .=> digitToInt (intToDigit i) .== -1 -- Q.E.D.--- >>> prove $ \c -> digitToInt c .== -1 <=> intToDigit (digitToInt c) .== literal ' '+-- >>> prove $ \c -> digitToInt c .== -1 .<=> intToDigit (digitToInt c) .== literal ' ' -- Q.E.D. intToDigit :: SInteger -> SChar-intToDigit i = ite (i .>=  0 &&& i .<=  9) (chr (sFromIntegral i + ord (literal '0')))-             $ ite (i .>= 10 &&& i .<= 15) (chr (sFromIntegral i + ord (literal 'a') - 10))+intToDigit i = ite (i .>=  0 .&& i .<=  9) (chr (sFromIntegral i + ord (literal '0')))+             $ ite (i .>= 10 .&& i .<= 15) (chr (sFromIntegral i + ord (literal 'a') - 10))              $ literal ' '  -- | Is this a control character? Control characters are essentially the non-printing characters.@@ -177,7 +176,7 @@  -- | Is this a lower-case character? ----- >>> prove $ \c -> isUpper c ==> isLower (toLower c)+-- >>> prove $ \c -> isUpper c .=> isLower (toLower c) -- Q.E.D. isLower :: SChar -> SBool isLower = (`elem` lower)@@ -185,7 +184,7 @@  -- | Is this an upper-case character? ----- >>> prove $ \c -> bnot (isLower c &&& isUpper c)+-- >>> prove $ \c -> sNot (isLower c .&& isUpper c) -- Q.E.D. isUpper :: SChar -> SBool isUpper = (`elem` upper)@@ -198,43 +197,43 @@  -- | Is this an 'isAlpha' or 'isNumber'. ----- >>> prove $ \c -> isAlphaNum c <=> isAlpha c ||| isNumber c+-- >>> prove $ \c -> isAlphaNum c .<=> isAlpha c .|| isNumber c -- Q.E.D. isAlphaNum :: SChar -> SBool-isAlphaNum c = isAlpha c ||| isNumber c+isAlphaNum c = isAlpha c .|| isNumber c  -- | Is this a printable character? Essentially the complement of 'isControl', with one -- exception. The Latin-1 character \173 is neither control nor printable. Go figure. ----- >>> prove $ \c -> c .== literal '\173' ||| isControl c <=> bnot (isPrint c)+-- >>> prove $ \c -> c .== literal '\173' .|| isControl c .<=> sNot (isPrint c) -- Q.E.D. isPrint :: SChar -> SBool-isPrint c = c ./= literal '\173' &&& bnot (isControl c)+isPrint c = c ./= literal '\173' .&& sNot (isControl c)  -- | Is this an ASCII digit, i.e., one of @0@..@9@. Note that this is a subset of 'isNumber' ----- >>> prove $ \c -> isDigit c ==> isNumber c+-- >>> prove $ \c -> isDigit c .=> isNumber c -- Q.E.D. isDigit :: SChar -> SBool isDigit = (`elem` "0123456789")  -- | Is this an Octal digit, i.e., one of @0@..@7@. ----- >>> prove $ \c -> isOctDigit c ==> isDigit c+-- >>> prove $ \c -> isOctDigit c .=> isDigit c -- Q.E.D. isOctDigit :: SChar -> SBool isOctDigit = (`elem` "01234567")  -- | Is this a Hex digit, i.e, one of @0@..@9@, @a@..@f@, @A@..@F@. ----- >>> prove $ \c -> isHexDigit c ==> isAlphaNum c+-- >>> prove $ \c -> isHexDigit c .=> isAlphaNum c -- Q.E.D. isHexDigit :: SChar -> SBool isHexDigit = (`elem` "0123456789abcdefABCDEF")  -- | Is this an alphabet character. Note that this function is equivalent to 'isAlpha'. ----- >>> prove $ \c -> isLetter c <=> isAlpha c+-- >>> prove $ \c -> isLetter c .<=> isAlpha c -- Q.E.D. isLetter :: SChar -> SBool isLetter = isAlpha@@ -242,10 +241,10 @@ -- | Is this a mark? Note that the Latin-1 subset doesn't have any marks; so this function -- is simply constant false for the time being. ----- >>> prove $ bnot . isMark+-- >>> prove $ sNot . isMark -- Q.E.D. isMark :: SChar -> SBool-isMark = const false+isMark = const sFalse  -- | Is this a number character? Note that this set contains not only the digits, but also -- the codes for a few numeric looking characters like 1/2 etc. Use 'isDigit' for the digits @0@ through @9@.@@ -262,7 +261,7 @@  -- | Is this a separator? ----- >>> prove $ \c -> isSeparator c ==> isSpace c+-- >>> prove $ \c -> isSeparator c .=> isSpace c -- Q.E.D. isSeparator :: SChar -> SBool isSeparator = (`elem` " \160")@@ -277,29 +276,29 @@ -- >>> prove isLatin1 -- Q.E.D. isLatin1 :: SChar -> SBool-isLatin1 = const true+isLatin1 = const sTrue  -- | Is this an ASCII letter? ----- >>> prove $ \c -> isAsciiLetter c <=> isAsciiUpper c ||| isAsciiLower c+-- >>> prove $ \c -> isAsciiLetter c .<=> isAsciiUpper c .|| isAsciiLower c -- Q.E.D. isAsciiLetter :: SChar -> SBool-isAsciiLetter c = isAsciiUpper c ||| isAsciiLower c+isAsciiLetter c = isAsciiUpper c .|| isAsciiLower c  -- | Is this an ASCII Upper-case letter? i.e., @A@ thru @Z@ ----- >>> prove $ \c -> isAsciiUpper c <=> ord c .>= ord (literal 'A') &&& ord c .<= ord (literal 'Z')+-- >>> prove $ \c -> isAsciiUpper c .<=> ord c .>= ord (literal 'A') .&& ord c .<= ord (literal 'Z') -- Q.E.D.--- >>> prove $ \c -> isAsciiUpper c <=> isAscii c &&& isUpper c+-- >>> prove $ \c -> isAsciiUpper c .<=> isAscii c .&& isUpper c -- Q.E.D. isAsciiUpper :: SChar -> SBool isAsciiUpper = (`elem` literal ['A' .. 'Z'])  -- | Is this an ASCII Lower-case letter? i.e., @a@ thru @z@ ----- >>> prove $ \c -> isAsciiLower c <=> ord c .>= ord (literal 'a') &&& ord c .<= ord (literal 'z')+-- >>> prove $ \c -> isAsciiLower c .<=> ord c .>= ord (literal 'a') .&& ord c .<= ord (literal 'z') -- Q.E.D.--- >>> prove $ \c -> isAsciiLower c <=> isAscii c &&& isLower c+-- >>> prove $ \c -> isAsciiLower c .<=> isAscii c .&& isLower c -- Q.E.D. isAsciiLower :: SChar -> SBool isAsciiLower = (`elem` literal ['a' .. 'z'])
+ Data/SBV/Client.hs view
@@ -0,0 +1,70 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Client+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Cross-cutting toplevel client functions+-----------------------------------------------------------------------------++{-# LANGUAGE QuasiQuotes         #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}++module Data.SBV.Client+  ( sbvCheckSolverInstallation+  , defaultSolverConfig+  , sbvAvailableSolvers+  , mkSymbolicEnumeration+  ) where++import Control.Monad (filterM)+import Data.Generics++import qualified Control.Exception   as C+import qualified Language.Haskell.TH as TH++import Data.SBV.Core.Data+import Data.SBV.Core.Model+import Data.SBV.Control.Utils+import Data.SBV.Provers.Prover++-- | Check whether the given solver is installed and is ready to go. This call does a+-- simple call to the solver to ensure all is well.+sbvCheckSolverInstallation :: SMTConfig -> IO Bool+sbvCheckSolverInstallation cfg = check `C.catch` (\(_ :: C.SomeException) -> return False)+  where check = do ThmResult r <- proveWith cfg $ \x -> (x+x) .== ((x*2) :: SWord8)+                   case r of+                     Unsatisfiable{} -> return True+                     _               -> return False++-- | The default configs corresponding to supported SMT solvers+defaultSolverConfig :: Solver -> SMTConfig+defaultSolverConfig Z3        = z3+defaultSolverConfig Yices     = yices+defaultSolverConfig Boolector = boolector+defaultSolverConfig CVC4      = cvc4+defaultSolverConfig MathSAT   = mathSAT+defaultSolverConfig ABC       = abc++-- | Return the known available solver configs, installed on your machine.+sbvAvailableSolvers :: IO [SMTConfig]+sbvAvailableSolvers = filterM sbvCheckSolverInstallation (map defaultSolverConfig [minBound .. maxBound])++-- | Make an enumeration a symbolic type.+mkSymbolicEnumeration :: TH.Name -> TH.Q [TH.Dec]+mkSymbolicEnumeration typeName = do+    let typeCon = TH.conT typeName+    [d| deriving instance Eq       $(typeCon)+        deriving instance Show     $(typeCon)+        deriving instance Ord      $(typeCon)+        deriving instance Read     $(typeCon)+        deriving instance Data     $(typeCon)+        deriving instance SymVal   $(typeCon)+        deriving instance HasKind  $(typeCon)+        deriving instance SMTValue $(typeCon)+        deriving instance SatModel $(typeCon)+      |]
+ Data/SBV/Client/BaseIO.hs view
@@ -0,0 +1,622 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Client.BaseIO+-- Author    : Brian Schroeder, Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Monomorphized versions of functions for simplified client use via+-- @Data.SBV@, where we restrict the underlying monad to be IO.+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}++module Data.SBV.Client.BaseIO where++import Data.SBV.Core.Data      (HasKind, Kind, Outputtable, Penalty, SymArray,+                                SymVal, SBool, SBV, SChar, SDouble, SFloat,+                                SInt8, SInt16, SInt32, SInt64, SInteger, SList,+                                SReal, SString, SV, SWord8, SWord16, SWord32,+                                SWord64)+import Data.SBV.Core.Model     (Metric)+import Data.SBV.Core.Symbolic  (Objective, OptimizeStyle, Quantifier, Result,+                                Symbolic, SBVRunMode, SMTConfig, SVal)+import Data.SBV.Control.Types  (SMTOption)+import Data.SBV.Provers.Prover (Provable, SExecutable, ThmResult)+import Data.SBV.SMT.SMT        (AllSatResult, SafeResult, SatResult,+                                OptimizeResult)++import qualified Data.SBV.Core.Data      as Trans+import qualified Data.SBV.Core.Model     as Trans+import qualified Data.SBV.Core.Symbolic  as Trans+import qualified Data.SBV.Provers.Prover as Trans++-- Data.SBV.Provers.Prover:++-- | Turns a value into a universally quantified predicate, internally naming the inputs.+-- In this case the sbv library will use names of the form @s1, s2@, etc. to name these variables+-- Example:+--+-- >  forAll_ $ \(x::SWord8) y -> x `shiftL` 2 .== y+--+-- is a predicate with two arguments, captured using an ordinary Haskell function. Internally,+-- @x@ will be named @s0@ and @y@ will be named @s1@.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.forAll_'+forAll_ :: Provable a => a -> Symbolic SBool+forAll_ = Trans.forAll_++-- | Turns a value into a predicate, allowing users to provide names for the inputs.+-- If the user does not provide enough number of names for the variables, the remaining ones+-- will be internally generated. Note that the names are only used for printing models and has no+-- other significance; in particular, we do not check that they are unique. Example:+--+-- >  forAll ["x", "y"] $ \(x::SWord8) y -> x `shiftL` 2 .== y+--+-- This is the same as above, except the variables will be named @x@ and @y@ respectively,+-- simplifying the counter-examples when they are printed.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.forAll'+forAll :: Provable a => [String] -> a -> Symbolic SBool+forAll = Trans.forAll++-- | Turns a value into an existentially quantified predicate. (Indeed, 'exists' would have been+-- a better choice here for the name, but alas it's already taken.)+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.forSome_'+forSome_ :: Provable a => a -> Symbolic SBool+forSome_ = Trans.forSome_++-- | Version of 'forSome' that allows user defined names.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.forSome'+forSome :: Provable a => [String] -> a -> Symbolic SBool+forSome = Trans.forSome++-- | Prove a predicate, using the default solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.prove'+prove :: Provable a => a -> IO ThmResult+prove = Trans.prove++-- | Prove the predicate using the given SMT-solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.proveWith'+proveWith :: Provable a => SMTConfig -> a -> IO ThmResult+proveWith = Trans.proveWith++-- | Find a satisfying assignment for a predicate, using the default solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sat'+sat :: Provable a => a -> IO SatResult+sat = Trans.sat++-- | Find a satisfying assignment using the given SMT-solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.satWith'+satWith :: Provable a => SMTConfig -> a -> IO SatResult+satWith = Trans.satWith++-- | Find all satisfying assignments, using the default solver.+-- Equivalent to @'allSatWith' 'Data.SBV.defaultSMTCfg'@. See 'allSatWith' for details.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.allSat'+allSat :: Provable a => a -> IO AllSatResult+allSat = Trans.allSat++-- | Return all satisfying assignments for a predicate.+-- Note that this call will block until all satisfying assignments are found. If you have a problem+-- with infinitely many satisfying models (consider 'SInteger') or a very large number of them, you+-- might have to wait for a long time. To avoid such cases, use the 'Data.SBV.Core.Symbolic.allSatMaxModelCount'+-- parameter in the configuration.+--+-- NB. Uninterpreted constant/function values and counter-examples for array values are ignored for+-- the purposes of 'allSat'. That is, only the satisfying assignments modulo uninterpreted functions and+-- array inputs will be returned. This is due to the limitation of not having a robust means of getting a+-- function counter-example back from the SMT solver.+--  Find all satisfying assignments using the given SMT-solver+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.allSatWith'+allSatWith :: Provable a => SMTConfig -> a -> IO AllSatResult+allSatWith = Trans.allSatWith++-- | Optimize a given collection of `Objective`s.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.optimize'+optimize :: Provable a => OptimizeStyle -> a -> IO OptimizeResult+optimize = Trans.optimize++-- | Optimizes the objectives using the given SMT-solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.optimizeWith'+optimizeWith :: Provable a => SMTConfig -> OptimizeStyle -> a -> IO OptimizeResult+optimizeWith = Trans.optimizeWith++-- | Check if the constraints given are consistent, using the default solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.isVacuous'+isVacuous :: Provable a => a -> IO Bool+isVacuous = Trans.isVacuous++-- | Determine if the constraints are vacuous using the given SMT-solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.isVacuousWith'+isVacuousWith :: Provable a => SMTConfig -> a -> IO Bool+isVacuousWith = Trans.isVacuousWith++-- | Checks theoremhood using the default solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.isTheorem'+isTheorem :: Provable a => a -> IO Bool+isTheorem = Trans.isTheorem++-- | Check whether a given property is a theorem.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.isTheoremWith'+isTheoremWith :: Provable a => SMTConfig -> a -> IO Bool+isTheoremWith = Trans.isTheoremWith++-- | Checks satisfiability using the default solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.isSatisfiable'+isSatisfiable :: Provable a => a -> IO Bool+isSatisfiable = Trans.isSatisfiable++-- | Check whether a given property is satisfiable.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.isSatisfiableWith'+isSatisfiableWith :: Provable a => SMTConfig -> a -> IO Bool+isSatisfiableWith = Trans.isSatisfiableWith++-- | Run an arbitrary symbolic computation, equivalent to @'runSMTWith' 'Data.SBV.defaultSMTCfg'@+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.runSMT'+runSMT :: Symbolic a -> IO a+runSMT = Trans.runSMT++-- | Runs an arbitrary symbolic computation, exposed to the user in SAT mode+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.runSMTWith'+runSMTWith :: SMTConfig -> Symbolic a -> IO a+runSMTWith = Trans.runSMTWith++-- | NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sName_'+sName_ :: SExecutable IO a => a -> Symbolic ()+sName_ = Trans.sName_++-- | NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sName'+sName :: SExecutable IO a => [String] -> a -> Symbolic ()+sName = Trans.sName++-- | Check safety using the default solver.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.safe'+safe :: SExecutable IO a => a -> IO [SafeResult]+safe = Trans.safe++-- | Check if any of the 'Data.SBV.sAssert' calls can be violated.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.safeWith'+safeWith :: SExecutable IO a => SMTConfig -> a -> IO [SafeResult]+safeWith = Trans.safeWith++-- Data.SBV.Core.Data:++-- | Create a symbolic variable.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.mkSymSBV'+mkSymSBV :: Maybe Quantifier -> Kind -> Maybe String -> Symbolic (SBV a)+mkSymSBV = Trans.mkSymSBV++-- | Convert a symbolic value to an SV, inside the Symbolic monad+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sbvToSymSV'+sbvToSymSV :: SBV a -> Symbolic SV+sbvToSymSV = Trans.sbvToSymSV++-- | Mark an interim result as an output. Useful when constructing Symbolic programs+-- that return multiple values, or when the result is programmatically computed.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.output'+output :: Outputtable a => a -> Symbolic a+output = Trans.output++-- | Create a user named input (universal)+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.forall'+forall :: SymVal a => String -> Symbolic (SBV a)+forall = Trans.forall++-- | Create an automatically named input+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.forall_'+forall_ :: SymVal a => Symbolic (SBV a)+forall_ = Trans.forall_++-- | Get a bunch of new words+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.mkForallVars'+mkForallVars :: SymVal a => Int -> Symbolic [SBV a]+mkForallVars = Trans.mkForallVars++-- | Create an existential variable+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.exists'+exists :: SymVal a => String -> Symbolic (SBV a)+exists = Trans.exists++-- | Create an automatically named existential variable+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.exists_'+exists_ :: SymVal a => Symbolic (SBV a)+exists_ = Trans.exists_++-- | Create a bunch of existentials+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.mkExistVars'+mkExistVars :: SymVal a => Int -> Symbolic [SBV a]+mkExistVars = Trans.mkExistVars++-- | Create a free variable, universal in a proof, existential in sat+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.free'+free :: SymVal a => String -> Symbolic (SBV a)+free = Trans.free++-- | Create an unnamed free variable, universal in proof, existential in sat+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.free_'+free_ :: SymVal a => Symbolic (SBV a)+free_ = Trans.free_++-- | Create a bunch of free vars+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.mkFreeVars'+mkFreeVars :: SymVal a => Int -> Symbolic [SBV a]+mkFreeVars = Trans.mkFreeVars++-- | Similar to free; Just a more convenient name+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.symbolic'+symbolic :: SymVal a => String -> Symbolic (SBV a)+symbolic = Trans.symbolic++-- | Similar to mkFreeVars; but automatically gives names based on the strings+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.symbolics'+symbolics :: SymVal a => [String] -> Symbolic [SBV a]+symbolics = Trans.symbolics++-- | One stop allocator+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.mkSymVal'+mkSymVal :: SymVal a => Maybe Quantifier -> Maybe String -> Symbolic (SBV a)+mkSymVal = Trans.mkSymVal++-- | Create a new anonymous array, possibly with a default initial value.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.newArray_'+newArray_ :: (SymArray array, HasKind a, HasKind b) => Maybe (SBV b) -> Symbolic (array a b)+newArray_ = Trans.newArray_++-- | Create a named new array, possibly with a default initial value.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.newArray'+newArray :: (SymArray array, HasKind a, HasKind b) => String -> Maybe (SBV b) -> Symbolic (array a b)+newArray = Trans.newArray++-- Data.SBV.Core.Model:++-- | Generically make a symbolic var+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.genMkSymVar'+genMkSymVar :: Kind -> Maybe Quantifier -> Maybe String -> Symbolic (SBV a)+genMkSymVar = Trans.genMkSymVar++-- | Declare an 'SBool'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sBool'+sBool :: String -> Symbolic SBool+sBool = Trans.sBool++-- | Declare a list of 'SBool's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sBools'+sBools :: [String] -> Symbolic [SBool]+sBools = Trans.sBools++-- | Declare an 'SWord8'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWord8'+sWord8 :: String -> Symbolic SWord8+sWord8 = Trans.sWord8++-- | Declare a list of 'SWord8's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWord8s'+sWord8s :: [String] -> Symbolic [SWord8]+sWord8s = Trans.sWord8s++-- | Declare an 'SWord16'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWord16'+sWord16 :: String -> Symbolic SWord16+sWord16 = Trans.sWord16++-- | Declare a list of 'SWord16's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWord16s'+sWord16s :: [String] -> Symbolic [SWord16]+sWord16s = Trans.sWord16s++-- | Declare an 'SWord32'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWord32'+sWord32 :: String -> Symbolic SWord32+sWord32 = Trans.sWord32++-- | Declare a list of 'SWord32's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWord32s'+sWord32s :: [String] -> Symbolic [SWord32]+sWord32s = Trans.sWord32s++-- | Declare an 'SWord64'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWord64'+sWord64 :: String -> Symbolic SWord64+sWord64 = Trans.sWord64++-- | Declare a list of 'SWord64's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWord64s'+sWord64s :: [String] -> Symbolic [SWord64]+sWord64s = Trans.sWord64s++-- | Declare an 'SInt8'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sInt8'+sInt8 :: String -> Symbolic SInt8+sInt8 = Trans.sInt8++-- | Declare a list of 'SInt8's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sInt8s'+sInt8s :: [String] -> Symbolic [SInt8]+sInt8s = Trans.sInt8s++-- | Declare an 'SInt16'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sInt16'+sInt16 :: String -> Symbolic SInt16+sInt16 = Trans.sInt16++-- | Declare a list of 'SInt16's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sInt16s'+sInt16s :: [String] -> Symbolic [SInt16]+sInt16s = Trans.sInt16s++-- | Declare an 'SInt32'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sInt32'+sInt32 :: String -> Symbolic SInt32+sInt32 = Trans.sInt32++-- | Declare a list of 'SInt32's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sInt32s'+sInt32s :: [String] -> Symbolic [SInt32]+sInt32s = Trans.sInt32s++-- | Declare an 'SInt64'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sInt64'+sInt64 :: String -> Symbolic SInt64+sInt64 = Trans.sInt64++-- | Declare a list of 'SInt64's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sInt64s'+sInt64s :: [String] -> Symbolic [SInt64]+sInt64s = Trans.sInt64s++-- | Declare an 'SInteger'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sInteger'+sInteger :: String -> Symbolic SInteger+sInteger = Trans.sInteger++-- | Declare a list of 'SInteger's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sIntegers'+sIntegers :: [String] -> Symbolic [SInteger]+sIntegers = Trans.sIntegers++-- | Declare an 'SReal'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sReal'+sReal :: String -> Symbolic SReal+sReal = Trans.sReal++-- | Declare a list of 'SReal's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sReals'+sReals :: [String] -> Symbolic [SReal]+sReals = Trans.sReals++-- | Declare an 'SFloat'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sFloat'+sFloat :: String -> Symbolic SFloat+sFloat = Trans.sFloat++-- | Declare a list of 'SFloat's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sFloats'+sFloats :: [String] -> Symbolic [SFloat]+sFloats = Trans.sFloats++-- | Declare an 'SDouble'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sDouble'+sDouble :: String -> Symbolic SDouble+sDouble = Trans.sDouble++-- | Declare a list of 'SDouble's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sDoubles'+sDoubles :: [String] -> Symbolic [SDouble]+sDoubles = Trans.sDoubles++-- | Declare an 'SChar'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sChar'+sChar :: String -> Symbolic SChar+sChar = Trans.sChar++-- | Declare an 'SString'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sString'+sString :: String -> Symbolic SString+sString = Trans.sString++-- | Declare a list of 'SChar's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sChars'+sChars :: [String] -> Symbolic [SChar]+sChars = Trans.sChars++-- | Declare a list of 'SString's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sStrings'+sStrings :: [String] -> Symbolic [SString]+sStrings = Trans.sStrings++-- | Declare an 'SList'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sList'+sList :: SymVal a => String -> Symbolic (SList a)+sList = Trans.sList++-- | Declare a list of 'SList's+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sLists'+sLists :: SymVal a => [String] -> Symbolic [SList a]+sLists = Trans.sLists++-- | Declare a tuple.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sTuple'+sTuple :: SymVal tup => String -> Symbolic (SBV tup)+sTuple = Trans.sTuple++-- | Declare a list of tuples.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sTuples'+sTuples :: SymVal tup => [String] -> Symbolic [SBV tup]+sTuples = Trans.sTuples++-- | Form the symbolic conjunction of a given list of boolean conditions. Useful in expressing+-- problems with constraints, like the following:+--+-- @+--   sat $ do [x, y, z] <- sIntegers [\"x\", \"y\", \"z\"]+--            solve [x .> 5, y + z .< x]+-- @+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.solve'+solve :: [SBool] -> Symbolic SBool+solve = Trans.solve++-- | Introduce a soft assertion, with an optional penalty+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.assertWithPenalty'+assertWithPenalty :: String -> SBool -> Penalty -> Symbolic ()+assertWithPenalty = Trans.assertWithPenalty++-- | Minimize a named metric+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.minimize'+minimize :: Metric a => String -> a -> Symbolic ()+minimize = Trans.minimize++-- | Maximize a named metric+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.maximize'+maximize :: Metric a => String -> a -> Symbolic ()+maximize = Trans.maximize++-- Data.SBV.Core.Symbolic:++-- | Convert a symbolic value to an SV, inside the Symbolic monad+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.svToSymSV'+svToSymSV :: SVal -> Symbolic SV+svToSymSV = Trans.svToSymSV++-- | Create an N-bit symbolic unsigned named variable+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWordN'+sWordN :: Int -> String -> Symbolic SVal+sWordN = Trans.sWordN++-- | Create an N-bit symbolic unsigned unnamed variable+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sWordN_'+sWordN_ :: Int -> Symbolic SVal+sWordN_ = Trans.sWordN_++-- | Create an N-bit symbolic signed named variable+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sIntN'+sIntN :: Int -> String -> Symbolic SVal+sIntN = Trans.sIntN++-- | Create an N-bit symbolic signed unnamed variable+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.sIntN_'+sIntN_ :: Int -> Symbolic SVal+sIntN_ = Trans.sIntN_++-- | Add a user specified axiom to the generated SMT-Lib file. The first argument is a mere+-- string, use for commenting purposes. The second argument is intended to hold the multiple-lines+-- of the axiom text as expressed in SMT-Lib notation. Note that we perform no checks on the axiom+-- itself, to see whether it's actually well-formed or is sensical by any means.+-- A separate formalization of SMT-Lib would be very useful here.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.addAxiom'+addAxiom :: String -> [String] -> Symbolic ()+addAxiom = Trans.addAxiom++-- | Run a symbolic computation, and return a extra value paired up with the 'Result'+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.runSymbolic'+runSymbolic :: SBVRunMode -> Symbolic a -> IO (a, Result)+runSymbolic = Trans.runSymbolic++-- | Add a new option+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.addNewSMTOption'+addNewSMTOption :: SMTOption -> Symbolic ()+addNewSMTOption = Trans.addNewSMTOption++-- | Handling constraints+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.imposeConstraint'+imposeConstraint :: Bool -> [(String, String)] -> SVal -> Symbolic ()+imposeConstraint = Trans.imposeConstraint++-- | Add an optimization goal+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.addSValOptGoal'+addSValOptGoal :: Objective SVal -> Symbolic ()+addSValOptGoal = Trans.addSValOptGoal++-- | Mark an interim result as an output. Useful when constructing Symbolic programs+-- that return multiple values, or when the result is programmatically computed.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.outputSVal'+outputSVal :: SVal -> Symbolic ()+outputSVal = Trans.outputSVal
Data/SBV/Compilers/C.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Compilers.C--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Compilers.C+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Compilation of symbolic programs to C -----------------------------------------------------------------------------@@ -136,37 +136,37 @@ -- | Pretty print a functions type. If there is only one output, we compile it -- as a function that returns that value. Otherwise, we compile it as a void function -- that takes return values as pointers to be updated.-pprCFunHeader :: String -> [(String, CgVal)] -> [(String, CgVal)] -> Maybe SW -> Doc+pprCFunHeader :: String -> [(String, CgVal)] -> [(String, CgVal)] -> Maybe SV -> Doc pprCFunHeader fn ins outs mbRet = retType <+> text fn P.<> parens (fsep (punctuate comma (map mkParam ins ++ map mkPParam outs)))   where retType = case mbRet of                    Nothing -> text "void"-                   Just sw -> pprCWord False sw+                   Just sv -> pprCWord False sv  mkParam, mkPParam :: (String, CgVal) -> Doc-mkParam  (n, CgAtomic sw)     = pprCWord True  sw <+> text n+mkParam  (n, CgAtomic sv)     = pprCWord True  sv <+> text n mkParam  (_, CgArray  [])     = die "mkParam: CgArray with no elements!"-mkParam  (n, CgArray  (sw:_)) = pprCWord True  sw <+> text "*" P.<> text n-mkPParam (n, CgAtomic sw)     = pprCWord False sw <+> text "*" P.<> text n+mkParam  (n, CgArray  (sv:_)) = pprCWord True  sv <+> text "*" P.<> text n+mkPParam (n, CgAtomic sv)     = pprCWord False sv <+> text "*" P.<> text n mkPParam (_, CgArray  [])     = die "mPkParam: CgArray with no elements!"-mkPParam (n, CgArray  (sw:_)) = pprCWord False sw <+> text "*" P.<> text n+mkPParam (n, CgArray  (sv:_)) = pprCWord False sv <+> text "*" P.<> text n  -- | Renders as "const SWord8 s0", etc. the first parameter is the width of the typefield-declSW :: Int -> SW -> Doc-declSW w sw = text "const" <+> pad (showCType sw) <+> text (show sw)+declSV :: Int -> SV -> Doc+declSV w sv = text "const" <+> pad (showCType sv) <+> text (show sv)   where pad s = text $ s ++ replicate (w - length s) ' '  -- | Return the proper declaration and the result as a pair. No consts-declSWNoConst :: Int -> SW -> (Doc, Doc)-declSWNoConst w sw = (text "     " <+> pad (showCType sw), text (show sw))+declSVNoConst :: Int -> SV -> (Doc, Doc)+declSVNoConst w sv = (text "     " <+> pad (showCType sv), text (show sv))   where pad s = text $ s ++ replicate (w - length s) ' '  -- | Renders as "s0", etc, or the corresponding constant-showSW :: CgConfig -> [(SW, CW)] -> SW -> Doc-showSW cfg consts sw-  | sw == falseSW                 = text "false"-  | sw == trueSW                  = text "true"-  | Just cw <- sw `lookup` consts = mkConst cfg cw-  | True                          = text $ show sw+showSV :: CgConfig -> [(SV, CV)] -> SV -> Doc+showSV cfg consts sv+  | sv == falseSV                 = text "false"+  | sv == trueSV                  = text "true"+  | Just cv <- sv `lookup` consts = mkConst cfg cv+  | True                          = text $ show sv  -- | Words as it would map to a C word pprCWord :: HasKind a => Bool -> a -> Doc@@ -180,18 +180,19 @@                 k                -> show k  -- | The printf specifier for the type-specifier :: CgConfig -> SW -> Doc-specifier cfg sw = case kindOf sw of-                     KBool         -> spec (False, 1)-                     KBounded b i  -> spec (b, i)-                     KUnbounded    -> spec (True, fromJust (cgInteger cfg))-                     KReal         -> specF (fromJust (cgReal cfg))-                     KFloat        -> specF CgFloat-                     KDouble       -> specF CgDouble-                     KString       -> text "%s"-                     KChar         -> text "%c"-                     KList k       -> die $ "list sort: " ++ show k-                     KUserSort s _ -> die $ "uninterpreted sort: " ++ s+specifier :: CgConfig -> SV -> Doc+specifier cfg sv = case kindOf sv of+                     KBool              -> spec (False, 1)+                     KBounded b i       -> spec (b, i)+                     KUnbounded         -> spec (True, fromJust (cgInteger cfg))+                     KReal              -> specF (fromJust (cgReal cfg))+                     KFloat             -> specF CgFloat+                     KDouble            -> specF CgDouble+                     KString            -> text "%s"+                     KChar              -> text "%c"+                     KList k            -> die $ "list sort: " ++ show k+                     KUninterpreted s _ -> die $ "uninterpreted sort: " ++ s+                     KTuple k           -> die $ "tuple sort: " ++ show k   where spec :: (Bool, Int) -> Doc         spec (False,  1) = text "%d"         spec (False,  8) = text "%\"PRIu8\""@@ -211,19 +212,19 @@ -- | Make a constant value of the given type. We don't check for out of bounds here, as it should not be needed. --   There are many options here, using binary, decimal, etc. We simply use decimal for values 8-bits or less, --   and hex otherwise.-mkConst :: CgConfig -> CW -> Doc-mkConst cfg  (CW KReal (CWAlgReal (AlgRational _ r))) = double (fromRational r :: Double) P.<> sRealSuffix (fromJust (cgReal cfg))+mkConst :: CgConfig -> CV -> Doc+mkConst cfg  (CV KReal (CAlgReal (AlgRational _ r))) = double (fromRational r :: Double) P.<> sRealSuffix (fromJust (cgReal cfg))   where sRealSuffix CgFloat      = text "F"         sRealSuffix CgDouble     = empty         sRealSuffix CgLongDouble = text "L"-mkConst cfg (CW KUnbounded       (CWInteger i)) = showSizedConst i (True, fromJust (cgInteger cfg))-mkConst _   (CW (KBounded sg sz) (CWInteger i)) = showSizedConst i (sg,   sz)-mkConst _   (CW KBool            (CWInteger i)) = showSizedConst i (False, 1)-mkConst _   (CW KFloat           (CWFloat f))   = text $ showCFloat f-mkConst _   (CW KDouble          (CWDouble d))  = text $ showCDouble d-mkConst _   (CW KString          (CWString s))  = text $ show s-mkConst _   (CW KChar            (CWChar c))    = text $ show c-mkConst _   cw                                  = die $ "mkConst: " ++ show cw+mkConst cfg (CV KUnbounded       (CInteger i)) = showSizedConst i (True, fromJust (cgInteger cfg))+mkConst _   (CV (KBounded sg sz) (CInteger i)) = showSizedConst i (sg,   sz)+mkConst _   (CV KBool            (CInteger i)) = showSizedConst i (False, 1)+mkConst _   (CV KFloat           (CFloat f))   = text $ showCFloat f+mkConst _   (CV KDouble          (CDouble d))  = text $ showCDouble d+mkConst _   (CV KString          (CString s))  = text $ show s+mkConst _   (CV KChar            (CChar c))    = text $ show c+mkConst _   cv                                 = die $ "mkConst: " ++ show cv  showSizedConst :: Integer -> (Bool, Int) -> Doc showSizedConst i   (False,  1) = text (if i == 0 then "false" else "true")@@ -344,7 +345,7 @@ sepIf b = if b then text "" else empty  -- | Generate an example driver program-genDriver :: CgConfig -> [Integer] -> String -> [(String, CgVal)] -> [(String, CgVal)] -> Maybe SW -> [Doc]+genDriver :: CgConfig -> [Integer] -> String -> [(String, CgVal)] -> [(String, CgVal)] -> Maybe SV -> [Doc] genDriver cfg randVals fn inps outs mbRet = [pre, header, body, post]  where pre    =  text "/* Example driver program for" <+> nm P.<> text ". */"               $$ text "/* Automatically generated by SBV. Edit as you see fit! */"@@ -361,7 +362,7 @@                       $$ call                       $$ text ""                       $$ (case mbRet of-                              Just sw -> text "printf" P.<> parens (printQuotes (fcall <+> text "=" <+> specifier cfg sw P.<> text "\\n")+                              Just sv -> text "printf" P.<> parens (printQuotes (fcall <+> text "=" <+> specifier cfg sv P.<> text "\\n")                                                                               P.<> comma <+> resultVar) P.<> semi                               Nothing -> text "printf" P.<> parens (printQuotes (fcall <+> text "->\\n")) P.<> semi)                       $$ vcat (map display outs)@@ -374,50 +375,50 @@        pairedInputs = matchRands (map abs randVals) inps        matchRands _      []                                 = []        matchRands []     _                                  = die "Run out of driver values!"-       matchRands (r:rs) ((n, CgAtomic sw)            : cs) = ([mkRVal sw r], n, CgAtomic sw) : matchRands rs cs+       matchRands (r:rs) ((n, CgAtomic sv)            : cs) = ([mkRVal sv r], n, CgAtomic sv) : matchRands rs cs        matchRands _      ((n, CgArray [])             : _ ) = die $ "Unsupported empty array input " ++ show n-       matchRands rs     ((n, a@(CgArray sws@(sw:_))) : cs)+       matchRands rs     ((n, a@(CgArray sws@(sv:_))) : cs)           | length frs /= l                                 = die "Run out of driver values!"-          | True                                            = (map (mkRVal sw) frs, n, a) : matchRands srs cs+          | True                                            = (map (mkRVal sv) frs, n, a) : matchRands srs cs           where l          = length sws                 (frs, srs) = splitAt l rs-       mkRVal sw r = mkConst cfg $ mkConstCW (kindOf sw) r+       mkRVal sv r = mkConst cfg $ mkConstCV (kindOf sv) r        mkInp (_,  _, CgAtomic{})         = empty  -- constant, no need to declare        mkInp (_,  n, CgArray [])         = die $ "Unsupported empty array value for " ++ show n-       mkInp (vs, n, CgArray sws@(sw:_)) =  pprCWord True sw <+> text n P.<> brackets (int (length sws)) <+> text "= {"+       mkInp (vs, n, CgArray sws@(sv:_)) =  pprCWord True sv <+> text n P.<> brackets (int (length sws)) <+> text "= {"                                                       $$ nest 4 (fsep (punctuate comma (align vs)))                                                       $$ text "};"                                          $$ text ""                                          $$ text "printf" P.<> parens (printQuotes (text "Contents of input array" <+> text n P.<> text ":\\n")) P.<> semi                                          $$ display (n, CgArray sws)                                          $$ text ""-       mkOut (v, CgAtomic sw)            = pprCWord False sw <+> text v P.<> semi+       mkOut (v, CgAtomic sv)            = pprCWord False sv <+> text v P.<> semi        mkOut (v, CgArray [])             = die $ "Unsupported empty array value for " ++ show v-       mkOut (v, CgArray sws@(sw:_))     = pprCWord False sw <+> text v P.<> brackets (int (length sws)) P.<> semi+       mkOut (v, CgArray sws@(sv:_))     = pprCWord False sv <+> text v P.<> brackets (int (length sws)) P.<> semi        resultVar = text "__result"        call = case mbRet of                 Nothing -> fcall P.<> semi-                Just sw -> pprCWord True sw <+> resultVar <+> text "=" <+> fcall P.<> semi+                Just sv -> pprCWord True sv <+> resultVar <+> text "=" <+> fcall P.<> semi        fcall = nm P.<> parens (fsep (punctuate comma (map mkCVal pairedInputs ++ map mkOVal outs)))        mkCVal ([v], _, CgAtomic{}) = v        mkCVal (vs,  n, CgAtomic{}) = die $ "Unexpected driver value computed for " ++ show n ++ render (hcat vs)        mkCVal (_,   n, CgArray{})  = text n        mkOVal (n, CgAtomic{})      = text "&" P.<> text n        mkOVal (n, CgArray{})       = text n-       display (n, CgAtomic sw)         = text "printf" P.<> parens (printQuotes (text " " <+> text n <+> text "=" <+> specifier cfg sw+       display (n, CgAtomic sv)         = text "printf" P.<> parens (printQuotes (text " " <+> text n <+> text "=" <+> specifier cfg sv                                                                                 P.<> text "\\n") P.<> comma <+> text n) P.<> semi        display (n, CgArray [])         =  die $ "Unsupported empty array value for " ++ show n-       display (n, CgArray sws@(sw:_)) =   text "int" <+> nctr P.<> semi+       display (n, CgArray sws@(sv:_)) =   text "int" <+> nctr P.<> semi                                         $$ text "for(" P.<> nctr <+> text "= 0;" <+> nctr <+> text "<" <+> int (length sws) <+> text "; ++" P.<> nctr P.<> text ")"                                         $$ nest 2 (text "printf" P.<> parens (printQuotes (text " " <+> entrySpec <+> text "=" <+> spec P.<> text "\\n")                                                                  P.<> comma <+> nctr <+> comma P.<> entry) P.<> semi)                   where nctr      = text n P.<> text "_ctr"                         entry     = text n P.<> text "[" P.<> nctr P.<> text "]"                         entrySpec = text n P.<> text "[%d]"-                        spec      = specifier cfg sw+                        spec      = specifier cfg sv  -- | Generate the C program-genCProg :: CgConfig -> String -> Doc -> Result -> [(String, CgVal)] -> [(String, CgVal)] -> Maybe SW -> Doc -> ([Doc], [String])+genCProg :: CgConfig -> String -> Doc -> Result -> [(String, CgVal)] -> [(String, CgVal)] -> Maybe SV -> Doc -> ([Doc], [String]) genCProg cfg fn proto (Result kindInfo _tvals _ovals cgs ins preConsts tbls arrs _uis _axioms (SBVPgm asgns) cstrs origAsserts _) inVars outVars mbRet extDecls   | isNothing (cgInteger cfg) && KUnbounded `Set.member` kindInfo   = error $ "SBV->C: Unbounded integers are not supported by the C compiler."@@ -442,7 +443,7 @@  where asserts | cgIgnoreAsserts cfg = []                | True                = origAsserts -       usorts = [s | KUserSort s _ <- Set.toList kindInfo, s /= "RoundingMode"] -- No support for any sorts other than RoundingMode!+       usorts = [s | KUninterpreted s _ <- Set.toList kindInfo, s /= "RoundingMode"] -- No support for any sorts other than RoundingMode!         pre    =  text "/* File:" <+> doubleQuotes (nm P.<> text ".c") P.<> text ". Automatically generated by SBV. Do not edit! */"               $$ text ""@@ -470,29 +471,31 @@         -- Do we need any linker flags for C?        flagsNeeded = nub $ concatMap (getLDFlag . opRes) assignments-          where opRes (sw, SBVApp o _) = (o, kindOf sw)+          where opRes (sv, SBVApp o _) = (o, kindOf sv)         codeSeg (fnm, ls) =  text "/* User specified custom code for" <+> doubleQuotes (text fnm) <+> text "*/"                          $$ vcat (map text ls)                          $$ text ""         typeWidth = getMax 0 $ [len (kindOf s) | (s, _) <- assignments] ++ [len (kindOf s) | (_, (s, _)) <- fst ins]-                where len KReal{}             = 5-                      len KFloat{}            = 6 -- SFloat-                      len KDouble{}           = 7 -- SDouble-                      len KString{}           = 7 -- SString-                      len KChar{}             = 5 -- SChar-                      len KUnbounded{}        = 8-                      len KBool               = 5 -- SBool-                      len (KBounded False n)  = 5 + length (show n) -- SWordN-                      len (KBounded True  n)  = 4 + length (show n) -- SIntN-                      len (KList s)           = die $ "List sort: " ++ show s-                      len (KUserSort s _)     = die $ "Uninterpreted sort: " ++ s+                where len KReal{}              = 5+                      len KFloat{}             = 6 -- SFloat+                      len KDouble{}            = 7 -- SDouble+                      len KString{}            = 7 -- SString+                      len KChar{}              = 5 -- SChar+                      len KUnbounded{}         = 8+                      len KBool                = 5 -- SBool+                      len (KBounded False n)   = 5 + length (show n) -- SWordN+                      len (KBounded True  n)   = 4 + length (show n) -- SIntN+                      len (KList s)            = die $ "List sort: " ++ show s+                      len (KTuple s)           = die $ "Tuple sort: " ++ show s+                      len (KUninterpreted s _) = die $ "Uninterpreted sort: " ++ s+                       getMax 8 _      = 8  -- 8 is the max we can get with SInteger, so don't bother looking any further                       getMax m []     = m                       getMax m (x:xs) = getMax (m `max` x) xs -       consts = (falseSW, falseCW) : (trueSW, trueCW) : preConsts+       consts = (falseSV, falseCV) : (trueSV, trueCV) : preConsts         isConst s = isJust (lookup s consts) @@ -510,32 +513,32 @@                opSWs _                        = Set.empty         isAlive :: (String, CgVal) -> Bool-       isAlive (_, CgAtomic sw) = sw `Set.member` usedVariables+       isAlive (_, CgAtomic sv) = sv `Set.member` usedVariables        isAlive (_, _)           = True         genIO :: Bool -> (Bool, (String, CgVal)) -> [Doc]-       genIO True  (alive, (cNm, CgAtomic sw)) = [declSW typeWidth sw  <+> text "=" <+> text cNm P.<> semi               | alive]-       genIO False (alive, (cNm, CgAtomic sw)) = [text "*" P.<> text cNm <+> text "=" <+> showSW cfg consts sw P.<> semi | alive]+       genIO True  (alive, (cNm, CgAtomic sv)) = [declSV typeWidth sv  <+> text "=" <+> text cNm P.<> semi               | alive]+       genIO False (alive, (cNm, CgAtomic sv)) = [text "*" P.<> text cNm <+> text "=" <+> showSV cfg consts sv P.<> semi | alive]        genIO isInp (_,     (cNm, CgArray sws)) = zipWith genElt sws [(0::Int)..]-         where genElt sw i-                 | isInp = declSW typeWidth sw <+> text "=" <+> text entry       P.<> semi-                 | True  = text entry          <+> text "=" <+> showSW cfg consts sw P.<> semi+         where genElt sv i+                 | isInp = declSV typeWidth sv <+> text "=" <+> text entry       P.<> semi+                 | True  = text entry          <+> text "=" <+> showSV cfg consts sv P.<> semi                  where entry = cNm ++ "[" ++ show i ++ "]" -       mkRet sw = text "return" <+> showSW cfg consts sw P.<> semi+       mkRet sv = text "return" <+> showSV cfg consts sv P.<> semi -       genTbl :: ((Int, Kind, Kind), [SW]) -> (Int, Doc)+       genTbl :: ((Int, Kind, Kind), [SV]) -> (Int, Doc)        genTbl ((i, _, k), elts) =  (location, static <+> text "const" <+> text (show k) <+> text ("table" ++ show i) P.<> text "[] = {"-                                              $$ nest 4 (fsep (punctuate comma (align (map (showSW cfg consts) elts))))+                                              $$ nest 4 (fsep (punctuate comma (align (map (showSV cfg consts) elts))))                                               $$ text "};")          where static   = if location == -1 then text "static" else empty                location = maximum (-1 : map getNodeId elts) -       getNodeId s@(SW _ (NodeId n)) | isConst s = -1+       getNodeId s@(SV _ (NodeId n)) | isConst s = -1                                      | True      = n -       genAsgn :: (SW, SBVExpr) -> (Int, Doc)-       genAsgn (sw, n) = (getNodeId sw, ppExpr cfg consts n (declSW typeWidth sw) (declSWNoConst typeWidth sw) P.<> semi)+       genAsgn :: (SV, SBVExpr) -> (Int, Doc)+       genAsgn (sv, n) = (getNodeId sv, ppExpr cfg consts n (declSV typeWidth sv) (declSVNoConst typeWidth sv) P.<> semi)         -- merge tables intermixed with assignments and assertions, paying attention to putting tables as        -- early as possible and tables right after.. Note that the assignment list (second argument) is sorted on its order@@ -547,11 +550,11 @@                  | i < i'                                 = (i,  t)  : merge2 trest as                  | True                                   = (i', a) : merge2 ts arest -       genAssert (msg, cs, sw) = (getNodeId sw, doc)+       genAssert (msg, cs, sv) = (getNodeId sv, doc)          where doc =     text "/* ASSERTION:" <+> text msg                      $$  maybe empty (vcat . map text) (locInfo (getCallStack `fmap` cs))                      $$  text " */"-                     $$  text "if" P.<> parens (showSW cfg consts sw)+                     $$  text "if" P.<> parens (showSV cfg consts sv)                      $$  text "{"                      $+$ nest 2 (vcat [errOut, text "exit(-1);"])                      $$  text "}"@@ -575,7 +578,7 @@   where addIf :: [Int] -> Doc         addIf cs = parens $ fsep $ intersperse (text "+") [parens (a <+> text "?" <+> int c <+> text ":" <+> int 0) | (a, c) <- zip args cs] -handleIEEE :: FPOp -> [(SW, CW)] -> [(SW, Doc)] -> Doc -> Doc+handleIEEE :: FPOp -> [(SV, CV)] -> [(SV, Doc)] -> Doc -> Doc handleIEEE w consts as var = cvt w   where same f                   = (f, f)         named fnm dnm f          = (f fnm, f dnm)@@ -632,20 +635,20 @@         fpArgs = case as of                    []            -> []                    ((m, _):args) -> case kindOf m of-                                      KUserSort "RoundingMode" _ -> case checkRM (m `lookup` consts) of-                                                                      Nothing          -> args-                                                                      Just (Left  msg) -> die msg-                                                                      Just (Right msg) -> tbd msg-                                      _                          -> as+                                      KUninterpreted "RoundingMode" _ -> case checkRM (m `lookup` consts) of+                                                                           Nothing          -> args+                                                                           Just (Left  msg) -> die msg+                                                                           Just (Right msg) -> tbd msg+                                      _                               -> as          -- Check that the RM is RoundNearestTiesToEven.         -- If we start supporting other rounding-modes, this would be the point where we'd insert the rounding-mode set/reset code         -- instead of merely returning OK or not-        checkRM (Just cv@(CW (KUserSort "RoundingMode" _) v)) =+        checkRM (Just cv@(CV (KUninterpreted "RoundingMode" _) v)) =               case v of-                CWUserSort (_, "RoundNearestTiesToEven") -> Nothing-                CWUserSort (_, s)                        -> Just (Right $ "handleIEEE: Unsupported rounding-mode: " ++ show s ++ " for: " ++ show w)-                _                                        -> Just (Left  $ "handleIEEE: Unexpected value for rounding-mode: " ++ show cv ++ " for: " ++ show w)+                CUserSort (_, "RoundNearestTiesToEven") -> Nothing+                CUserSort (_, s)                        -> Just (Right $ "handleIEEE: Unsupported rounding-mode: " ++ show s ++ " for: " ++ show w)+                _                                       -> Just (Left  $ "handleIEEE: Unexpected value for rounding-mode: " ++ show cv ++ " for: " ++ show w)         checkRM (Just cv) = Just (Left  $ "handleIEEE: Expected rounding-mode, but got: " ++ show cv ++ " for: " ++ show w)         checkRM Nothing   = Just (Right $ "handleIEEE: Non-constant rounding-mode for: " ++ show w) @@ -668,7 +671,7 @@                        <+> text "&&" <+> parens (text "FP_ZERO == fpclassify" P.<> parens b)                                      -- b is zero                        <+> text "&&" <+> parens (text "signbit" P.<> parens a <+> text "!=" <+> text "signbit" P.<> parens b)       -- a and b differ in sign -ppExpr :: CgConfig -> [(SW, CW)] -> SBVExpr -> Doc -> (Doc, Doc) -> Doc+ppExpr :: CgConfig -> [(SV, CV)] -> SBVExpr -> Doc -> (Doc, Doc) -> Doc ppExpr cfg consts (SBVApp op opArgs) lhs (typ, var)   | doNotAssign op   = typ <+> var P.<> semi <+> rhs@@ -677,7 +680,7 @@   where doNotAssign (IEEEFP FP_Reinterpret{}) = True   -- generates a memcpy instead; no simple assignment         doNotAssign _                         = False  -- generates simple assignment -        rhs = p op (map (showSW cfg consts) opArgs)+        rhs = p op (map (showSV cfg consts) opArgs)          rtc = cgRTC cfg @@ -687,9 +690,9 @@                   ]          -- see if we can find a constant shift; makes the output way more readable-        getShiftAmnt def [_, sw] = case sw `lookup` consts of-                                    Just (CW _  (CWInteger i)) -> integer i-                                    _                          -> def+        getShiftAmnt def [_, sv] = case sv `lookup` consts of+                                    Just (CV _  (CInteger i)) -> integer i+                                    _                         -> def         getShiftAmnt def _       = def          p :: Op -> [Doc] -> Doc@@ -719,32 +722,38 @@           | needsCheckL                = cndLkUp checkLeft           | needsCheckR                = cndLkUp checkRight           | True                       = lkUp-          where [index, defVal] = map (showSW cfg consts) [ind, def]-                lkUp = text "table" P.<> int t P.<> brackets (showSW cfg consts ind)+          where [index, defVal] = map (showSV cfg consts) [ind, def]++                lkUp = text "table" P.<> int t P.<> brackets (showSV cfg consts ind)                 cndLkUp cnd = cnd <+> text "?" <+> defVal <+> text ":" <+> lkUp+                 checkLeft  = index <+> text "< 0"                 checkRight = index <+> text ">=" <+> int len                 checkBoth  = parens (checkLeft <+> text "||" <+> checkRight)+                 canOverflow True  sz = (2::Integer)^(sz-1)-1 >= fromIntegral len                 canOverflow False sz = (2::Integer)^sz    -1 >= fromIntegral len+                 (needsCheckL, needsCheckR) = case k of-                                               KBool           -> (False, canOverflow False (1::Int))-                                               KBounded sg sz  -> (sg, canOverflow sg sz)-                                               KReal           -> die "array index with real value"-                                               KFloat          -> die "array index with float value"-                                               KDouble         -> die "array index with double value"-                                               KString         -> die "array index with string value"-                                               KChar           -> die "array index with character value"-                                               KUnbounded      -> case cgInteger cfg of-                                                                    Nothing -> (True, True) -- won't matter, it'll be rejected later-                                                                    Just i  -> (True, canOverflow True i)-                                               KList     s     -> die $ "List sort " ++ show s-                                               KUserSort s _   -> die $ "Uninterpreted sort: " ++ s+                                               KBool              -> (False, canOverflow False (1::Int))+                                               KBounded sg sz     -> (sg, canOverflow sg sz)+                                               KReal              -> die "array index with real value"+                                               KFloat             -> die "array index with float value"+                                               KDouble            -> die "array index with double value"+                                               KString            -> die "array index with string value"+                                               KChar              -> die "array index with character value"+                                               KUnbounded         -> case cgInteger cfg of+                                                                       Nothing -> (True, True) -- won't matter, it'll be rejected later+                                                                       Just i  -> (True, canOverflow True i)+                                               KList     s        -> die $ "List sort " ++ show s+                                               KTuple    s        -> die $ "Tuple sort " ++ show s+                                               KUninterpreted s _ -> die $ "Uninterpreted sort: " ++ s+         -- Div/Rem should be careful on 0, in the SBV world x `div` 0 is 0, x `rem` 0 is x         -- NB: Quot is supposed to truncate toward 0; Not clear to me if C guarantees this behavior.         -- Brief googling suggests C99 does indeed truncate toward 0, but other C compilers might differ.         p Quot [a, b] = let k = kindOf (head opArgs)-                            z = mkConst cfg $ mkConstCW k (0::Integer)+                            z = mkConst cfg $ mkConstCV k (0::Integer)                         in protectDiv0 k "/" z a b         p Rem  [a, b] = protectDiv0 (kindOf (head opArgs)) "%" a a b         p UNeg [a]    = parens (text "-" <+> a)
Data/SBV/Compilers/CodeGen.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Compilers.CodeGen--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Compilers.CodeGen+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Code generation utilities -----------------------------------------------------------------------------@@ -41,8 +41,7 @@         ) where  import Control.Monad             (filterM, replicateM, unless)-import Control.Monad.Reader      (ask)-import Control.Monad.Trans       (MonadIO, lift, liftIO)+import Control.Monad.Trans       (MonadIO(liftIO), lift) import Control.Monad.State.Lazy  (MonadState, StateT(..), modify') import Data.Char                 (toLower, isSpace) import Data.List                 (nub, isPrefixOf, intercalate, (\\))@@ -54,7 +53,7 @@ import qualified Text.PrettyPrint.HughesPJ as P (render)  import Data.SBV.Core.Data-import Data.SBV.Core.Symbolic (svToSymSW, svMkSymVar, outputSVal)+import Data.SBV.Core.Symbolic (MonadSymbolic(..), svToSymSV, svMkSymVar, outputSVal)  #if MIN_VERSION_base(4,11,0) import Control.Monad.Fail as Fail@@ -90,8 +89,8 @@                            }  -- | Abstraction of target language values-data CgVal = CgAtomic SW-           | CgArray  [SW]+data CgVal = CgAtomic SV+           | CgArray  [SV]  -- | Code-generation state data CgState = CgState {@@ -121,6 +120,7 @@ -- and return values. newtype SBVCodeGen a = SBVCodeGen (StateT CgState Symbolic a)                    deriving ( Applicative, Functor, Monad, MonadIO, MonadState CgState+                            , MonadSymbolic #if MIN_VERSION_base(4,11,0)                             , Fail.MonadFail #endif@@ -130,10 +130,6 @@ cgSym :: Symbolic a -> SBVCodeGen a cgSym = SBVCodeGen . lift --- | Reach into symbolic monad and output a value. Returns the corresponding SW-cgSBVToSW :: SBV a -> SBVCodeGen SW-cgSBVToSW = cgSym . sbvToSymSW- -- | Sets RTC (run-time-checks) for index-out-of-bounds, shift-with-large value etc. on/off. Default: 'False'. cgPerformRTCs :: Bool -> SBVCodeGen () cgPerformRTCs b = modify' (\s -> s { cgFinalConfig = (cgFinalConfig s) { cgRTC = b } })@@ -210,93 +206,93 @@  -- | Creates an atomic input in the generated code. svCgInput :: Kind -> String -> SBVCodeGen SVal-svCgInput k nm = do r  <- cgSym (ask >>= liftIO . svMkSymVar (Just ALL) k Nothing)-                    sw <- cgSym (svToSymSW r)-                    modify' (\s -> s { cgInputs = (nm, CgAtomic sw) : cgInputs s })+svCgInput k nm = do r  <- symbolicEnv >>= liftIO . svMkSymVar (Just ALL) k Nothing+                    sv <- svToSymSV r+                    modify' (\s -> s { cgInputs = (nm, CgAtomic sv) : cgInputs s })                     return r  -- | Creates an array input in the generated code. svCgInputArr :: Kind -> Int -> String -> SBVCodeGen [SVal] svCgInputArr k sz nm   | sz < 1 = error $ "SBV.cgInputArr: Array inputs must have at least one element, given " ++ show sz ++ " for " ++ show nm-  | True   = do rs  <- cgSym $ ask >>= liftIO . replicateM sz . svMkSymVar (Just ALL) k Nothing-                sws <- cgSym $ mapM svToSymSW rs+  | True   = do rs  <- symbolicEnv >>= liftIO . replicateM sz . svMkSymVar (Just ALL) k Nothing+                sws <- mapM svToSymSV rs                 modify' (\s -> s { cgInputs = (nm, CgArray sws) : cgInputs s })                 return rs  -- | Creates an atomic output in the generated code. svCgOutput :: String -> SVal -> SBVCodeGen ()-svCgOutput nm v = do _ <- cgSym (outputSVal v)-                     sw <- cgSym (svToSymSW v)-                     modify' (\s -> s { cgOutputs = (nm, CgAtomic sw) : cgOutputs s })+svCgOutput nm v = do _ <- outputSVal v+                     sv <- svToSymSV v+                     modify' (\s -> s { cgOutputs = (nm, CgAtomic sv) : cgOutputs s })  -- | Creates an array output in the generated code. svCgOutputArr :: String -> [SVal] -> SBVCodeGen () svCgOutputArr nm vs   | sz < 1 = error $ "SBV.cgOutputArr: Array outputs must have at least one element, received " ++ show sz ++ " for " ++ show nm-  | True   = do _ <- cgSym (mapM outputSVal vs)-                sws <- cgSym (mapM svToSymSW vs)+  | True   = do mapM_ outputSVal vs+                sws <- mapM svToSymSV vs                 modify' (\s -> s { cgOutputs = (nm, CgArray sws) : cgOutputs s })   where sz = length vs  -- | Creates a returned (unnamed) value in the generated code. svCgReturn :: SVal -> SBVCodeGen ()-svCgReturn v = do _ <- cgSym (outputSVal v)-                  sw <- cgSym (svToSymSW v)-                  modify' (\s -> s { cgReturns = CgAtomic sw : cgReturns s })+svCgReturn v = do _ <- outputSVal v+                  sv <- svToSymSV v+                  modify' (\s -> s { cgReturns = CgAtomic sv : cgReturns s })  -- | Creates a returned (unnamed) array value in the generated code. svCgReturnArr :: [SVal] -> SBVCodeGen () svCgReturnArr vs   | sz < 1 = error $ "SBV.cgReturnArr: Array returns must have at least one element, received " ++ show sz-  | True   = do _ <- cgSym (mapM outputSVal vs)-                sws <- cgSym (mapM svToSymSW vs)+  | True   = do mapM_ outputSVal vs+                sws <- mapM svToSymSV vs                 modify' (\s -> s { cgReturns = CgArray sws : cgReturns s })   where sz = length vs  -- | Creates an atomic input in the generated code.-cgInput :: SymWord a => String -> SBVCodeGen (SBV a)-cgInput nm = do r <- cgSym forall_-                sw <- cgSBVToSW r-                modify' (\s -> s { cgInputs = (nm, CgAtomic sw) : cgInputs s })+cgInput :: SymVal a => String -> SBVCodeGen (SBV a)+cgInput nm = do r <- forall_+                sv <- sbvToSymSV r+                modify' (\s -> s { cgInputs = (nm, CgAtomic sv) : cgInputs s })                 return r  -- | Creates an array input in the generated code.-cgInputArr :: SymWord a => Int -> String -> SBVCodeGen [SBV a]+cgInputArr :: SymVal a => Int -> String -> SBVCodeGen [SBV a] cgInputArr sz nm   | sz < 1 = error $ "SBV.cgInputArr: Array inputs must have at least one element, given " ++ show sz ++ " for " ++ show nm-  | True   = do rs <- cgSym $ mapM (const forall_) [1..sz]-                sws <- mapM cgSBVToSW rs+  | True   = do rs <- mapM (const forall_) [1..sz]+                sws <- mapM sbvToSymSV rs                 modify' (\s -> s { cgInputs = (nm, CgArray sws) : cgInputs s })                 return rs  -- | Creates an atomic output in the generated code. cgOutput :: String -> SBV a -> SBVCodeGen ()-cgOutput nm v = do _ <- cgSym (output v)-                   sw <- cgSBVToSW v-                   modify' (\s -> s { cgOutputs = (nm, CgAtomic sw) : cgOutputs s })+cgOutput nm v = do _ <- output v+                   sv <- sbvToSymSV v+                   modify' (\s -> s { cgOutputs = (nm, CgAtomic sv) : cgOutputs s })  -- | Creates an array output in the generated code.-cgOutputArr :: SymWord a => String -> [SBV a] -> SBVCodeGen ()+cgOutputArr :: SymVal a => String -> [SBV a] -> SBVCodeGen () cgOutputArr nm vs   | sz < 1 = error $ "SBV.cgOutputArr: Array outputs must have at least one element, received " ++ show sz ++ " for " ++ show nm-  | True   = do _ <- cgSym (mapM output vs)-                sws <- mapM cgSBVToSW vs+  | True   = do mapM_ output vs+                sws <- mapM sbvToSymSV vs                 modify' (\s -> s { cgOutputs = (nm, CgArray sws) : cgOutputs s })   where sz = length vs  -- | Creates a returned (unnamed) value in the generated code. cgReturn :: SBV a -> SBVCodeGen ()-cgReturn v = do _ <- cgSym (output v)-                sw <- cgSBVToSW v-                modify' (\s -> s { cgReturns = CgAtomic sw : cgReturns s })+cgReturn v = do _ <- output v+                sv <- sbvToSymSV v+                modify' (\s -> s { cgReturns = CgAtomic sv : cgReturns s })  -- | Creates a returned (unnamed) array value in the generated code.-cgReturnArr :: SymWord a => [SBV a] -> SBVCodeGen ()+cgReturnArr :: SymVal a => [SBV a] -> SBVCodeGen () cgReturnArr vs   | sz < 1 = error $ "SBV.cgReturnArr: Array returns must have at least one element, received " ++ show sz-  | True   = do _ <- cgSym (mapM output vs)-                sws <- mapM cgSBVToSW vs+  | True   = do mapM_ output vs+                sws <- mapM sbvToSymSV vs                 modify' (\s -> s { cgReturns = CgArray sws : cgReturns s })   where sz = length vs
Data/SBV/Control.hs view
@@ -1,21 +1,22 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Control--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Control+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Control sublanguage for interacting with SMT solvers. ----------------------------------------------------------------------------- -{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE NamedFieldPuns  #-}  module Data.SBV.Control (      -- $queryIntro       -- * User queries-       Query, query+       ExtractIO(..), MonadQuery(..), Queriable(..), Query, query       -- * Create a fresh variable      , freshVar_, freshVar@@ -24,11 +25,11 @@      , freshArray_, freshArray       -- * Checking satisfiability-     , CheckSatResult(..), checkSat, checkSatUsing, checkSatAssuming, checkSatAssumingWithUnsatisfiableSet+     , CheckSatResult(..), checkSat, ensureSat, checkSatUsing, checkSatAssuming, checkSatAssumingWithUnsatisfiableSet       -- * Querying the solver      -- ** Extracting values-     , SMTValue(..), getValue, getUninterpretedValue, getModel, getAssignment, getSMTResult, getUnknownReason+     , SMTValue(..), getValue, getUninterpretedValue, getModel, getAssignment, getSMTResult, getUnknownReason, getObservables       -- ** Extracting the unsat core      , getUnsatCore@@ -75,14 +76,33 @@      ) where  import Data.SBV.Core.Data     (SMTConfig(..))-import Data.SBV.Core.Symbolic (Query, Symbolic, Query(..), QueryContext(..))+import Data.SBV.Core.Symbolic (MonadQuery(..), Query, Queriable(..), Symbolic, QueryContext(..)) -import Data.SBV.Control.Query-import Data.SBV.Control.Utils (SMTValue(..), queryDebug, executeQuery)+import Data.SBV.Control.BaseIO+import Data.SBV.Control.Query hiding (  getInfo, getOption, getUnknownReason, getObservables+                                      , getSMTResult, getLexicographicOptResults+                                      , getIndependentOptResults+                                      , getParetoOptResults, getModel+                                      , checkSatAssuming+                                      , checkSatAssumingWithUnsatisfiableSet+                                      , getAssertionStackDepth+                                      , inNewAssertionStack, push, pop+                                      , caseSplit, resetAssertions, echo, exit+                                      , getUnsatCore, getProof, getInterpolant+                                      , getAssertions, getAssignment+                                      , mkSMTResult, freshVar_, freshVar+                                      , freshArray, freshArray_, checkSat, ensureSat+                                      , checkSatUsing, getValue+                                      , getUninterpretedValue, timeout, io)+import Data.SBV.Control.Utils (SMTValue) +import Data.SBV.Utils.ExtractIO (ExtractIO(..))++import qualified Data.SBV.Control.Utils as Trans+ -- | Run a custom query query :: Query a -> Symbolic a-query = executeQuery QueryExternal+query = Trans.executeQuery QueryExternal  {- $queryIntro In certain cases, the user might want to take over the communication with the solver, programmatically
+ Data/SBV/Control/BaseIO.hs view
@@ -0,0 +1,448 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Control.BaseIO+-- Author    : Brian Schroeder, Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Monomorphized versions of functions for simplified client use via+-- @Data.SBV.Control@, where we restrict the underlying monad to be IO.+-----------------------------------------------------------------------------++module Data.SBV.Control.BaseIO where++import Data.SBV.Control.Query (Assignment)+import Data.SBV.Control.Types (CheckSatResult, SMTInfoFlag, SMTInfoResponse, SMTOption, SMTReasonUnknown)+import Data.SBV.Control.Utils (SMTValue)+import Data.SBV.Core.Concrete (CV)+import Data.SBV.Core.Data     (HasKind, Symbolic, SymArray, SymVal, SBool, SBV)+import Data.SBV.Core.Symbolic (Query, QueryContext, QueryState, State, SMTModel, SMTResult, SV)++import qualified Data.SBV.Control.Query as Trans+import qualified Data.SBV.Control.Utils as Trans++-- Data.SBV.Control.Query++-- | Ask solver for info.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getInfo'+getInfo :: SMTInfoFlag -> Query SMTInfoResponse+getInfo = Trans.getInfo++-- | Retrieve the value of an 'SMTOption.' The curious function argument is on purpose here,+-- simply pass the constructor name. Example: the call @'getOption' 'Data.SBV.Control.ProduceUnsatCores'@ will return+-- either @Nothing@ or @Just (ProduceUnsatCores True)@ or @Just (ProduceUnsatCores False)@.+--+-- Result will be 'Nothing' if the solver does not support this option.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getOption'+getOption :: (a -> SMTOption) -> Query (Maybe SMTOption)+getOption = Trans.getOption++-- | Get the reason unknown. Only internally used.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getUnknownReason'+getUnknownReason :: Query SMTReasonUnknown+getUnknownReason = Trans.getUnknownReason++-- | Get the observables recorded during a query run.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getObservables'+getObservables :: Query [(String, CV)]+getObservables = Trans.getObservables++-- | Issue check-sat and get an SMT Result out.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getSMTResult'+getSMTResult :: Query SMTResult+getSMTResult = Trans.getSMTResult++-- | Issue check-sat and get results of a lexicographic optimization.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getLexicographicOptResults'+getLexicographicOptResults :: Query SMTResult+getLexicographicOptResults = Trans.getLexicographicOptResults++-- | Issue check-sat and get results of an independent (boxed) optimization.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getIndependentOptResults'+getIndependentOptResults :: [String] -> Query [(String, SMTResult)]+getIndependentOptResults = Trans.getIndependentOptResults++-- | Construct a pareto-front optimization result+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getParetoOptResults'+getParetoOptResults :: Maybe Int -> Query (Bool, [SMTResult])+getParetoOptResults = Trans.getParetoOptResults++-- | Collect model values. It is implicitly assumed that we are in a check-sat+-- context. See 'getSMTResult' for a variant that issues a check-sat first and+-- returns an 'SMTResult'.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getModel'+getModel :: Query SMTModel+getModel = Trans.getModel++-- | Check for satisfiability, under the given conditions. Similar to 'Data.SBV.Control.checkSat' except it allows making+-- further assumptions as captured by the first argument of booleans. (Also see 'checkSatAssumingWithUnsatisfiableSet'+-- for a variant that returns the subset of the given assumptions that led to the 'Data.SBV.Control.Unsat' conclusion.)+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.checkSatAssuming'+checkSatAssuming :: [SBool] -> Query CheckSatResult+checkSatAssuming = Trans.checkSatAssuming++-- | Check for satisfiability, under the given conditions. Returns the unsatisfiable+-- set of assumptions. Similar to 'Data.SBV.Control.checkSat' except it allows making further assumptions+-- as captured by the first argument of booleans. If the result is 'Data.SBV.Control.Unsat', the user will+-- also receive a subset of the given assumptions that led to the 'Data.SBV.Control.Unsat' conclusion. Note+-- that while this set will be a subset of the inputs, it is not necessarily guaranteed to be minimal.+--+-- You must have arranged for the production of unsat assumptions+-- first via+--+-- @+--     'Data.SBV.setOption' $ 'Data.SBV.Control.ProduceUnsatAssumptions' 'True'+-- @+--+-- for this call to not error out!+--+-- Usage note: 'getUnsatCore' is usually easier to use than 'checkSatAssumingWithUnsatisfiableSet', as it+-- allows the use of named assertions, as obtained by 'Data.SBV.namedConstraint'. If 'getUnsatCore'+-- fills your needs, you should definitely prefer it over 'checkSatAssumingWithUnsatisfiableSet'.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.checkSatAssumingWithUnsatisfiableSet'+checkSatAssumingWithUnsatisfiableSet :: [SBool] -> Query (CheckSatResult, Maybe [SBool])+checkSatAssumingWithUnsatisfiableSet = Trans.checkSatAssumingWithUnsatisfiableSet++-- | The current assertion stack depth, i.e., #push - #pops after start. Always non-negative.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getAssertionStackDepth'+getAssertionStackDepth :: Query Int+getAssertionStackDepth = Trans.getAssertionStackDepth++-- | Run the query in a new assertion stack. That is, we push the context, run the query+-- commands, and pop it back.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.inNewAssertionStack'+inNewAssertionStack :: Query a -> Query a+inNewAssertionStack = Trans.inNewAssertionStack++-- | Push the context, entering a new one. Pushes multiple levels if /n/ > 1.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.push'+push :: Int -> Query ()+push = Trans.push++-- | Pop the context, exiting a new one. Pops multiple levels if /n/ > 1. It's an error to pop levels that don't exist.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.pop'+pop :: Int -> Query ()+pop = Trans.pop++-- | Search for a result via a sequence of case-splits, guided by the user. If one of+-- the conditions lead to a satisfiable result, returns @Just@ that result. If none of them+-- do, returns @Nothing@. Note that we automatically generate a coverage case and search+-- for it automatically as well. In that latter case, the string returned will be "Coverage".+-- The first argument controls printing progress messages  See "Documentation.SBV.Examples.Queries.CaseSplit"+-- for an example use case.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.caseSplit'+caseSplit :: Bool -> [(String, SBool)] -> Query (Maybe (String, SMTResult))+caseSplit = Trans.caseSplit++-- | Reset the solver, by forgetting all the assertions. However, bindings are kept as is,+-- as opposed to a full reset of the solver. Use this variant to clean-up the solver+-- state while leaving the bindings intact. Pops all assertion levels. Declarations and+-- definitions resulting from the 'Data.SBV.setLogic' command are unaffected. Note that SBV+-- implicitly uses global-declarations, so bindings will remain intact.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.resetAssertions'+resetAssertions :: Query ()+resetAssertions = Trans.resetAssertions++-- | Echo a string. Note that the echoing is done by the solver, not by SBV.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.echo'+echo :: String -> Query ()+echo = Trans.echo++-- | Exit the solver. This action will cause the solver to terminate. Needless to say,+-- trying to communicate with the solver after issuing "exit" will simply fail.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.exit'+exit :: Query ()+exit = Trans.exit++-- | Retrieve the unsat-core. Note you must have arranged for+-- unsat cores to be produced first via+--+-- @+--     'Data.SBV.setOption' $ 'Data.SBV.Control.ProduceUnsatCores' 'True'+-- @+--+-- for this call to not error out!+--+-- NB. There is no notion of a minimal unsat-core, in case unsatisfiability can be derived+-- in multiple ways. Furthermore, Z3 does not guarantee that the generated unsat+-- core does not have any redundant assertions either, as doing so can incur a performance penalty.+-- (There might be assertions in the set that is not needed.) To ensure all the assertions+-- in the core are relevant, use:+--+-- @+--     'Data.SBV.setOption' $ 'Data.SBV.Control.OptionKeyword' ":smt.core.minimize" ["true"]+-- @+--+-- Note that this only works with Z3.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getUnsatCore'+getUnsatCore :: Query [String]+getUnsatCore = Trans.getUnsatCore++-- | Retrieve the proof. Note you must have arranged for+-- proofs to be produced first via+--+-- @+--     'Data.SBV.setOption' $ 'Data.SBV.Control.ProduceProofs' 'True'+-- @+--+-- for this call to not error out!+--+-- A proof is simply a 'String', as returned by the solver. In the future, SBV might+-- provide a better datatype, depending on the use cases. Please get in touch if you+-- use this function and can suggest a better API.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getProof'+getProof :: Query String+getProof = Trans.getProof++-- | Retrieve an interpolant after an 'Data.SBV.Control.Unsat' result is obtained. Note you must have arranged for+-- interpolants to be produced first via+--+-- @+--     'Data.SBV.setOption' $ 'Data.SBV.Control.ProduceInterpolants' 'True'+-- @+--+-- for this call to not error out!+--+-- To get an interpolant for a pair of formulas @A@ and @B@, use a 'Data.SBV.constrainWithAttribute' call to attach+-- interplation groups to @A@ and @B@. Then call 'getInterpolant' @[\"A\"]@, assuming those are the names+-- you gave to the formulas in the @A@ group.+--+-- An interpolant for @A@ and @B@ is a formula @I@ such that:+--+-- @+--        A .=> I+--    and B .=> sNot I+-- @+--+-- That is, it's evidence that @A@ and @B@ cannot be true together+-- since @A@ implies @I@ but @B@ implies @not I@; establishing that @A@ and @B@ cannot+-- be satisfied at the same time. Furthermore, @I@ will have only the symbols that are common+-- to @A@ and @B@.+--+-- N.B. As of Z3 version 4.8.0; Z3 no longer supports interpolants. Use the MathSAT backend for extracting+-- interpolants. See "Documentation.SBV.Examples.Queries.Interpolants" for an example.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getInterpolant'+getInterpolant :: [String] -> Query String+getInterpolant = Trans.getInterpolant++-- | Retrieve assertions. Note you must have arranged for+-- assertions to be available first via+--+-- @+--     'Data.SBV.setOption' $ 'Data.SBV.Control.ProduceAssertions' 'True'+-- @+--+-- for this call to not error out!+--+-- Note that the set of assertions returned is merely a list of strings, just like the+-- case for 'getProof'. In the future, SBV might provide a better datatype, depending+-- on the use cases. Please get in touch if you use this function and can suggest+-- a better API.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getAssertions'+getAssertions :: Query [String]+getAssertions = Trans.getAssertions++-- | Retrieve the assignment. This is a lightweight version of 'getValue', where the+-- solver returns the truth value for all named subterms of type 'Bool'.+--+-- You must have first arranged for assignments to be produced via+--+-- @+--     'Data.SBV.setOption' $ 'Data.SBV.Control.ProduceAssignments' 'True'+-- @+--+-- for this call to not error out!+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getAssignment'+getAssignment :: Query [(String, Bool)]+getAssignment = Trans.getAssignment++-- | Produce the query result from an assignment.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.mkSMTResult'+mkSMTResult :: [Assignment] -> Query SMTResult+mkSMTResult = Trans.mkSMTResult++-- Data.SBV.Control.Utils++-- | Perform an arbitrary IO action.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.io'+io :: IO a -> Query a+io = Trans.io++-- | Modify the query state+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.modifyQueryState'+modifyQueryState :: (QueryState -> QueryState) -> Query ()+modifyQueryState = Trans.modifyQueryState++-- | Execute in a new incremental context+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.inNewContext'+inNewContext :: (State -> IO a) -> Query a+inNewContext = Trans.inNewContext++-- | Similar to 'freshVar', except creates unnamed variable.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.freshVar_'+freshVar_ :: SymVal a => Query (SBV a)+freshVar_ = Trans.freshVar_++-- | Create a fresh variable in query mode. You should prefer+-- creating input variables using 'Data.SBV.sBool', 'Data.SBV.sInt32', etc., which act+-- as primary inputs to the model and can be existential or universal.+-- Use 'freshVar' only in query mode for anonymous temporary variables.+-- Such variables are always existential. Note that 'freshVar' should hardly be+-- needed: Your input variables and symbolic expressions should suffice for+-- most major use cases.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.freshVar'+freshVar :: SymVal a => String -> Query (SBV a)+freshVar = Trans.freshVar++-- | Similar to 'freshArray', except creates unnamed array.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.freshArray_'+freshArray_ :: (SymArray array, HasKind a, HasKind b) => Maybe (SBV b) -> Query (array a b)+freshArray_ = Trans.freshArray_++-- | Create a fresh array in query mode. Again, you should prefer+-- creating arrays before the queries start using 'Data.SBV.newArray', but this+-- method can come in handy in occasional cases where you need a new array+-- after you start the query based interaction.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.freshArray'+freshArray :: (SymArray array, HasKind a, HasKind b) => String -> Maybe (SBV b) -> Query (array a b)+freshArray = Trans.freshArray++-- | If 'Data.SBV.verbose' is 'True', print the message, useful for debugging messages+-- in custom queries. Note that 'Data.SBV.redirectVerbose' will be respected: If a+-- file redirection is given, the output will go to the file.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.queryDebug'+queryDebug :: [String] -> Query ()+queryDebug = Trans.queryDebug++-- | Send a string to the solver, and return the response+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.ask'+ask :: String -> Query String+ask = Trans.ask++-- | Send a string to the solver. If the first argument is 'True', we will require+-- a "success" response as well. Otherwise, we'll fire and forget.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.send'+send :: Bool -> String -> Query ()+send = Trans.send++-- | Retrieve a responses from the solver until it produces a synchronization tag. We make the tag+-- unique by attaching a time stamp, so no need to worry about getting the wrong tag unless it happens+-- in the very same picosecond! We return multiple valid s-expressions till the solver responds with the tag.+-- Should only be used for internal tasks or when we want to synchronize communications, and not on a+-- regular basis! Use 'send'/'ask' for that purpose. This comes in handy, however, when solvers respond+-- multiple times as in optimization for instance, where we both get a check-sat answer and some objective values.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.retrieveResponse'+retrieveResponse :: String -> Maybe Int -> Query [String]+retrieveResponse = Trans.retrieveResponse++-- | Get the value of a term.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getValue'+getValue :: SMTValue a => SBV a -> Query a+getValue = Trans.getValue++-- | Get the value of an uninterpreted sort, as a String+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getUninterpretedValue'+getUninterpretedValue :: HasKind a => SBV a -> Query String+getUninterpretedValue = Trans.getUninterpretedValue++-- | Get the value of a term. If the kind is Real and solver supports decimal approximations,+-- we will "squash" the representations.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getValueCV'+getValueCV :: Maybe Int -> SV -> Query CV+getValueCV = Trans.getValueCV++-- | Check for satisfiability.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.checkSat'+checkSat :: Query CheckSatResult+checkSat = Trans.checkSat++-- | Ensure that the current context is satisfiable. If not, this function will throw an error.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.ensureSat'+ensureSat :: Query ()+ensureSat = Trans.ensureSat++-- | Check for satisfiability with a custom check-sat-using command.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.checkSatUsing'+checkSatUsing :: String -> Query CheckSatResult+checkSatUsing = Trans.checkSatUsing++-- | Retrieve the set of unsatisfiable assumptions, following a call to 'Data.SBV.Control.checkSatAssumingWithUnsatisfiableSet'. Note that+-- this function isn't exported to the user, but rather used internally. The user simple calls 'Data.SBV.Control.checkSatAssumingWithUnsatisfiableSet'.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.getUnsatAssumptions'+getUnsatAssumptions :: [String] -> [(String, a)] -> Query [a]+getUnsatAssumptions = Trans.getUnsatAssumptions++-- | Timeout a query action, typically a command call to the underlying SMT solver.+-- The duration is in microseconds (@1\/10^6@ seconds). If the duration+-- is negative, then no timeout is imposed. When specifying long timeouts, be careful not to exceed+-- @maxBound :: Int@. (On a 64 bit machine, this bound is practically infinite. But on a 32 bit+-- machine, it corresponds to about 36 minutes!)+--+-- Semantics: The call @timeout n q@ causes the timeout value to be applied to all interactive calls that take place+-- as we execute the query @q@. That is, each call that happens during the execution of @q@ gets a separate+-- time-out value, as opposed to one timeout value that limits the whole query. This is typically the intended behavior.+-- It is advisible to apply this combinator to calls that involve a single call to the solver for+-- finer control, as opposed to an entire set of interactions. However, different use cases might call for different scenarios.+--+-- If the solver responds within the time-out specified, then we continue as usual. However, if the backend solver times-out+-- using this mechanism, there is no telling what the state of the solver will be. Thus, we raise an error in this case.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.timeout'+timeout :: Int -> Query a -> Query a+timeout = Trans.timeout++-- | Bail out if we don't get what we expected+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.unexpected'+unexpected :: String -> String -> String -> Maybe [String] -> String -> Maybe [String] -> Query a+unexpected = Trans.unexpected++-- | Execute a query.+--+-- NB. For a version which generalizes over the underlying monad, see 'Data.SBV.Trans.Control.executeQuery'+executeQuery :: QueryContext -> Query a -> Symbolic a+executeQuery = Trans.executeQuery
Data/SBV/Control/Query.hs view
@@ -1,18 +1,19 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Control.Query--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Control.Query+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Querying a solver interactively. ----------------------------------------------------------------------------- -{-# LANGUAGE LambdaCase     #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TupleSections  #-}-{-# LANGUAGE Rank2Types     #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE NamedFieldPuns      #-}+{-# LANGUAGE Rank2Types          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-}  {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -21,7 +22,7 @@      , CheckSatResult(..), checkSat, checkSatUsing, checkSatAssuming, checkSatAssumingWithUnsatisfiableSet      , getUnsatCore, getProof, getInterpolant, getAssignment, getOption, freshVar, freshVar_, freshArray, freshArray_, push, pop, getAssertionStackDepth      , inNewAssertionStack, echo, caseSplit, resetAssertions, exit, getAssertions, getValue, getUninterpretedValue, getModel, getSMTResult-     , getLexicographicOptResults, getIndependentOptResults, getParetoOptResults, getAllSatResult, getUnknownReason+     , getLexicographicOptResults, getIndependentOptResults, getParetoOptResults, getAllSatResult, getUnknownReason, getObservables, ensureSat      , SMTOption(..), SMTInfoFlag(..), SMTErrorBehavior(..), SMTReasonUnknown(..), SMTInfoResponse(..), getInfo      , Logic(..), Assignment(..)      , ignoreExitCode, timeout@@ -31,7 +32,7 @@      ) where  import Control.Monad            (unless, when, zipWithM)-import Control.Monad.State.Lazy (get)+import Control.Monad.IO.Class   (MonadIO)  import Data.IORef (readIORef) @@ -40,22 +41,21 @@   import Data.Char     (toLower)-import Data.List     (unzip3, intercalate, nubBy, sortBy)+import Data.List     (unzip3, intercalate, nubBy, sortBy, sortOn) import Data.Maybe    (listToMaybe, catMaybes) import Data.Function (on)  import Data.SBV.Core.Data -import Data.SBV.Core.Symbolic   (QueryState(..), Query(..), SMTModel(..), SMTResult(..), State(..), incrementInternalCounter)+import Data.SBV.Core.Symbolic   (MonadQuery(..), QueryState(..), SMTModel(..), SMTResult(..), State(..), incrementInternalCounter)  import Data.SBV.Utils.SExpr-import Data.SBV.Utils.Boolean  import Data.SBV.Control.Types import Data.SBV.Control.Utils  -- | An Assignment of a model binding-data Assignment = Assign SVal CW+data Assignment = Assign SVal CV  -- Remove one pair of surrounding 'c's, if present noSurrounding :: Char -> String -> String@@ -101,8 +101,8 @@           | i < 0 = "(- " ++ show (-i) ++ ")"           | True  = show i --- | Ask solver for info.-getInfo :: SMTInfoFlag -> Query SMTInfoResponse+-- | Generalization of 'Data.SBV.Control.getInfo'+getInfo :: (MonadIO m, MonadQuery m) => SMTInfoFlag -> m SMTInfoResponse getInfo flag = do     let cmd = "(get-info " ++ show flag ++ ")"         bad = unexpected "getInfo" cmd "a valid get-info response" Nothing@@ -153,12 +153,8 @@                          , ("timeout",    UnknownTimeOut)                          ] --- | Retrieve the value of an 'SMTOption.' The curious function argument is on purpose here,--- simply pass the constructor name. Example: the call @'getOption' 'ProduceUnsatCores'@ will return--- either @Nothing@ or @Just (ProduceUnsatCores True)@ or @Just (ProduceUnsatCores False)@.------ Result will be 'Nothing' if the solver does not support this option.-getOption :: (a -> SMTOption) -> Query (Maybe SMTOption)+-- | Generalization of 'Data.SBV.Control.getInfo'+getOption :: (MonadIO m, MonadQuery m) => (a -> SMTOption) -> m (Maybe SMTOption) getOption f = case f undefined of                  DiagnosticOutputChannel{}   -> askFor "DiagnosticOutputChannel"   ":diagnostic-output-channel"   $ string     DiagnosticOutputChannel                  ProduceAssertions{}         -> askFor "ProduceAssertions"         ":produce-assertions"          $ bool       ProduceAssertions@@ -197,8 +193,8 @@         -- free format, really         stringList c e _ = return $ Just $ c $ stringsOf e --- | Get the reason unknown. Only internally used.-getUnknownReason :: Query SMTReasonUnknown+-- | Generalization of 'Data.SBV.Control.getUnknownReason'+getUnknownReason :: (MonadIO m, MonadQuery m) => m SMTReasonUnknown getUnknownReason = do ru <- getInfo ReasonUnknown                       case ru of                         Resp_Unsupported     -> return $ UnknownOther "Solver responded: Unsupported."@@ -206,8 +202,21 @@                         -- Shouldn't happen, but just in case:                         _                    -> error $ "Unexpected reason value received: " ++ show ru --- | Issue check-sat and get an SMT Result out.-getSMTResult :: Query SMTResult+-- | Generalization of 'Data.SBV.Control.ensureSat'+ensureSat :: (MonadIO m, MonadQuery m) => m ()+ensureSat = do cfg <- getConfig+               cs <- checkSatUsing $ satCmd cfg+               case cs of+                 Sat -> return ()+                 Unk -> do s <- getUnknownReason+                           error $ unlines [ ""+                                           , "*** Data.SBV.ensureSat: Solver reported Unknown!"+                                           , "*** Reason: " ++ show s+                                           ]+                 Unsat -> error "Data.SBV.ensureSat: Solver reported Unsat!"++-- | Generalization of 'Data.SBV.Control.getSMTResult'+getSMTResult :: (MonadIO m, MonadQuery m) => m SMTResult getSMTResult = do cfg <- getConfig                   cs  <- checkSat                   case cs of@@ -217,12 +226,12 @@  -- | Classify a model based on whether it has unbound objectives or not. classifyModel :: SMTConfig -> SMTModel -> SMTResult-classifyModel cfg m = case filter (not . isRegularCW . snd) (modelObjectives m) of+classifyModel cfg m = case filter (not . isRegularCV . snd) (modelObjectives m) of                         [] -> Satisfiable cfg m                         _  -> SatExtField cfg m --- | Issue check-sat and get results of a lexicographic optimization.-getLexicographicOptResults :: Query SMTResult+-- | Generalization of 'Data.SBV.Control.getLexicographicOptResults'+getLexicographicOptResults :: (MonadIO m, MonadQuery m) => m SMTResult getLexicographicOptResults = do cfg <- getConfig                                 cs  <- checkSat                                 case cs of@@ -233,8 +242,8 @@                                      m               <- getModel                                      return m {modelObjectives = objectiveValues} --- | Issue check-sat and get results of an independent (boxed) optimization.-getIndependentOptResults :: [String] -> Query [(String, SMTResult)]+-- | Generalization of 'Data.SBV.Control.getIndependentOptResults'+getIndependentOptResults :: forall m. (MonadIO m, MonadQuery m) => [String] -> m [(String, SMTResult)] getIndependentOptResults objNames = do cfg <- getConfig                                        cs  <- checkSat @@ -248,12 +257,12 @@                                nms <- zipWithM getIndependentResult [0..] objNames                                return [(n, classify (m {modelObjectives = objectiveValues})) | (n, m) <- nms] -        getIndependentResult :: Int -> String -> Query (String, SMTModel)+        getIndependentResult :: Int -> String -> m (String, SMTModel)         getIndependentResult i s = do m <- getModelAtIndex (Just i)                                       return (s, m) --- | Construct a pareto-front optimization result-getParetoOptResults :: Maybe Int -> Query (Bool, [SMTResult])+-- | Generalization of 'Data.SBV.Control.getParetoOptResults'+getParetoOptResults :: (MonadIO m, MonadQuery m) => Maybe Int -> m (Bool, [SMTResult]) getParetoOptResults (Just i)         | i <= 0             = return (True, []) getParetoOptResults mbN      = do cfg <- getConfig@@ -269,7 +278,7 @@                                (limReached, fronts) <- getParetoFronts (subtract 1 <$> mbN) [m]                                return (limReached, reverse (map classify fronts)) -        getParetoFronts :: Maybe Int -> [SMTModel] -> Query (Bool, [SMTModel])+        getParetoFronts :: (MonadIO m, MonadQuery m) => Maybe Int -> [SMTModel] -> m (Bool, [SMTModel])         getParetoFronts (Just i) sofar | i <= 0 = return (True, sofar)         getParetoFronts mbi      sofar          = do cs <- checkSat                                                      let more = getModel >>= \m -> getParetoFronts (subtract 1 <$> mbi) (m : sofar)@@ -278,41 +287,40 @@                                                        Sat   -> more                                                        Unk   -> more --- | Collect model values. It is implicitly assumed that we are in a check-sat--- context. See 'getSMTResult' for a variant that issues a check-sat first and--- returns an 'SMTResult'.-getModel :: Query SMTModel+-- | Generalization of 'Data.SBV.Control.getModel'+getModel :: (MonadIO m, MonadQuery m) => m SMTModel getModel = getModelAtIndex Nothing  -- | Get a model stored at an index. This is likely very Z3 specific!-getModelAtIndex :: Maybe Int -> Query SMTModel+getModelAtIndex :: (MonadIO m, MonadQuery m) => Maybe Int -> m SMTModel getModelAtIndex mbi = do-             State{runMode} <- get-             cfg   <- getConfig-             inps  <- getQuantifiedInputs-             obsvs <- getObservables-             rm    <- io $ readIORef runMode-             let vars :: [NamedSymVar]-                 vars = case rm of-                          m@CodeGen         -> error $ "SBV.getModel: Model is not available in mode: " ++ show m-                          m@Concrete        -> error $ "SBV.getModel: Model is not available in mode: " ++ show m-                          SMTMode _ isSAT _ -> -- for "sat", display the prefix existentials. for "proof", display the prefix universals-                                               let allModelInputs = if isSAT then takeWhile ((/= ALL) . fst) inps-                                                                             else takeWhile ((== ALL) . fst) inps+             State{runMode} <- queryState+             cfg    <- getConfig+             inps   <- getQuantifiedInputs+             obsvs  <- getObservables+             rm     <- io $ readIORef runMode+             assocs <- case rm of+                         m@CodeGen         -> error $ "SBV.getModel: Model is not available in mode: " ++ show m+                         m@Concrete        -> error $ "SBV.getModel: Model is not available in mode: " ++ show m+                         SMTMode _ isSAT _ -> -- for "sat", display the prefix existentials. for "proof", display the prefix universals+                                              let allModelInputs = if isSAT then takeWhile ((/= ALL) . fst) inps+                                                                            else takeWhile ((== ALL) . fst) inps -                                                   -- are we inside a quantifier-                                                   insideQuantifier = length allModelInputs < length inps+                                                  -- are we inside a quantifier+                                                  insideQuantifier = length allModelInputs < length inps -                                                   -- observables are only meaningful if we're not in a quantified context-                                                   allPrefixObservables | insideQuantifier = []-                                                                        | True             = [(EX, (sw, nm)) | (nm, sw) <- obsvs]+                                                  -- observables are only meaningful if we're not in a quantified context+                                                  prefixObservables | insideQuantifier = []+                                                                    | True             = obsvs -                                                   sortByNodeId :: [NamedSymVar] -> [NamedSymVar]-                                                   sortByNodeId = sortBy (compare `on` (\(SW _ n, _) -> n))+                                                  sortByNodeId :: [(NamedSymVar, a)] -> [a]+                                                  sortByNodeId = map snd . sortBy (compare `on` (\((SV _ nid, _), _) -> nid)) -                                               in sortByNodeId [nv | (_, nv@(_, n)) <- allModelInputs ++ allPrefixObservables, not (isNonModelVar cfg n)]+                                                  grab (sv, nm) = ((sv, nm),) <$> getValueCV mbi sv -             assocs <- mapM (\(sw, n) -> (n, ) <$> getValueCW mbi sw) vars+                                              in do inputAssocs <- mapM (grab . snd) allModelInputs+                                                    return $  sortOn fst prefixObservables+                                                           ++ sortByNodeId [(sv, (nm, val)) | (sv@(_, nm), val) <- inputAssocs, not (isNonModelVar cfg nm)]               return SMTModel { modelObjectives = []                              , modelAssocs     = assocs@@ -320,7 +328,7 @@  -- | Just after a check-sat is issued, collect objective values. Used -- internally only, not exposed to the user.-getObjectiveValues :: Query [(String, GeneralizedCW)]+getObjectiveValues :: forall m. (MonadIO m, MonadQuery m) => m [(String, GeneralizedCV)] getObjectiveValues = do let cmd = "(get-objectives)"                              bad = unexpected "getObjectiveValues" cmd "a list of objective values" Nothing@@ -333,7 +341,7 @@                                             _                             -> bad r Nothing    where -- | Parse an objective value out.-        getObjValue :: (forall a. Maybe [String] -> Query a) -> [NamedSymVar] -> SExpr -> Query (Maybe (String, GeneralizedCW))+        getObjValue :: (forall a. Maybe [String] -> m a) -> [NamedSymVar] -> SExpr -> m (Maybe (String, GeneralizedCV))         getObjValue bailOut inputs expr =                 case expr of                   EApp [_]                                            -> return Nothing            -- Happens when a soft-assertion has no associated group.@@ -341,51 +349,51 @@                   EApp [EApp [ECon "bvadd", ECon nm, ENum (a, _)], v] -> locate nm v (Just a)      -- Happens when we "adjust" a signed-bounded objective                   _                                                   -> dontUnderstand (show expr) -          where locate nm v mbAdjust = case listToMaybe [p | p@(sw, _) <- inputs, show sw == nm] of+          where locate nm v mbAdjust = case listToMaybe [p | p@(sv, _) <- inputs, show sv == nm] of                                          Nothing               -> return Nothing -- Happens when the soft assertion has a group-id that's not one of the input names-                                         Just (sw, actualName) -> grab sw v >>= \val -> return $ Just (actualName, signAdjust mbAdjust val)+                                         Just (sv, actualName) -> grab sv v >>= \val -> return $ Just (actualName, signAdjust mbAdjust val)                  dontUnderstand s = bailOut $ Just [ "Unable to understand solver output."                                                   , "While trying to process: " ++ s                                                   ] -                signAdjust :: Maybe Integer -> GeneralizedCW -> GeneralizedCW+                signAdjust :: Maybe Integer -> GeneralizedCV -> GeneralizedCV                 signAdjust Nothing    v = v                 signAdjust (Just adj) e = goG e-                  where goG :: GeneralizedCW -> GeneralizedCW-                        goG (ExtendedCW ecw) = ExtendedCW $ goE ecw-                        goG (RegularCW  cw)  = RegularCW  $ go cw+                  where goG :: GeneralizedCV -> GeneralizedCV+                        goG (ExtendedCV ecv) = ExtendedCV $ goE ecv+                        goG (RegularCV  cv)  = RegularCV  $ go cv -                        goE :: ExtCW -> ExtCW+                        goE :: ExtCV -> ExtCV                         goE (Infinite k)      = Infinite k                         goE (Epsilon  k)      = Epsilon  k                         goE (Interval  lo hi) = Interval  (goE lo) (goE hi)-                        goE (BoundedCW cw)    = BoundedCW (go cw)-                        goE (AddExtCW  a b)   = AddExtCW  (goE a) (goE b)-                        goE (MulExtCW  a b)   = MulExtCW  (goE a) (goE b)+                        goE (BoundedCV cv)    = BoundedCV (go cv)+                        goE (AddExtCV  a b)   = AddExtCV  (goE a) (goE b)+                        goE (MulExtCV  a b)   = MulExtCV  (goE a) (goE b) -                        go :: CW -> CW-                        go cw = case (kindOf cw, cwVal cw) of-                                  (k@(KBounded True _), CWInteger v) -> normCW $ CW k (CWInteger (v - adj))-                                  _                                  -> error $ "SBV.getObjValue: Unexpected cw received! " ++ show cw+                        go :: CV -> CV+                        go cv = case (kindOf cv, cvVal cv) of+                                  (k@(KBounded True _), CInteger v) -> normCV $ CV k (CInteger (v - adj))+                                  _                                 -> error $ "SBV.getObjValue: Unexpected cv received! " ++ show cv -                grab :: SW -> SExpr -> Query GeneralizedCW+                grab :: SV -> SExpr -> m GeneralizedCV                 grab s topExpr-                  | Just v <- recoverKindedValue k topExpr = return $ RegularCW v-                  | True                                   = ExtendedCW <$> cvt (simplify topExpr)+                  | Just v <- recoverKindedValue k topExpr = return $ RegularCV v+                  | True                                   = ExtendedCV <$> cvt (simplify topExpr)                   where k = kindOf s                          -- Convert to an extended expression. Hopefully complete!-                        cvt :: SExpr -> Query ExtCW+                        cvt :: SExpr -> m ExtCV                         cvt (ECon "oo")                    = return $ Infinite  k                         cvt (ECon "epsilon")               = return $ Epsilon   k                         cvt (EApp [ECon "interval", x, y]) =          Interval  <$> cvt x <*> cvt y-                        cvt (ENum    (i, _))               = return $ BoundedCW $ mkConstCW k i-                        cvt (EReal   r)                    = return $ BoundedCW $ CW k $ CWAlgReal r-                        cvt (EFloat  f)                    = return $ BoundedCW $ CW k $ CWFloat   f-                        cvt (EDouble d)                    = return $ BoundedCW $ CW k $ CWDouble  d-                        cvt (EApp [ECon "+", x, y])        =          AddExtCW <$> cvt x <*> cvt y-                        cvt (EApp [ECon "*", x, y])        =          MulExtCW <$> cvt x <*> cvt y+                        cvt (ENum    (i, _))               = return $ BoundedCV $ mkConstCV k i+                        cvt (EReal   r)                    = return $ BoundedCV $ CV k $ CAlgReal r+                        cvt (EFloat  f)                    = return $ BoundedCV $ CV k $ CFloat   f+                        cvt (EDouble d)                    = return $ BoundedCV $ CV k $ CDouble  d+                        cvt (EApp [ECon "+", x, y])        =          AddExtCV <$> cvt x <*> cvt y+                        cvt (EApp [ECon "*", x, y])        =          MulExtCV <$> cvt x <*> cvt y                         -- Nothing else should show up, hopefully!                         cvt e = dontUnderstand (show e) @@ -395,49 +403,30 @@                         simplify (EApp xs)                  = EApp (map simplify xs)                         simplify e                          = e --- | Check for satisfiability, under the given conditions. Similar to 'Data.SBV.Control.checkSat' except it allows making--- further assumptions as captured by the first argument of booleans. (Also see 'checkSatAssumingWithUnsatisfiableSet'--- for a variant that returns the subset of the given assumptions that led to the 'Unsat' conclusion.)-checkSatAssuming :: [SBool] -> Query CheckSatResult+-- | Generalization of 'Data.SBV.Control.checkSatAssuming'+checkSatAssuming :: (MonadIO m, MonadQuery m) => [SBool] -> m CheckSatResult checkSatAssuming sBools = fst <$> checkSatAssumingHelper False sBools --- | Check for satisfiability, under the given conditions. Returns the unsatisfiable--- set of assumptions. Similar to 'Data.SBV.Control.checkSat' except it allows making further assumptions--- as captured by the first argument of booleans. If the result is 'Unsat', the user will--- also receive a subset of the given assumptions that led to the 'Unsat' conclusion. Note--- that while this set will be a subset of the inputs, it is not necessarily guaranteed to be minimal.------ You must have arranged for the production of unsat assumptions--- first via------ @---     'setOption' $ 'ProduceUnsatAssumptions' 'True'--- @------ for this call to not error out!------ Usage note: 'getUnsatCore' is usually easier to use than 'checkSatAssumingWithUnsatisfiableSet', as it--- allows the use of named assertions, as obtained by 'namedConstraint'. If 'getUnsatCore'--- fills your needs, you should definitely prefer it over 'checkSatAssumingWithUnsatisfiableSet'.-checkSatAssumingWithUnsatisfiableSet :: [SBool] -> Query (CheckSatResult, Maybe [SBool])+-- | Generalization of 'Data.SBV.Control.checkSatAssumingWithUnsatisfiableSet'+checkSatAssumingWithUnsatisfiableSet :: (MonadIO m, MonadQuery m) => [SBool] -> m (CheckSatResult, Maybe [SBool]) checkSatAssumingWithUnsatisfiableSet = checkSatAssumingHelper True  -- | Helper for the two variants of checkSatAssuming we have. Internal only.-checkSatAssumingHelper :: Bool -> [SBool] -> Query (CheckSatResult, Maybe [SBool])+checkSatAssumingHelper :: (MonadIO m, MonadQuery m) => Bool -> [SBool] -> m (CheckSatResult, Maybe [SBool]) checkSatAssumingHelper getAssumptions sBools = do         -- sigh.. SMT-Lib requires the values to be literals only. So, create proxies.-        let mkAssumption st = do swsOriginal <- mapM (\sb -> do sw <- sbvToSW st sb-                                                                return (sw, sb)) sBools+        let mkAssumption st = do swsOriginal <- mapM (\sb -> do sv <- sbvToSV st sb+                                                                return (sv, sb)) sBools                                   -- drop duplicates and trues-                                 let swbs = [p | p@(sw, _) <- nubBy ((==) `on` fst) swsOriginal, sw /= trueSW]+                                 let swbs = [p | p@(sv, _) <- nubBy ((==) `on` fst) swsOriginal, sv /= trueSV]                                   -- get a unique proxy name for each-                                 uniqueSWBs <- mapM (\(sw, sb) -> do unique <- incrementInternalCounter st-                                                                     return (sw, (unique, sb))) swbs+                                 uniqueSWBs <- mapM (\(sv, sb) -> do unique <- incrementInternalCounter st+                                                                     return (sv, (unique, sb))) swbs -                                 let translate (sw, (unique, sb)) = (nm, decls, (proxy, sb))-                                        where nm    = show sw+                                 let translate (sv, (unique, sb)) = (nm, decls, (proxy, sb))+                                        where nm    = show sv                                               proxy = "__assumption_proxy_" ++ nm ++ "_" ++ show unique                                               decls = [ "(declare-const " ++ proxy ++ " Bool)"                                                       , "(assert (= " ++ proxy ++ " " ++ nm ++ "))"@@ -471,13 +460,13 @@                             ECon "unknown" -> return (Unk, Nothing)                             _              -> bad r Nothing --- | The current assertion stack depth, i.e., #push - #pops after start. Always non-negative.-getAssertionStackDepth :: Query Int+-- | Generalization of 'Data.SBV.Control.getAssertionStackDepth'+getAssertionStackDepth :: (MonadIO m, MonadQuery m) => m Int getAssertionStackDepth = queryAssertionStackDepth <$> getQueryState  -- | Upon a pop, we need to restore all arrays and tables. See: http://github.com/LeventErkok/sbv/issues/374-restoreTablesAndArrays :: Query ()-restoreTablesAndArrays = do st <- get+restoreTablesAndArrays :: (MonadIO m, MonadQuery m) => m ()+restoreTablesAndArrays = do st <- queryState                             qs <- getQueryState                              case queryTblArrPreserveIndex qs of@@ -495,8 +484,8 @@                                                     xs  -> send True $ "(assert (and " ++ unwords xs ++ "))"  -- | Upon a push, record the cut-off point for table and array restoration, if we haven't already-recordTablesAndArrayCutOff :: Query ()-recordTablesAndArrayCutOff = do st <- get+recordTablesAndArrayCutOff :: (MonadIO m, MonadQuery m) => m ()+recordTablesAndArrayCutOff = do st <- queryState                                 qs <- getQueryState                                  case queryTblArrPreserveIndex qs of@@ -506,16 +495,15 @@                                                  modifyQueryState $ \s -> s {queryTblArrPreserveIndex = Just (tCount, aCount)} --- | Run the query in a new assertion stack. That is, we push the context, run the query--- commands, and pop it back.-inNewAssertionStack :: Query a -> Query a+-- | Generalization of 'Data.SBV.Control.inNewAssertionStack'+inNewAssertionStack :: (MonadIO m, MonadQuery m) => m a -> m a inNewAssertionStack q = do push 1                            r <- q                            pop 1                            return r --- | Push the context, entering a new one. Pushes multiple levels if /n/ > 1.-push :: Int -> Query ()+-- | Generalization of 'Data.SBV.Control.push'+push :: (MonadIO m, MonadQuery m) => Int -> m () push i  | i <= 0 = error $ "Data.SBV: push requires a strictly positive level argument, received: " ++ show i  | True   = do depth <- getAssertionStackDepth@@ -523,8 +511,8 @@                recordTablesAndArrayCutOff                modifyQueryState $ \s -> s{queryAssertionStackDepth = depth + i} --- | Pop the context, exiting a new one. Pops multiple levels if /n/ > 1. It's an error to pop levels that don't exist.-pop :: Int -> Query ()+-- | Generalization of 'Data.SBV.Control.pop'+pop :: (MonadIO m, MonadQuery m) => Int -> m () pop i  | i <= 0 = error $ "Data.SBV: pop requires a strictly positive level argument, received: " ++ show i  | True   = do depth <- getAssertionStackDepth@@ -544,15 +532,10 @@    where shl 1 = "one level"          shl n = show n ++ " levels" --- | Search for a result via a sequence of case-splits, guided by the user. If one of--- the conditions lead to a satisfiable result, returns @Just@ that result. If none of them--- do, returns @Nothing@. Note that we automatically generate a coverage case and search--- for it automatically as well. In that latter case, the string returned will be "Coverage".--- The first argument controls printing progress messages  See "Documentation.SBV.Examples.Queries.CaseSplit"--- for an example use case.-caseSplit :: Bool -> [(String, SBool)] -> Query (Maybe (String, SMTResult))+-- | Generalization of 'Data.SBV.Control.caseSplit'+caseSplit :: (MonadIO m, MonadQuery m) => Bool -> [(String, SBool)] -> m (Maybe (String, SMTResult)) caseSplit printCases cases = do cfg <- getConfig-                                go cfg (cases ++ [("Coverage", bnot (bOr (map snd cases)))])+                                go cfg (cases ++ [("Coverage", sNot (sOr (map snd cases)))])   where msg = when printCases . io . putStrLn          go _ []            = return Nothing@@ -573,17 +556,13 @@                                               res <- Unknown cfg <$> getUnknownReason                                               return $ Just (n, res) --- | Reset the solver, by forgetting all the assertions. However, bindings are kept as is,--- as opposed to a full reset of the solver. Use this variant to clean-up the solver--- state while leaving the bindings intact. Pops all assertion levels. Declarations and--- definitions resulting from the 'Data.SBV.setLogic' command are unaffected. Note that SBV--- implicitly uses global-declarations, so bindings will remain intact.-resetAssertions :: Query ()+-- | Generalization of 'Data.SBV.Control.resetAssertions'+resetAssertions :: (MonadIO m, MonadQuery m) => m () resetAssertions = do send True "(reset-assertions)"                      modifyQueryState $ \s -> s{queryAssertionStackDepth = 0} --- | Echo a string. Note that the echoing is done by the solver, not by SBV.-echo :: String -> Query ()+-- | Generalization of 'Data.SBV.Control.echo'+echo :: (MonadIO m, MonadQuery m) => String -> m () echo s = do let cmd = "(echo \"" ++ concatMap sanitize s ++ "\")"              -- we send the command, but otherwise ignore the response@@ -597,33 +576,13 @@   where sanitize '"'  = "\"\""  -- quotes need to be duplicated         sanitize c    = [c] --- | Exit the solver. This action will cause the solver to terminate. Needless to say,--- trying to communicate with the solver after issuing "exit" will simply fail.-exit :: Query ()+-- | Generalization of 'Data.SBV.Control.exit'+exit :: (MonadIO m, MonadQuery m) => m () exit = do send True "(exit)"           modifyQueryState $ \s -> s{queryAssertionStackDepth = 0} --- | Retrieve the unsat-core. Note you must have arranged for--- unsat cores to be produced first via------ @---     'setOption' $ 'ProduceUnsatCores' 'True'--- @------ for this call to not error out!------ NB. There is no notion of a minimal unsat-core, in case unsatisfiability can be derived--- in multiple ways. Furthermore, Z3 does not guarantee that the generated unsat--- core does not have any redundant assertions either, as doing so can incur a performance penalty.--- (There might be assertions in the set that is not needed.) To ensure all the assertions--- in the core are relevant, use:------ @---     'setOption' $ 'OptionKeyword' ":smt.core.minimize" ["true"]--- @------ Note that this only works with Z3.-getUnsatCore :: Query [String]+-- | Generalization of 'Data.SBV.Control.getUnsatCore'+getUnsatCore :: (MonadIO m, MonadQuery m) => m [String] getUnsatCore = do         let cmd = "(get-unsat-core)"             bad = unexpected "getUnsatCore" cmd "an unsat-core response"@@ -651,26 +610,15 @@            _                                     -> bad r Nothing  -- | Retrieve the unsat core if it was asked for in the configuration-getUnsatCoreIfRequested :: Query (Maybe [String])+getUnsatCoreIfRequested :: (MonadIO m, MonadQuery m) => m (Maybe [String]) getUnsatCoreIfRequested = do         cfg <- getConfig         if or [b | ProduceUnsatCores b <- solverSetOptions cfg]            then Just <$> getUnsatCore            else return Nothing --- | Retrieve the proof. Note you must have arranged for--- proofs to be produced first via------ @---     'setOption' $ 'ProduceProofs' 'True'--- @------ for this call to not error out!------ A proof is simply a 'String', as returned by the solver. In the future, SBV might--- provide a better datatype, depending on the use cases. Please get in touch if you--- use this function and can suggest a better API.-getProof :: Query String+-- | Generalization of 'Data.SBV.Control.getProof'+getProof :: (MonadIO m, MonadQuery m) => m String getProof = do         let cmd = "(get-proof)"             bad = unexpected "getProof" cmd "a get-proof response"@@ -689,34 +637,8 @@         -- result of parsing is ignored.         parse r bad $ \_ -> return r --- | Retrieve an interpolant after an 'Unsat' result is obtained. Note you must have arranged for--- interpolants to be produced first via------ @---     'setOption' $ 'ProduceInterpolants' 'True'--- @------ for this call to not error out!------ To get an interpolant for a pair of formulas @A@ and @B@, use a 'constrainWithAttribute' call to attach--- interplation groups to @A@ and @B@. Then call 'getInterpolant' @[\"A\"]@, assuming those are the names--- you gave to the formulas in the @A@ group.------ An interpolant for @A@ and @B@ is a formula @I@ such that:------ @---        A ==> I---    and B ==> not I--- @------ That is, it's evidence that @A@ and @B@ cannot be true together--- since @A@ implies @I@ but @B@ implies @not I@; establishing that @A@ and @B@ cannot--- be satisfied at the same time. Furthermore, @I@ will have only the symbols that are common--- to @A@ and @B@.------ N.B. As of Z3 version 4.8.0; Z3 no longer supports interpolants. Use the MathSAT backend for extracting--- interpolants. See "Documentation.SBV.Examples.Queries.Interpolants" for an example.-getInterpolant :: [String] -> Query String+-- | Generalization of 'Data.SBV.Control.getInterpolant'+getInterpolant :: (MonadIO m, MonadQuery m) => [String] -> m String getInterpolant fs   | null fs   = error "SBV.getInterpolant requires at least one marked constraint, received none!"@@ -737,20 +659,8 @@         parse r bad $ \e -> return $ serialize False e --- | Retrieve assertions. Note you must have arranged for--- assertions to be available first via------ @---     'setOption' $ 'ProduceAssertions' 'True'--- @------ for this call to not error out!------ Note that the set of assertions returned is merely a list of strings, just like the--- case for 'getProof'. In the future, SBV might provide a better datatype, depending--- on the use cases. Please get in touch if you use this function and can suggest--- a better API.-getAssertions :: Query [String]+-- | Generalization of 'Data.SBV.Control.getAssertions'+getAssertions :: (MonadIO m, MonadQuery m) => m [String] getAssertions = do         let cmd = "(get-assertions)"             bad = unexpected "getAssertions" cmd "a get-assertions response"@@ -769,17 +679,8 @@                                 EApp xs -> return $ map render xs                                 _       -> return [render pe] --- | Retrieve the assignment. This is a lightweight version of 'getValue', where the--- solver returns the truth value for all named subterms of type 'Bool'.------ You must have first arranged for assignments to be produced via------ @---     'setOption' $ 'ProduceAssignments' 'True'--- @------ for this call to not error out!-getAssignment :: Query [(String, Bool)]+-- | Generalization of 'Data.SBV.Control.getAssignment'+getAssignment :: (MonadIO m, MonadQuery m) => m [(String, Bool)] getAssignment = do         let cmd = "(get-assignment)"             bad = unexpected "getAssignment" cmd "a get-assignment response"@@ -814,18 +715,18 @@ -- However, an explicit 'Assignment' might be handy in complex scenarios where a model needs to be -- created manually. infix 1 |->-(|->) :: SymWord a => SBV a -> a -> Assignment+(|->) :: SymVal a => SBV a -> a -> Assignment SBV a |-> v = case literal v of-                SBV (SVal _ (Left cw)) -> Assign a cw-                r                      -> error $ "Data.SBV: Impossible happened in |->: Cannot construct a CW with literal: " ++ show r+                SBV (SVal _ (Left cv)) -> Assign a cv+                r                      -> error $ "Data.SBV: Impossible happened in |->: Cannot construct a CV with literal: " ++ show r --- | Produce the query result from an assignment.-mkSMTResult :: [Assignment] -> Query SMTResult+-- | Generalization of 'Data.SBV.Control.mkSMTResult'+mkSMTResult :: (MonadIO m, MonadQuery m) => [Assignment] -> m SMTResult mkSMTResult asgns = do              QueryState{queryConfig} <- getQueryState              inps <- getQuantifiedInputs -             let grabValues st = do let extract (Assign s n) = sbvToSW st (SBV s) >>= \sw -> return (sw, n)+             let grabValues st = do let extract (Assign s n) = sbvToSV st (SBV s) >>= \sv -> return (sv, n)                                      modelAssignment <- mapM extract asgns
Data/SBV/Control/Types.hs view
@@ -1,16 +1,16 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Control.Types--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Control.Types+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Types related to interactive queries ----------------------------------------------------------------------------- -{-# LANGUAGE DeriveGeneric  #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}  module Data.SBV.Control.Types (        CheckSatResult(..)
Data/SBV/Control/Utils.hs view
@@ -1,27 +1,30 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Control.Utils--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Control.Utils+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Query related utils. ----------------------------------------------------------------------------- -{-# LANGUAGE    BangPatterns         #-}-{-# LANGUAGE    DefaultSignatures    #-}-{-# LANGUAGE    LambdaCase           #-}-{-# LANGUAGE    NamedFieldPuns       #-}-{-# LANGUAGE    ScopedTypeVariables  #-}-{-# LANGUAGE    TupleSections        #-}-{-# LANGUAGE    TypeSynonymInstances #-}-{-# LANGUAGE    FlexibleInstances    #-}-{-# OPTIONS_GHC -fno-warn-orphans    #-}+{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TupleSections         #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeSynonymInstances  #-} +{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Data.SBV.Control.Utils (        io-     , ask, send, getValue, getUninterpretedValue, getValueCW, getUnsatAssumptions, SMTValue(..)+     , ask, send, getValue, getUninterpretedValue, getValueCV, getUnsatAssumptions, SMTValue(..)      , getQueryState, modifyQueryState, getConfig, getObjectives, getSBVAssertions, getSBVPgm, getQuantifiedInputs, getObservables      , checkSat, checkSatUsing, getAllSatResult      , inNewContext, freshVar, freshVar_, freshArray, freshArray_@@ -38,9 +41,10 @@ import Data.Maybe (isJust) import Data.List  (sortBy, sortOn, elemIndex, partition, groupBy, tails, intercalate) -import Data.Char     (isPunctuation, isSpace, chr, ord)+import Data.Char     (isPunctuation, isSpace, chr, ord, isDigit) import Data.Function (on) +import Data.Proxy import Data.Typeable (Typeable)  import Data.Int@@ -49,30 +53,28 @@ import qualified Data.Map.Strict    as Map import qualified Data.IntMap.Strict as IMap -import qualified Control.Monad.Reader as R (ask)--import Control.Monad            (unless)-import Control.Monad.State.Lazy (get, liftIO)--import Control.Monad.State      (evalStateT)+import Control.Monad            (join, unless)+import Control.Monad.IO.Class   (MonadIO, liftIO)+import Control.Monad.Trans      (lift)+import Control.Monad.Reader     (runReaderT)  import Data.IORef (readIORef, writeIORef)  import Data.Time (getZonedTime) -import Data.SBV.Core.Data     ( SW(..), CW(..), SBV, AlgReal, sbvToSW, kindOf, Kind(..)-                              , HasKind(..), mkConstCW, CWVal(..), SMTResult(..)-                              , NamedSymVar, SMTConfig(..), Query, SMTModel(..)+import Data.SBV.Core.Data     ( SV(..), trueSV, falseSV, CV(..), trueCV, falseCV, SBV, AlgReal, sbvToSV, kindOf, Kind(..)+                              , HasKind(..), mkConstCV, CVal(..), SMTResult(..)+                              , NamedSymVar, SMTConfig(..), SMTModel(..)                               , QueryState(..), SVal(..), Quantifier(..), cache                               , newExpr, SBVExpr(..), Op(..), FPOp(..), SBV(..), SymArray(..)                               , SolverContext(..), SBool, Objective(..), SolverCapabilities(..), capabilities-                              , Result(..), SMTProblem(..), trueSW, SymWord(..), SBVPgm(..), SMTSolver(..), SBVRunMode(..)+                              , Result(..), SMTProblem(..), trueSV, SymVal(..), SBVPgm(..), SMTSolver(..), SBVRunMode(..)                               ) -import Data.SBV.Core.Symbolic ( IncState(..), withNewIncState, State(..), svToSW, Symbolic-                              , QueryContext(..)+import Data.SBV.Core.Symbolic ( IncState(..), withNewIncState, State(..), svToSV, symbolicEnv, SymbolicT+                              , MonadQuery(..), QueryContext(..), Queriable(..)                               , registerLabel, svMkSymVar-                              , isSafetyCheckingIStage, isSetupIStage, isRunIStage, IStage(..), Query(..)+                              , isSafetyCheckingIStage, isSetupIStage, isRunIStage, IStage(..), QueryT(..)                               , extractSymbolicSimulationState                               ) @@ -82,8 +84,8 @@ import Data.SBV.SMT.SMTLib  (toIncSMTLib, toSMTLib) import Data.SBV.SMT.Utils   (showTimeoutValue, addAnnotations, alignPlain, debug, mergeSExpr, SBVException(..)) +import Data.SBV.Utils.ExtractIO import Data.SBV.Utils.Lib (qfsToString, isKString)- import Data.SBV.Utils.SExpr import Data.SBV.Control.Types @@ -95,12 +97,12 @@  import Unsafe.Coerce (unsafeCoerce) -- Only used safely! --- | 'Query' as a 'SolverContext'.-instance SolverContext Query where-   constrain                 = addQueryConstraint False []-   softConstrain             = addQueryConstraint True  []-   namedConstraint nm        = addQueryConstraint False [(":named", nm)]-   constrainWithAttribute    = addQueryConstraint False+-- | 'Data.SBV.Trans.Control.QueryT' as a 'SolverContext'.+instance MonadIO m => SolverContext (QueryT m) where+   constrain              = addQueryConstraint False []+   softConstrain          = addQueryConstraint True  []+   namedConstraint nm     = addQueryConstraint False [(":named", nm)]+   constrainWithAttribute = addQueryConstraint False     setOption o      | isStartModeOption o = error $ unlines [ ""@@ -111,38 +113,40 @@  -- | Adding a constraint, possibly with attributes and possibly soft. Only used internally. -- Use 'constrain' and 'namedConstraint' from user programs.-addQueryConstraint :: Bool -> [(String, String)] -> SBool -> Query ()-addQueryConstraint isSoft atts b = do sw <- inNewContext (\st -> do mapM_ (registerLabel "Constraint" st) [nm | (":named", nm) <- atts]-                                                                    sbvToSW st b)-                                      send True $ "(" ++ asrt ++ " " ++ addAnnotations atts (show sw)  ++ ")"+addQueryConstraint :: (MonadIO m, MonadQuery m) => Bool -> [(String, String)] -> SBool -> m ()+addQueryConstraint isSoft atts b = do sv <- inNewContext (\st -> liftIO $ do mapM_ (registerLabel "Constraint" st) [nm | (":named", nm) <- atts]+                                                                             sbvToSV st b)++                                      unless (null atts && sv == trueSV) $+                                             send True $ "(" ++ asrt ++ " " ++ addAnnotations atts (show sv)  ++ ")"    where asrt | isSoft = "assert-soft"               | True   = "assert"  -- | Get the current configuration-getConfig :: Query SMTConfig+getConfig :: (MonadIO m, MonadQuery m) => m SMTConfig getConfig = queryConfig <$> getQueryState  -- | Get the objectives-getObjectives :: Query [Objective (SW, SW)]-getObjectives = do State{rOptGoals} <- get+getObjectives :: (MonadIO m, MonadQuery m) => m [Objective (SV, SV)]+getObjectives = do State{rOptGoals} <- queryState                    io $ reverse <$> readIORef rOptGoals  -- | Get the program-getSBVPgm :: Query SBVPgm-getSBVPgm = do State{spgm} <- get+getSBVPgm :: (MonadIO m, MonadQuery m) => m SBVPgm+getSBVPgm = do State{spgm} <- queryState                io $ readIORef spgm  -- | Get the assertions put in via 'Data.SBV.sAssert'-getSBVAssertions :: Query [(String, Maybe CallStack, SW)]-getSBVAssertions = do State{rAsserts} <- get+getSBVAssertions :: (MonadIO m, MonadQuery m) => m [(String, Maybe CallStack, SV)]+getSBVAssertions = do State{rAsserts} <- queryState                       io $ reverse <$> readIORef rAsserts --- | Perform an arbitrary IO action.-io :: IO a -> Query a+-- | Generalization of 'Data.SBV.Control.io'+io :: MonadIO m => IO a -> m a io = liftIO  -- | Sync-up the external solver with new context we have generated-syncUpSolver :: Bool -> IncState -> Query ()+syncUpSolver :: (MonadIO m, MonadQuery m) => Bool -> IncState -> m () syncUpSolver afterAPush is = do         cfg <- getConfig         ls  <- io $ do let swap  (a, b)        = (b, a)@@ -155,13 +159,14 @@                        tbls  <- map arrange . sortBy cmp . map swap . Map.toList <$> readIORef (rNewTbls is)                        uis   <- Map.toAscList <$> readIORef (rNewUIs is)                        as    <- readIORef (rNewAsgns is)+                        return $ toIncSMTLib afterAPush cfg inps ks cnsts arrs tbls uis as cfg         mapM_ (send True) $ mergeSExpr ls  -- | Retrieve the query context-getQueryState :: Query QueryState-getQueryState = do state <- get-                   mbQS  <- io $ readIORef (queryState state)+getQueryState :: (MonadIO m, MonadQuery m) => m QueryState+getQueryState = do state <- queryState+                   mbQS  <- io $ readIORef (rQueryState state)                    case mbQS of                      Nothing -> error $ unlines [ ""                                                 , "*** Data.SBV: Impossible happened: Query context required in a non-query mode."@@ -169,69 +174,63 @@                                                 ]                      Just qs -> return qs --- | Modify the query state-modifyQueryState :: (QueryState -> QueryState) -> Query ()-modifyQueryState f = do state <- get-                        mbQS  <- io $ readIORef (queryState state)+-- | Generalization of 'Data.SBV.Control.modifyQueryState'+modifyQueryState :: (MonadIO m, MonadQuery m) => (QueryState -> QueryState) -> m ()+modifyQueryState f = do state <- queryState+                        mbQS  <- io $ readIORef (rQueryState state)                         case mbQS of                           Nothing -> error $ unlines [ ""                                                      , "*** Data.SBV: Impossible happened: Query context required in a non-query mode."                                                      , "Please report this as a bug!"                                                      ]                           Just qs -> let fqs = f qs-                                     in fqs `seq` io $ writeIORef (queryState state) $ Just fqs+                                     in fqs `seq` io $ writeIORef (rQueryState state) $ Just fqs --- | Execute in a new incremental context-inNewContext :: (State -> IO a) -> Query a-inNewContext act = do st <- get+-- | Generalization of 'Data.SBV.Control.inNewContext'+inNewContext :: (MonadIO m, MonadQuery m) => (State -> IO a) -> m a+inNewContext act = do st <- queryState                       (is, r) <- io $ withNewIncState st act-                      mbQS <- io . readIORef . queryState $ st+                      mbQS <- io . readIORef . rQueryState $ st                       let afterAPush = case mbQS of                                          Nothing -> False                                          Just qs -> isJust (queryTblArrPreserveIndex qs)                       syncUpSolver afterAPush is                       return r --- | Similar to 'freshVar', except creates unnamed variable.-freshVar_ :: forall a. SymWord a => Query (SBV a)+-- | Generic 'Queriable' instance for 'SymVal'/'SMTValue' values+instance (MonadIO m, SymVal a, SMTValue a) => Queriable m (SBV a) a where+  fresh   = freshVar_+  extract = getValue++-- | Generalization of 'Data.SBV.Control.freshVar_'+freshVar_ :: forall a m. (MonadIO m, MonadQuery m, SymVal a) => m (SBV a) freshVar_ = inNewContext $ fmap SBV . svMkSymVar (Just EX) k Nothing-  where k = kindOf (undefined :: a)+  where k = kindOf (Proxy @a) --- | Create a fresh variable in query mode. You should prefer--- creating input variables using 'Data.SBV.sBool', 'Data.SBV.sInt32', etc., which act--- as primary inputs to the model and can be existential or universal.--- Use 'freshVar' only in query mode for anonymous temporary variables.--- Such variables are always existential. Note that 'freshVar' should hardly be--- needed: Your input variables and symbolic expressions should suffice for--- most major use cases.-freshVar :: forall a. SymWord a => String -> Query (SBV a)+-- | Generalization of 'Data.SBV.Control.freshVar'+freshVar :: forall a m. (MonadIO m, MonadQuery m, SymVal a) => String -> m (SBV a) freshVar nm = inNewContext $ fmap SBV . svMkSymVar (Just EX) k (Just nm)-  where k = kindOf (undefined :: a)+  where k = kindOf (Proxy @a) --- | Similar to 'freshArray', except creates unnamed array.-freshArray_ :: (SymArray array, HasKind a, HasKind b) => Maybe (SBV b) -> Query (array a b)+-- | Generalization of 'Data.SBV.Control.freshArray_'+freshArray_ :: (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) => Maybe (SBV b) -> m (array a b) freshArray_ = mkFreshArray Nothing --- | Create a fresh array in query mode. Again, you should prefer--- creating arrays before the queries start using 'newArray', but this--- method can come in handy in occasional cases where you need a new array--- after you start the query based interaction.-freshArray :: (SymArray array, HasKind a, HasKind b) => String -> Maybe (SBV b) -> Query (array a b)+-- | Generalization of 'Data.SBV.Control.freshArray'+freshArray :: (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) => String -> Maybe (SBV b) -> m (array a b) freshArray nm = mkFreshArray (Just nm)  -- | Creating arrays, internal use only.-mkFreshArray :: (SymArray array, HasKind a, HasKind b) => Maybe String -> Maybe (SBV b) -> Query (array a b)+mkFreshArray :: (MonadIO m, MonadQuery m, SymArray array, HasKind a, HasKind b) => Maybe String -> Maybe (SBV b) -> m (array a b) mkFreshArray mbNm mbVal = inNewContext $ newArrayInState mbNm mbVal --- | If 'verbose' is 'True', print the message, useful for debugging messages--- in custom queries. Note that 'redirectVerbose' will be respected: If a--- file redirection is given, the output will go to the file.-queryDebug :: [String] -> Query ()+-- | Generalization of 'Data.SBV.Control.queryDebug'+queryDebug :: (MonadIO m, MonadQuery m) => [String] -> m () queryDebug msgs = do QueryState{queryConfig} <- getQueryState                      io $ debug queryConfig msgs --- | Send a string to the solver, and return the response-ask :: String -> Query String+-- | Generalization of 'Data.SBV.Control.ask'+ask :: (MonadIO m, MonadQuery m) => String -> m String ask s = do QueryState{queryAsk, queryTimeOutValue} <- getQueryState             case queryTimeOutValue of@@ -244,7 +243,7 @@  -- | Send a string to the solver, and return the response. Except, if the response -- is one of the "ignore" ones, keep querying.-askIgnoring :: String -> [String] -> Query String+askIgnoring :: (MonadIO m, MonadQuery m) => String -> [String] -> m String askIgnoring s ignoreList = do             QueryState{queryAsk, queryRetrieveResponse, queryTimeOutValue} <- getQueryState@@ -266,9 +265,8 @@             loop r --- | Send a string to the solver. If the first argument is 'True', we will require--- a "success" response as well. Otherwise, we'll fire and forget.-send :: Bool -> String -> Query ()+-- | Generalization of 'Data.SBV.Control.send'+send :: (MonadIO m, MonadQuery m) => Bool -> String -> m () send requireSuccess s = do              QueryState{queryAsk, querySend, queryConfig, queryTimeOutValue} <- getQueryState@@ -291,13 +289,8 @@                 else io $ querySend queryTimeOutValue s  -- fire and forget. if you use this, you're on your own! --- | Retrieve a responses from the solver until it produces a synchronization tag. We make the tag--- unique by attaching a time stamp, so no need to worry about getting the wrong tag unless it happens--- in the very same picosecond! We return multiple valid s-expressions till the solver responds with the tag.--- Should only be used for internal tasks or when we want to synchronize communications, and not on a--- regular basis! Use 'send'/'ask' for that purpose. This comes in handy, however, when solvers respond--- multiple times as in optimization for instance, where we both get a check-sat answer and some objective values.-retrieveResponse :: String -> Maybe Int -> Query [String]+-- | Generalization of 'Data.SBV.Control.retrieveResponse'+retrieveResponse :: (MonadIO m, MonadQuery m) => String -> Maybe Int -> m [String] retrieveResponse userTag mbTo = do              ts  <- io (show <$> getZonedTime) @@ -379,7 +372,7 @@    -- and the ice is thin here. But it works, and is much better than a plethora    -- of overlapping instances. Sigh.    sexprToVal (ECon s)-    | isKString (undefined :: [a]) && length s >= 2 && head s == '"' && last s == '"'+    | isKString @[a] undefined && length s >= 2 && head s == '"' && last s == '"'     = Just $ map unsafeCoerce s'     | True     = Just $ map (unsafeCoerce . c2w8) s'@@ -397,46 +390,110 @@     sexprToVal _                                       = Nothing --- | Get the value of a term.-getValue :: SMTValue a => SBV a -> Query a-getValue s = do sw <- inNewContext (`sbvToSW` s)-                let nm  = show sw+instance SMTValue () where+   sexprToVal (ECon "SBVTuple0") = Just ()+   sexprToVal _                  = Nothing++-- | Convert a sexpr of n-tuple to constituent sexprs. Z3 and CVC4 differ here on how they+-- present tuples, so we accommodate both:+sexprToTuple :: Int -> SExpr -> [SExpr]+sexprToTuple n e = try e+  where -- Z3 way+        try (EApp (ECon f : args)) = case splitAt (length "mkSBVTuple") f of+                                       ("mkSBVTuple", c) | all isDigit c && read c == n && length args == n -> args+                                       _  -> bad+        -- CVC4 way+        try  (EApp (EApp [ECon "as", ECon f, _] : args)) = try (EApp (ECon f : args))+        try  _ = bad+        bad = error $ "Data.SBV.sexprToTuple: Impossible: Expected a constructor for " ++ show n ++ " tuple, but got: " ++ show e++-- 2-tuple+instance (SMTValue a, SMTValue b) => SMTValue (a, b) where+   sexprToVal s = case sexprToTuple 2 s of+                    [a, b] -> (,) <$> sexprToVal a <*> sexprToVal b+                    _      -> Nothing++-- 3-tuple+instance (SMTValue a, SMTValue b, SMTValue c) => SMTValue (a, b, c) where+   sexprToVal s = case sexprToTuple 3 s of+                    [a, b, c] -> (,,) <$> sexprToVal a <*> sexprToVal b <*> sexprToVal c+                    _         -> Nothing++-- 4-tuple+instance (SMTValue a, SMTValue b, SMTValue c, SMTValue d) => SMTValue (a, b, c, d) where+   sexprToVal s = case sexprToTuple 4 s of+                    [a, b, c, d] -> (,,,) <$> sexprToVal a <*> sexprToVal b <*> sexprToVal c <*> sexprToVal d+                    _            -> Nothing++-- 5-tuple+instance (SMTValue a, SMTValue b, SMTValue c, SMTValue d, SMTValue e) => SMTValue (a, b, c, d, e) where+   sexprToVal s = case sexprToTuple 5 s of+                    [a, b, c, d, e] -> (,,,,) <$> sexprToVal a <*> sexprToVal b <*> sexprToVal c <*> sexprToVal d <*> sexprToVal e+                    _               -> Nothing++-- 6-tuple+instance (SMTValue a, SMTValue b, SMTValue c, SMTValue d, SMTValue e, SMTValue f) => SMTValue (a, b, c, d, e, f) where+   sexprToVal s = case sexprToTuple 6 s of+                    [a, b, c, d, e, f] -> (,,,,,) <$> sexprToVal a <*> sexprToVal b <*> sexprToVal c <*> sexprToVal d <*> sexprToVal e <*> sexprToVal f+                    _                  -> Nothing++-- 7-tuple+instance (SMTValue a, SMTValue b, SMTValue c, SMTValue d, SMTValue e, SMTValue f, SMTValue g) => SMTValue (a, b, c, d, e, f, g) where+   sexprToVal s = case sexprToTuple 7 s of+                    [a, b, c, d, e, f, g] -> (,,,,,,) <$> sexprToVal a <*> sexprToVal b <*> sexprToVal c <*> sexprToVal d <*> sexprToVal e <*> sexprToVal f <*> sexprToVal g+                    _                     -> Nothing++-- 8-tuple+instance (SMTValue a, SMTValue b, SMTValue c, SMTValue d, SMTValue e, SMTValue f, SMTValue g, SMTValue h) => SMTValue (a, b, c, d, e, f, g, h) where+   sexprToVal s = case sexprToTuple 8 s of+                    [a, b, c, d, e, f, g, h] -> (,,,,,,,) <$> sexprToVal a <*> sexprToVal b <*> sexprToVal c <*> sexprToVal d <*> sexprToVal e <*> sexprToVal f <*> sexprToVal g <*> sexprToVal h+                    _                        -> Nothing++-- | Generalization of 'Data.SBV.Control.getValue'+getValue :: (MonadIO m, MonadQuery m, SMTValue a) => SBV a -> m a+getValue s = do sv <- inNewContext (`sbvToSV` s)+                let nm  = show sv                     cmd = "(get-value (" ++ nm ++ "))"                     bad = unexpected "getValue" cmd "a model value" Nothing                 r <- ask cmd-                parse r bad $ \case EApp [EApp [ECon o,  v]] | o == show sw -> case sexprToVal v of+                parse r bad $ \case EApp [EApp [ECon o,  v]] | o == show sv -> case sexprToVal v of                                                                                  Nothing -> bad r Nothing                                                                                  Just c  -> return c                                     _                                       -> bad r Nothing --- | Get the value of an uninterpreted sort, as a String-getUninterpretedValue :: HasKind a => SBV a -> Query String+-- | Generalization of 'Data.SBV.Control.getUninterpretedValue'+getUninterpretedValue :: (MonadIO m, MonadQuery m, HasKind a) => SBV a -> m String getUninterpretedValue s =         case kindOf s of-          KUserSort _ (Left _) -> do sw <- inNewContext (`sbvToSW` s)+          KUninterpreted _ (Left _) -> do sv <- inNewContext (`sbvToSV` s) -                                     let nm  = show sw-                                         cmd = "(get-value (" ++ nm ++ "))"-                                         bad = unexpected "getValue" cmd "a model value" Nothing+                                          let nm  = show sv+                                              cmd = "(get-value (" ++ nm ++ "))"+                                              bad = unexpected "getValue" cmd "a model value" Nothing -                                     r <- ask cmd+                                          r <- ask cmd -                                     parse r bad $ \case EApp [EApp [ECon o,  ECon v]] | o == show sw -> return v-                                                         _                                            -> bad r Nothing+                                          parse r bad $ \case EApp [EApp [ECon o,  ECon v]] | o == show sv -> return v+                                                              _                                            -> bad r Nothing -          k                    -> error $ unlines [""-                                                  , "*** SBV.getUninterpretedValue: Called on an 'interpreted' kind"-                                                  , "*** "-                                                  , "***    Kind: " ++ show k-                                                  , "***    Hint: Use 'getValue' to extract value for interpreted kinds."-                                                  , "*** "-                                                  , "*** Only truly uninterpreted sorts should be used with 'getUninterpretedValue.'"-                                                  ]+          k                         -> error $ unlines [""+                                                       , "*** SBV.getUninterpretedValue: Called on an 'interpreted' kind"+                                                       , "*** "+                                                       , "***    Kind: " ++ show k+                                                       , "***    Hint: Use 'getValue' to extract value for interpreted kinds."+                                                       , "*** "+                                                       , "*** Only truly uninterpreted sorts should be used with 'getUninterpretedValue.'"+                                                       ] --- | Get the value of a term, but in CW form. Used internally. The model-index, in particular is extremely Z3 specific!-getValueCWHelper :: Maybe Int -> SW -> Query CW-getValueCWHelper mbi s = do-       let nm  = show s+-- | Get the value of a term, but in CV form. Used internally. The model-index, in particular is extremely Z3 specific!+getValueCVHelper :: (MonadIO m, MonadQuery m) => Maybe Int -> SV -> m CV+getValueCVHelper mbi s+  | s == trueSV+  = return trueCV+  | s == falseSV+  = return falseCV+  | True+  = do let nm  = show s            k   = kindOf s             modelIndex = case mbi of@@ -450,26 +507,29 @@        r <- ask cmd         parse r bad $ \case EApp [EApp [ECon v, val]] | v == nm -> case recoverKindedValue (kindOf s) val of-                                                                    Just cw -> return cw+                                                                    Just cv -> return cv                                                                     Nothing -> bad r Nothing                            _                                   -> bad r Nothing  -- | Recover a given solver-printed value with a possible interpretation-recoverKindedValue :: Kind -> SExpr -> Maybe CW+recoverKindedValue :: Kind -> SExpr -> Maybe CV recoverKindedValue k e = case e of-                           ENum    i | isIntegralLike    -> Just $ mkConstCW k (fst i)-                           ENum    i | isChar          k -> Just $ CW KChar    (CWChar    (chr (fromIntegral (fst i))))-                           EReal   i | isReal          k -> Just $ CW KReal    (CWAlgReal i)-                           EFloat  i | isFloat         k -> Just $ CW KFloat   (CWFloat   i)-                           EDouble i | isDouble        k -> Just $ CW KDouble  (CWDouble  i)-                           ECon    s | isString        k -> Just $ CW KString  (CWString   (interpretString s))-                           ECon    s | isUninterpreted k -> Just $ CW k        (CWUserSort (getUIIndex k s, s))-                           _         | isList          k -> Just $ CW k        (CWList     (interpretList e))-                           _                             -> Nothing+                           ENum    i | isIntegralLike    -> Just $ mkConstCV k (fst i)+                           ENum    i | isChar          k -> Just $ CV KChar    (CChar    (chr (fromIntegral (fst i))))+                           EReal   i | isReal          k -> Just $ CV KReal    (CAlgReal i)+                           EFloat  i | isFloat         k -> Just $ CV KFloat   (CFloat   i)+                           EDouble i | isDouble        k -> Just $ CV KDouble  (CDouble  i)+                           ECon    s | isString        k -> Just $ CV KString  (CString   (interpretString s))+                           ECon    s | isUninterpreted k -> Just $ CV k        (CUserSort (getUIIndex k s, s))+                           _         | isList          k -> Just $ CV k        (CList     (interpretList e))+                           _         | isTuple         k -> Just $ CV k        (CTuple    (interpretTuple e))++                           _ -> Nothing+   where isIntegralLike = or [f k | f <- [isBoolean, isBounded, isInteger, isReal, isFloat, isDouble]] -        getUIIndex (KUserSort  _ (Right xs)) i = i `elemIndex` xs-        getUIIndex _                         _ = Nothing+        getUIIndex (KUninterpreted  _ (Right xs)) i = i `elemIndex` xs+        getUIIndex _                              _ = Nothing          stringLike xs = length xs >= 2 && head xs == '"' && last xs == '"' @@ -486,11 +546,11 @@         -- Lists are tricky since z3 prints the 8-bit variants as strings. See: <http://github.com/Z3Prover/z3/issues/1808>         interpretList (ECon s)           | isStringSequence k && stringLike s-          = map (CWInteger . fromIntegral . ord) $ interpretString s+          = map (CInteger . fromIntegral . ord) $ interpretString s         interpretList topExpr = walk topExpr           where walk (EApp [ECon "as", ECon "seq.empty", _]) = []                 walk (EApp [ECon "seq.unit", v])             = case recoverKindedValue ek v of-                                                                 Just w -> [cwVal w]+                                                                 Just w -> [cvVal w]                                                                  Nothing -> error $ "Cannot parse a sequence item of kind " ++ show ek ++ " from: " ++ show v ++ extra v                 walk (EApp [ECon "seq.++", pre, post])       = walk pre ++ walk post                 walk cur                                     = error $ "Expected a sequence constant, but received: " ++ show cur ++ extra cur@@ -501,37 +561,52 @@                  ek = case k of                        KList ik -> ik-                       _        -> error $ "Impossible: Expected a sequence kind, bug got: " ++ show k+                       _        -> error $ "Impossible: Expected a sequence kind, but got: " ++ show k --- | Get the value of a term. If the kind is Real and solver supports decimal approximations,--- we will "squash" the representations.-getValueCW :: Maybe Int -> SW -> Query CW-getValueCW mbi s+        interpretTuple te = walk (1 :: Int) (zipWith recoverKindedValue ks args) []+                where (ks, n) = case k of+                                  KTuple eks -> (eks, length eks)+                                  _          -> error $ unlines [ "Impossible: Expected a tuple kind, but got: " ++ show k+                                                                , "While trying to parse: " ++ show te+                                                                ]++                      args = sexprToTuple n te++                      walk _ []           sofar = reverse sofar+                      walk i (Just el:es) sofar = walk (i+1) es (cvVal el : sofar)+                      walk i (Nothing:_)  _     = error $ unlines [ "Couldn't parse a tuple element at position " ++ show i+                                                                  , "Kind: " ++ show k+                                                                  , "Expr: " ++ show te+                                                                  ]++-- | Generalization of 'Data.SBV.Control.getValueCV'+getValueCV :: (MonadIO m, MonadQuery m) => Maybe Int -> SV -> m CV+getValueCV mbi s   | kindOf s /= KReal-  = getValueCWHelper mbi s+  = getValueCVHelper mbi s   | True   = do cfg <- getConfig        if not (supportsApproxReals (capabilities (solver cfg)))-          then getValueCWHelper mbi s+          then getValueCVHelper mbi s           else do send True "(set-option :pp.decimal false)"-                  rep1 <- getValueCWHelper mbi s+                  rep1 <- getValueCVHelper mbi s                   send True   "(set-option :pp.decimal true)"                   send True $ "(set-option :pp.decimal_precision " ++ show (printRealPrec cfg) ++ ")"-                  rep2 <- getValueCWHelper mbi s+                  rep2 <- getValueCVHelper mbi s -                  let bad = unexpected "getValueCW" "get-value" ("a real-valued binding for " ++ show s) Nothing (show (rep1, rep2)) Nothing+                  let bad = unexpected "getValueCV" "get-value" ("a real-valued binding for " ++ show s) Nothing (show (rep1, rep2)) Nothing                    case (rep1, rep2) of-                    (CW KReal (CWAlgReal a), CW KReal (CWAlgReal b)) -> return $ CW KReal (CWAlgReal (mergeAlgReals ("Cannot merge real-values for " ++ show s) a b))-                    _                                                -> bad+                    (CV KReal (CAlgReal a), CV KReal (CAlgReal b)) -> return $ CV KReal (CAlgReal (mergeAlgReals ("Cannot merge real-values for " ++ show s) a b))+                    _                                              -> bad --- | Check for satisfiability.-checkSat :: Query CheckSatResult+-- | Generalization of 'Data.SBV.Control.checkSat'+checkSat :: (MonadIO m, MonadQuery m) => m CheckSatResult checkSat = do cfg <- getConfig               checkSatUsing $ satCmd cfg --- | Check for satisfiability with a custom check-sat-using command.-checkSatUsing :: String -> Query CheckSatResult+-- | Generalization of 'Data.SBV.Control.checkSatUsing'+checkSatUsing :: (MonadIO m, MonadQuery m) => String -> m CheckSatResult checkSatUsing cmd = do let bad = unexpected "checkSat" cmd "one of sat/unsat/unknown" Nothing                             -- Sigh.. Ignore some of the pesky warnings. We only do it as an exception here.@@ -545,8 +620,8 @@                                            _              -> bad r Nothing  -- | What are the top level inputs? Trackers are returned as top level existentials-getQuantifiedInputs :: Query [(Quantifier, NamedSymVar)]-getQuantifiedInputs = do State{rinps} <- get+getQuantifiedInputs :: (MonadIO m, MonadQuery m) => m [(Quantifier, NamedSymVar)]+getQuantifiedInputs = do State{rinps} <- queryState                          (rQinps, rTrackers) <- liftIO $ readIORef rinps                           let qinps    = reverse rQinps@@ -558,26 +633,33 @@                          return $ preQs ++ trackers ++ postQs  -- | Get observables, i.e., those explicitly labeled by the user with a call to 'Data.SBV.observe'.-getObservables :: Query [(String, SW)]-getObservables = do State{rObservables} <- get+getObservables :: (MonadIO m, MonadQuery m) => m [(String, CV)]+getObservables = do State{rObservables} <- queryState                      rObs <- liftIO $ readIORef rObservables -                    return $ reverse rObs+                    -- This intentionally reverses the result; since 'rObs' stores in reversed order+                    let walk []             sofar = return sofar+                        walk ((n, f, s):os) sofar = do cv <- getValueCV Nothing s+                                                       if f cv+                                                          then walk os ((n, cv) : sofar)+                                                          else walk os            sofar +                    walk rObs []+ -- | Repeatedly issue check-sat, after refuting the previous model. -- The bool is true if the model is unique upto prefix existentials.-getAllSatResult :: Query (Bool, Bool, [SMTResult])+getAllSatResult :: forall m. (MonadIO m, MonadQuery m, SolverContext m) => m (Bool, Bool, [SMTResult]) getAllSatResult = do queryDebug ["*** Checking Satisfiability, all solutions.."]                       cfg <- getConfig -                     State{rUsedKinds} <- get+                     State{rUsedKinds} <- queryState                       ki    <- liftIO $ readIORef rUsedKinds                      qinps <- getQuantifiedInputs -                     let usorts = [s | us@(KUserSort s _) <- Set.toList ki, isFree us]+                     let usorts = [s | us@(KUninterpreted s _) <- Set.toList ki, isFree us]                       unless (null usorts) $ queryDebug [ "*** SBV.allSat: Uninterpreted sorts present: " ++ unwords usorts                                                        , "***             SBV will use equivalence classes to generate all-satisfying instances."@@ -587,10 +669,10 @@                          vars = let allModelInputs = takeWhile ((/= ALL) . fst) qinps                                      sortByNodeId :: [NamedSymVar] -> [NamedSymVar]-                                    sortByNodeId = sortBy (compare `on` (\(SW _ n, _) -> n))+                                    sortByNodeId = sortBy (compare `on` (\(SV _ n, _) -> n))                                      mkSVal :: NamedSymVar -> (SVal, NamedSymVar)-                                    mkSVal nm@(sw, _) = (SVal (kindOf sw) (Right (cache (const (return sw)))), nm)+                                    mkSVal nm@(sv, _) = (SVal (kindOf sv) (Right (cache (const (return sv)))), nm)                                  in map mkSVal $ sortByNodeId [nv | (_, nv@(_, n)) <- allModelInputs, not (isNonModelVar cfg n)] @@ -600,12 +682,12 @@                      (sc, ms) <- loop vars cfg                      return (sc, w, reverse ms) -   where isFree (KUserSort _ (Left _)) = True-         isFree _                      = False+   where isFree (KUninterpreted _ (Left _)) = True+         isFree _                           = False           loop vars cfg = go (1::Int) []-            where go :: Int -> [SMTResult] -> Query (Bool, [SMTResult])-                  go !cnt sofar+           where go :: Int -> [SMTResult] -> m (Bool, [SMTResult])+                 go !cnt sofar                    | Just maxModels <- allSatMaxModelCount cfg, cnt > maxModels                    = do queryDebug ["*** Maximum model count request of " ++ show maxModels ++ " reached, stopping the search."]                         return (True, sofar)@@ -616,11 +698,11 @@                           Unsat -> return (False, sofar)                           Unk   -> do queryDebug ["*** Solver returned unknown, terminating query."]                                       return (False, sofar)-                          Sat   -> do assocs <- mapM (\(sval, (sw, n)) -> do cw <- getValueCW Nothing sw-                                                                             return (n, (sval, cw))) vars+                          Sat   -> do assocs <- mapM (\(sval, (sv, n)) -> do cv <- getValueCV Nothing sv+                                                                             return (n, (sval, cv))) vars                                        let m = Satisfiable cfg SMTModel { modelObjectives = []-                                                                       , modelAssocs     = [(n, cw) | (n, (_, cw)) <- assocs]+                                                                       , modelAssocs     = [(n, cv) | (n, (_, cv)) <- assocs]                                                                        }                                            (interpreteds, uninterpreteds) = partition (not . isFree . kindOf . fst) (map snd assocs)@@ -629,14 +711,14 @@                                           -- NB. When the kind is floating, we *have* to be careful, since +/- zero, and NaN's                                           -- and equality don't get along!                                           interpretedEqs :: [SVal]-                                          interpretedEqs = [mkNotEq (kindOf sv) sv (SVal (kindOf sv) (Left cw)) | (sv, cw) <- interpreteds]+                                          interpretedEqs = [mkNotEq (kindOf sv) sv (SVal (kindOf sv) (Left cv)) | (sv, cv) <- interpreteds]                                              where mkNotEq k a b                                                     | isDouble k || isFloat k = svNot (a `fpNotEq` b)                                                     | True                    = a `svNotEqual` b                                                     fpNotEq a b = SVal KBool $ Right $ cache r-                                                       where r st = do swa <- svToSW st a-                                                                       swb <- svToSW st b+                                                       where r st = do swa <- svToSV st a+                                                                       swb <- svToSV st b                                                                        newExpr st KBool (SBVApp (IEEEFP FP_ObjEqual) [swa, swb])                                            -- For each "uninterpreted" variable, use equivalence class@@ -645,7 +727,7 @@                                                            . filter (\l -> length l > 1)  -- Only need this class if it has at least two members                                                            . map (map fst)                -- throw away values, we only need svals                                                            . groupBy ((==) `on` snd)      -- make sure they belong to the same sort and have the same value-                                                           . sortOn snd                   -- sort them according to their CW (i.e., sort/value)+                                                           . sortOn snd                   -- sort them according to their CV (i.e., sort/value)                                                            $ uninterpreteds                                             where pwDistinct :: [SVal] -> [SVal]                                                   pwDistinct ss = [x `svNotEqual` y | (x:ys) <- tails ss, y <- ys]@@ -664,9 +746,8 @@                                         Just d  -> do constrain d                                                       go (cnt+1) resultsSoFar --- | Retrieve the set of unsatisfiable assumptions, following a call to 'Data.SBV.Control.checkSatAssumingWithUnsatisfiableSet'. Note that--- this function isn't exported to the user, but rather used internally. The user simple calls 'Data.SBV.Control.checkSatAssumingWithUnsatisfiableSet'.-getUnsatAssumptions :: [String] -> [(String, a)] -> Query [a]+-- | Generalization of 'Data.SBV.Control.getUnsatAssumptions'+getUnsatAssumptions :: (MonadIO m, MonadQuery m) => [String] -> [(String, a)] -> m [a] getUnsatAssumptions originals proxyMap = do         let cmd = "(get-unsat-assumptions)" @@ -704,21 +785,8 @@            EApp es | Just xs <- mapM fromECon es -> walk xs []            _                                     -> bad r Nothing --- | Timeout a query action, typically a command call to the underlying SMT solver.--- The duration is in microseconds (@1\/10^6@ seconds). If the duration--- is negative, then no timeout is imposed. When specifying long timeouts, be careful not to exceed--- @maxBound :: Int@. (On a 64 bit machine, this bound is practically infinite. But on a 32 bit--- machine, it corresponds to about 36 minutes!)------ Semantics: The call @timeout n q@ causes the timeout value to be applied to all interactive calls that take place--- as we execute the query @q@. That is, each call that happens during the execution of @q@ gets a separate--- time-out value, as opposed to one timeout value that limits the whole query. This is typically the intended behavior.--- It is advisible to apply this combinator to calls that involve a single call to the solver for--- finer control, as opposed to an entire set of interactions. However, different use cases might call for different scenarios.------ If the solver responds within the time-out specified, then we continue as usual. However, if the backend solver times-out--- using this mechanism, there is no telling what the state of the solver will be. Thus, we raise an error in this case.-timeout :: Int -> Query a -> Query a+-- | Generalization of 'Data.SBV.Control.timeout'+timeout :: (MonadIO m, MonadQuery m) => Int -> m a -> m a timeout n q = do modifyQueryState (\qs -> qs {queryTimeOutValue = Just n})                  r <- q                  modifyQueryState (\qs -> qs {queryTimeOutValue = Nothing})@@ -730,8 +798,8 @@                         Left  e   -> fCont r (Just [e])                         Right res -> sCont res --- | Bail out if we don't get what we expected-unexpected :: String -> String -> String -> Maybe [String] -> String -> Maybe [String] -> Query a+-- | Generalization of 'Data.SBV.Control.unexpected'+unexpected :: (MonadIO m, MonadQuery m) => String -> String -> String -> Maybe [String] -> String -> Maybe [String] -> m a unexpected ctx sent expected mbHint received mbReason = do         -- empty the response channel first         extras <- retrieveResponse "terminating upon unexpected response" (Just 5000000)@@ -753,8 +821,8 @@         io $ C.throwIO exc  -- | Convert a query result to an SMT Problem-runProofOn :: SBVRunMode -> [String] -> Result -> SMTProblem-runProofOn rm comments res@(Result ki _qcInfo _observables _codeSegs is consts tbls arrs uis axs pgm cstrs _assertions outputs) =+runProofOn :: SBVRunMode -> QueryContext -> [String] -> Result -> SMTProblem+runProofOn rm context comments res@(Result ki _qcInfo _observables _codeSegs is consts tbls arrs uis axs pgm cstrs _assertions outputs) =      let (config, isSat, isSafe, isSetup) = case rm of                                               SMTMode stage s c -> (c, s, isSafetyCheckingIStage stage, isSetupIStage stage)                                               _                 -> error $ "runProofOn: Unexpected run mode: " ++ show rm@@ -762,7 +830,7 @@          flipQ (ALL, x) = (EX,  x)          flipQ (EX,  x) = (ALL, x) -         skolemize :: [(Quantifier, NamedSymVar)] -> [Either SW (SW, [SW])]+         skolemize :: [(Quantifier, NamedSymVar)] -> [Either SV (SV, [SV])]          skolemize quants = go quants ([], [])            where go []                   (_,  sofar) = reverse sofar                  go ((ALL, (v, _)):rest) (us, sofar) = go rest (v:us, Left v : sofar)@@ -771,11 +839,11 @@          qinps      = if isSat then fst is else map flipQ (fst is)          skolemMap  = skolemize qinps -         o | isSafe = trueSW+         o | isSafe = trueSV            | True   = case outputs of-                        []  | isSetup -> trueSW+                        []  | isSetup -> trueSV                         [so]          -> case so of-                                           SW KBool _ -> so+                                           SV KBool _ -> so                                            _          -> error $ unlines [ "Impossible happened, non-boolean output: " ++ show so                                                                          , "Detected while generating the trace:\n" ++ show res                                                                          ]@@ -784,12 +852,12 @@                                                , "*** Check calls to \"output\", they are typically not needed!"                                                ] -     in SMTProblem { smtLibPgm = toSMTLib config ki isSat comments is skolemMap consts tbls arrs uis axs pgm cstrs o }+     in SMTProblem { smtLibPgm = toSMTLib config context ki isSat comments is skolemMap consts tbls arrs uis axs pgm cstrs o } --- | Execute a query-executeQuery :: QueryContext -> Query a -> Symbolic a-executeQuery queryContext (Query userQuery) = do-     st <- R.ask+-- | Generalization of 'Data.SBV.Control.executeQuery'+executeQuery :: forall m a. ExtractIO m => QueryContext -> QueryT m a -> SymbolicT m a+executeQuery queryContext (QueryT userQuery) = do+     st <- symbolicEnv      rm <- liftIO $ readIORef (runMode st)       -- If we're doing an external query, then we cannot allow quantifiers to be present. Why?@@ -841,20 +909,21 @@       case rm of         -- Transitioning from setup-        SMTMode stage isSAT cfg | not (isRunIStage stage) -> liftIO $ do+        SMTMode stage isSAT cfg | not (isRunIStage stage) -> do                                                  let backend = engine (solver cfg) -                                                res     <- extractSymbolicSimulationState st-                                                setOpts <- reverse <$> readIORef (rSMTOptions st)+                                                res     <- liftIO $ extractSymbolicSimulationState st+                                                setOpts <- liftIO $ reverse <$> readIORef (rSMTOptions st) -                                                let SMTProblem{smtLibPgm} = runProofOn rm [] res+                                                let SMTProblem{smtLibPgm} = runProofOn rm queryContext [] res                                                     cfg' = cfg { solverSetOptions = solverSetOptions cfg ++ setOpts }                                                     pgm  = smtLibPgm cfg' -                                                writeIORef (runMode st) $ SMTMode IRun isSAT cfg+                                                liftIO $ writeIORef (runMode st) $ SMTMode IRun isSAT cfg -                                                backend cfg' st (show pgm) $ evalStateT userQuery+                                                lift $ join $ liftIO $ backend cfg' st (show pgm) $+                                                    extractIO . runReaderT userQuery          -- Already in a query, in theory we can just continue, but that causes use-case issues         -- so we reject it. TODO: Review if we should actually support this. The issue arises with
Data/SBV/Core/AlgReals.hs view
@@ -1,16 +1,17 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Core.AlgReals--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Core.AlgReals+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Algrebraic reals in Haskell. -----------------------------------------------------------------------------  {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE TypeSynonymInstances #-}+ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Data.SBV.Core.AlgReals (
Data/SBV/Core/Concrete.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Core.Concrete--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Core.Concrete+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Operations on concrete values -----------------------------------------------------------------------------@@ -27,106 +27,110 @@ import Data.SBV.Utils.Numeric (fpIsEqualObjectH, fpCompareObjectH)  -- | A constant value-data CWVal = CWAlgReal  !AlgReal              -- ^ algebraic real-           | CWInteger  !Integer              -- ^ bit-vector/unbounded integer-           | CWFloat    !Float                -- ^ float-           | CWDouble   !Double               -- ^ double-           | CWChar     !Char                 -- ^ character-           | CWString   !String               -- ^ string-           | CWList     ![CWVal]              -- ^ list-           | CWUserSort !(Maybe Int, String)  -- ^ value of an uninterpreted/user kind. The Maybe Int shows index position for enumerations+data CVal = CAlgReal  !AlgReal             -- ^ algebraic real+          | CInteger  !Integer             -- ^ bit-vector/unbounded integer+          | CFloat    !Float               -- ^ float+          | CDouble   !Double              -- ^ double+          | CChar     !Char                -- ^ character+          | CString   !String              -- ^ string+          | CList     ![CVal]              -- ^ list+          | CUserSort !(Maybe Int, String) -- ^ value of an uninterpreted/user kind. The Maybe Int shows index position for enumerations+          | CTuple    ![CVal]              -- ^ tuple --- | Assing a rank to CW Values, this is structural and helps with ordering-cwRank :: CWVal -> Int-cwRank CWAlgReal  {} = 0-cwRank CWInteger  {} = 1-cwRank CWFloat    {} = 2-cwRank CWDouble   {} = 3-cwRank CWChar     {} = 4-cwRank CWString   {} = 5-cwRank CWList     {} = 6-cwRank CWUserSort {} = 7+-- | Assing a rank to constant values, this is structural and helps with ordering+cvRank :: CVal -> Int+cvRank CAlgReal  {} = 0+cvRank CInteger  {} = 1+cvRank CFloat    {} = 2+cvRank CDouble   {} = 3+cvRank CChar     {} = 4+cvRank CString   {} = 5+cvRank CList     {} = 6+cvRank CUserSort {} = 7+cvRank CTuple    {} = 8 --- | Eq instance for CWVal. Note that we cannot simply derive Eq/Ord, since CWAlgReal doesn't have proper+-- | Eq instance for CVVal. Note that we cannot simply derive Eq/Ord, since CVAlgReal doesn't have proper -- instances for these when values are infinitely precise reals. However, we do -- need a structural eq/ord for Map indexes; so define custom ones here:-instance Eq CWVal where-  CWAlgReal  a == CWAlgReal  b = a `algRealStructuralEqual` b-  CWInteger  a == CWInteger  b = a == b-  CWFloat    a == CWFloat    b = a `fpIsEqualObjectH` b   -- We don't want +0/-0 to be confused; and also we want NaN = NaN here!-  CWDouble   a == CWDouble   b = a `fpIsEqualObjectH` b   -- ditto-  CWChar     a == CWChar     b = a == b-  CWString   a == CWString   b = a == b-  CWList     a == CWList     b = a == b-  CWUserSort a == CWUserSort b = a == b-  _            == _            = False+instance Eq CVal where+  CAlgReal  a == CAlgReal  b = a `algRealStructuralEqual` b+  CInteger  a == CInteger  b = a == b+  CFloat    a == CFloat    b = a `fpIsEqualObjectH` b   -- We don't want +0/-0 to be confused; and also we want NaN = NaN here!+  CDouble   a == CDouble   b = a `fpIsEqualObjectH` b   -- ditto+  CChar     a == CChar     b = a == b+  CString   a == CString   b = a == b+  CList     a == CList     b = a == b+  CUserSort a == CUserSort b = a == b+  CTuple    a == CTuple    b = a == b+  _           == _           = False --- | Ord instance for CWVal. Same comments as the 'Eq' instance why this cannot be derived.-instance Ord CWVal where-  CWAlgReal  a `compare` CWAlgReal b  = a        `algRealStructuralCompare` b-  CWInteger  a `compare` CWInteger b  = a        `compare`                  b-  CWFloat    a `compare` CWFloat b    = a        `fpCompareObjectH`         b-  CWDouble   a `compare` CWDouble b   = a        `fpCompareObjectH`         b-  CWChar     a `compare` CWChar b     = a        `compare`                  b-  CWString   a `compare` CWString b   = a        `compare`                  b-  CWList     a `compare` CWList   b   = a        `compare`                  b-  CWUserSort a `compare` CWUserSort b = a        `compare`                  b-  a            `compare` b            = cwRank a `compare`                  cwRank b+-- | Ord instance for VWVal. Same comments as the 'Eq' instance why this cannot be derived.+instance Ord CVal where+  CAlgReal  a `compare` CAlgReal b  = a        `algRealStructuralCompare` b+  CInteger  a `compare` CInteger b  = a        `compare`                  b+  CFloat    a `compare` CFloat b    = a        `fpCompareObjectH`         b+  CDouble   a `compare` CDouble b   = a        `fpCompareObjectH`         b+  CChar     a `compare` CChar b     = a        `compare`                  b+  CString   a `compare` CString b   = a        `compare`                  b+  CList     a `compare` CList   b   = a        `compare`                  b+  CUserSort a `compare` CUserSort b = a        `compare`                  b+  CTuple    a `compare` CTuple    b = a        `compare`                  b+  a           `compare` b           = cvRank a `compare`                  cvRank b --- | 'CW' represents a concrete word of a fixed size:+-- | 'CV' represents a concrete word of a fixed size: -- For signed words, the most significant digit is considered to be the sign.-data CW = CW { _cwKind  :: !Kind-             , cwVal    :: !CWVal+data CV = CV { _cvKind  :: !Kind+             , cvVal    :: !CVal              }         deriving (Eq, Ord) --- | A generalized CW allows for expressions involving infinite and epsilon values/intervals Used in optimization problems.-data GeneralizedCW = ExtendedCW ExtCW-                   | RegularCW  CW+-- | A generalized CV allows for expressions involving infinite and epsilon values/intervals Used in optimization problems.+data GeneralizedCV = ExtendedCV ExtCV+                   | RegularCV  CV  -- | A simple expression type over extendent values, covering infinity, epsilon and intervals.-data ExtCW = Infinite  Kind         -- infinity+data ExtCV = Infinite  Kind         -- infinity            | Epsilon   Kind         -- epsilon-           | Interval  ExtCW ExtCW  -- closed interval-           | BoundedCW CW           -- a bounded value (i.e., neither infinity, nor epsilon). Note that this cannot appear at top, but can appear as a sub-expr.-           | AddExtCW  ExtCW ExtCW  -- addition-           | MulExtCW  ExtCW ExtCW  -- multiplication+           | Interval  ExtCV ExtCV  -- closed interval+           | BoundedCV CV           -- a bounded value (i.e., neither infinity, nor epsilon). Note that this cannot appear at top, but can appear as a sub-expr.+           | AddExtCV  ExtCV ExtCV  -- addition+           | MulExtCV  ExtCV ExtCV  -- multiplication --- | Kind instance for Extended CW-instance HasKind ExtCW where+-- | Kind instance for Extended CV+instance HasKind ExtCV where   kindOf (Infinite  k)   = k   kindOf (Epsilon   k)   = k   kindOf (Interval  l _) = kindOf l-  kindOf (BoundedCW  c)  = kindOf c-  kindOf (AddExtCW  l _) = kindOf l-  kindOf (MulExtCW  l _) = kindOf l+  kindOf (BoundedCV  c)  = kindOf c+  kindOf (AddExtCV  l _) = kindOf l+  kindOf (MulExtCV  l _) = kindOf l  -- | Show instance, shows with the kind-instance Show ExtCW where-  show = showExtCW True+instance Show ExtCV where+  show = showExtCV True --- | Show an extended CW, with kind if required-showExtCW :: Bool -> ExtCW -> String-showExtCW = go False-  where go parens shk extCW = case extCW of+-- | Show an extended CV, with kind if required+showExtCV :: Bool -> ExtCV -> String+showExtCV = go False+  where go parens shk extCV = case extCV of                                 Infinite{}    -> withKind False "oo"                                 Epsilon{}     -> withKind False "epsilon"-                                Interval  l u -> withKind True  $ '['  : showExtCW False l ++ " .. " ++ showExtCW False u ++ "]"-                                BoundedCW c   -> showCW shk c-                                AddExtCW l r  -> par $ withKind False $ add (go True False l) (go True False r)+                                Interval  l u -> withKind True  $ '['  : showExtCV False l ++ " .. " ++ showExtCV False u ++ "]"+                                BoundedCV c   -> showCV shk c+                                AddExtCV l r  -> par $ withKind False $ add (go True False l) (go True False r)                                  -- a few niceties here to grok -oo and -epsilon-                                MulExtCW (BoundedCW (CW KUnbounded (CWInteger (-1)))) Infinite{} -> withKind False "-oo"-                                MulExtCW (BoundedCW (CW KReal      (CWAlgReal (-1)))) Infinite{} -> withKind False "-oo"-                                MulExtCW (BoundedCW (CW KUnbounded (CWInteger (-1)))) Epsilon{}  -> withKind False "-epsilon"-                                MulExtCW (BoundedCW (CW KReal      (CWAlgReal (-1)))) Epsilon{}  -> withKind False "-epsilon"+                                MulExtCV (BoundedCV (CV KUnbounded (CInteger (-1)))) Infinite{} -> withKind False "-oo"+                                MulExtCV (BoundedCV (CV KReal      (CAlgReal (-1)))) Infinite{} -> withKind False "-oo"+                                MulExtCV (BoundedCV (CV KUnbounded (CInteger (-1)))) Epsilon{}  -> withKind False "-epsilon"+                                MulExtCV (BoundedCV (CV KReal      (CAlgReal (-1)))) Epsilon{}  -> withKind False "-epsilon" -                                MulExtCW l r  -> par $ withKind False $ mul (go True False l) (go True False r)+                                MulExtCV l r  -> par $ withKind False $ mul (go True False l) (go True False r)            where par v | parens = '(' : v ++ ")"                        | True   = v                  withKind isInterval v | not shk    = v-                                       | isInterval = v ++ " :: [" ++ showBaseKind (kindOf extCW) ++ "]"-                                       | True       = v ++ " :: "  ++ showBaseKind (kindOf extCW)+                                       | isInterval = v ++ " :: [" ++ showBaseKind (kindOf extCV) ++ "]"+                                       | True       = v ++ " :: "  ++ showBaseKind (kindOf extCV)                   add :: String -> String -> String                  add n v@@ -136,162 +140,176 @@                  mul :: String -> String -> String                  mul n v = n ++ " * " ++ v --- | Is this a regular CW?-isRegularCW :: GeneralizedCW -> Bool-isRegularCW RegularCW{}  = True-isRegularCW ExtendedCW{} = False+-- | Is this a regular CV?+isRegularCV :: GeneralizedCV -> Bool+isRegularCV RegularCV{}  = True+isRegularCV ExtendedCV{} = False --- | 'Kind' instance for CW-instance HasKind CW where-  kindOf (CW k _) = k+-- | 'Kind' instance for CV+instance HasKind CV where+  kindOf (CV k _) = k --- | 'Kind' instance for generalized CW-instance HasKind GeneralizedCW where-  kindOf (ExtendedCW e) = kindOf e-  kindOf (RegularCW  c) = kindOf c+-- | 'Kind' instance for generalized CV+instance HasKind GeneralizedCV where+  kindOf (ExtendedCV e) = kindOf e+  kindOf (RegularCV  c) = kindOf c --- | Are two CW's of the same type?-cwSameType :: CW -> CW -> Bool-cwSameType x y = kindOf x == kindOf y+-- | Are two CV's of the same type?+cvSameType :: CV -> CV -> Bool+cvSameType x y = kindOf x == kindOf y --- | Convert a CW to a Haskell boolean (NB. Assumes input is well-kinded)-cwToBool :: CW -> Bool-cwToBool x = cwVal x /= CWInteger 0+-- | Convert a CV to a Haskell boolean (NB. Assumes input is well-kinded)+cvToBool :: CV -> Bool+cvToBool x = cvVal x /= CInteger 0 --- | Normalize a CW. Essentially performs modular arithmetic to make sure the+-- | Normalize a CV. Essentially performs modular arithmetic to make sure the -- value can fit in the given bit-size. Note that this is rather tricky for -- negative values, due to asymmetry. (i.e., an 8-bit negative number represents -- values in the range -128 to 127; thus we have to be careful on the negative side.)-normCW :: CW -> CW-normCW c@(CW (KBounded signed sz) (CWInteger v)) = c { cwVal = CWInteger norm }+normCV :: CV -> CV+normCV c@(CV (KBounded signed sz) (CInteger v)) = c { cvVal = CInteger norm }  where norm | sz == 0 = 0             | signed  = let rg = 2 ^ (sz - 1)                         in case divMod v rg of                                   (a, b) | even a -> b                                   (_, b)          -> b - rg             | True    = v `mod` (2 ^ sz)-normCW c@(CW KBool (CWInteger v)) = c { cwVal = CWInteger (v .&. 1) }-normCW c = c+normCV c@(CV KBool (CInteger v)) = c { cvVal = CInteger (v .&. 1) }+normCV c                         = c --- | Constant False as a CW. We represent it using the integer value 0.-falseCW :: CW-falseCW = CW KBool (CWInteger 0)+-- | Constant False as a 'CV'. We represent it using the integer value 0.+falseCV :: CV+falseCV = CV KBool (CInteger 0) --- | Constant True as a CW. We represent it using the integer value 1.-trueCW :: CW-trueCW  = CW KBool (CWInteger 1)+-- | Constant True as a 'CV'. We represent it using the integer value 1.+trueCV :: CV+trueCV  = CV KBool (CInteger 1) --- | Lift a unary function through a CW-liftCW :: (AlgReal -> b) -> (Integer -> b) -> (Float -> b) -> (Double -> b) -> (Char -> b) -> (String -> b) -> ((Maybe Int, String) -> b) -> ([CWVal] -> b) -> CW -> b-liftCW f _ _ _ _ _ _ _ (CW _ (CWAlgReal  v)) = f v-liftCW _ f _ _ _ _ _ _ (CW _ (CWInteger  v)) = f v-liftCW _ _ f _ _ _ _ _ (CW _ (CWFloat    v)) = f v-liftCW _ _ _ f _ _ _ _ (CW _ (CWDouble   v)) = f v-liftCW _ _ _ _ f _ _ _ (CW _ (CWChar     v)) = f v-liftCW _ _ _ _ _ f _ _ (CW _ (CWString   v)) = f v-liftCW _ _ _ _ _ _ f _ (CW _ (CWUserSort v)) = f v-liftCW _ _ _ _ _ _ _ f (CW _ (CWList     v)) = f v+-- | Lift a unary function through a 'CV'.+liftCV :: (AlgReal -> b) -> (Integer -> b) -> (Float -> b) -> (Double -> b) -> (Char -> b) -> (String -> b) -> ((Maybe Int, String) -> b) -> ([CVal] -> b) -> ([CVal] -> b) -> CV -> b+liftCV f _ _ _ _ _ _ _ _ (CV _ (CAlgReal  v)) = f v+liftCV _ f _ _ _ _ _ _ _ (CV _ (CInteger  v)) = f v+liftCV _ _ f _ _ _ _ _ _ (CV _ (CFloat    v)) = f v+liftCV _ _ _ f _ _ _ _ _ (CV _ (CDouble   v)) = f v+liftCV _ _ _ _ f _ _ _ _ (CV _ (CChar     v)) = f v+liftCV _ _ _ _ _ f _ _ _ (CV _ (CString   v)) = f v+liftCV _ _ _ _ _ _ f _ _ (CV _ (CUserSort v)) = f v+liftCV _ _ _ _ _ _ _ f _ (CV _ (CList     v)) = f v+liftCV _ _ _ _ _ _ _ _ f (CV _ (CTuple    v)) = f v --- | Lift a binary function through a CW-liftCW2 :: (AlgReal -> AlgReal -> b) -> (Integer -> Integer -> b) -> (Float -> Float -> b) -> (Double -> Double -> b) -> (Char -> Char -> b) -> (String -> String -> b) -> ([CWVal] -> [CWVal] -> b) -> ((Maybe Int, String) -> (Maybe Int, String) -> b) -> CW -> CW -> b-liftCW2 r i f d c s u v x y = case (cwVal x, cwVal y) of-                                (CWAlgReal  a, CWAlgReal  b) -> r a b-                                (CWInteger  a, CWInteger  b) -> i a b-                                (CWFloat    a, CWFloat    b) -> f a b-                                (CWDouble   a, CWDouble   b) -> d a b-                                (CWChar     a, CWChar     b) -> c a b-                                (CWString   a, CWString   b) -> s a b-                                (CWList     a, CWList     b) -> u a b-                                (CWUserSort a, CWUserSort b) -> v a b-                                _                            -> error $ "SBV.liftCW2: impossible, incompatible args received: " ++ show (x, y)+-- | Lift a binary function through a 'CV'.+liftCV2 :: (AlgReal -> AlgReal -> b) -> (Integer -> Integer -> b) -> (Float -> Float -> b) -> (Double -> Double -> b) -> (Char -> Char -> b) -> (String -> String -> b) -> ([CVal] -> [CVal] -> b) -> ([CVal] -> [CVal] -> b) -> ((Maybe Int, String) -> (Maybe Int, String) -> b) -> CV -> CV -> b+liftCV2 r i f d c s u v w x y = case (cvVal x, cvVal y) of+                                (CAlgReal  a, CAlgReal  b) -> r a b+                                (CInteger  a, CInteger  b) -> i a b+                                (CFloat    a, CFloat    b) -> f a b+                                (CDouble   a, CDouble   b) -> d a b+                                (CChar     a, CChar     b) -> c a b+                                (CString   a, CString   b) -> s a b+                                (CList     a, CList     b) -> u a b+                                (CTuple    a, CTuple    b) -> v a b+                                (CUserSort a, CUserSort b) -> w a b+                                _                          -> error $ "SBV.liftCV2: impossible, incompatible args received: " ++ show (x, y) --- | Map a unary function through a CW.-mapCW :: (AlgReal -> AlgReal) -> (Integer -> Integer) -> (Float -> Float) -> (Double -> Double) -> (Char -> Char) -> (String -> String) -> ((Maybe Int, String) -> (Maybe Int, String)) -> CW -> CW-mapCW r i f d c s u x  = normCW $ CW (kindOf x) $ case cwVal x of-                                                    CWAlgReal  a -> CWAlgReal  (r a)-                                                    CWInteger  a -> CWInteger  (i a)-                                                    CWFloat    a -> CWFloat    (f a)-                                                    CWDouble   a -> CWDouble   (d a)-                                                    CWChar     a -> CWChar     (c a)-                                                    CWString   a -> CWString   (s a)-                                                    CWUserSort a -> CWUserSort (u a)-                                                    CWList{}     -> error "Data.SBV.mapCW: Unexpected call through mapCW with lists!"+-- | Map a unary function through a 'CV'.+mapCV :: (AlgReal -> AlgReal) -> (Integer -> Integer) -> (Float -> Float) -> (Double -> Double) -> (Char -> Char) -> (String -> String) -> ((Maybe Int, String) -> (Maybe Int, String)) -> CV -> CV+mapCV r i f d c s u x  = normCV $ CV (kindOf x) $ case cvVal x of+                                                    CAlgReal  a -> CAlgReal  (r a)+                                                    CInteger  a -> CInteger  (i a)+                                                    CFloat    a -> CFloat    (f a)+                                                    CDouble   a -> CDouble   (d a)+                                                    CChar     a -> CChar     (c a)+                                                    CString   a -> CString   (s a)+                                                    CUserSort a -> CUserSort (u a)+                                                    CList{}     -> error "Data.SBV.mapCV: Unexpected call through mapCV with lists!"+                                                    CTuple{}    -> error "Data.SBV.mapCV: Unexpected call through mapCV with tuples!" --- | Map a binary function through a CW.-mapCW2 :: (AlgReal -> AlgReal -> AlgReal) -> (Integer -> Integer -> Integer) -> (Float -> Float -> Float) -> (Double -> Double -> Double) -> (Char -> Char -> Char) -> (String -> String -> String) -> ((Maybe Int, String) -> (Maybe Int, String) -> (Maybe Int, String)) -> CW -> CW -> CW-mapCW2 r i f d c s u x y = case (cwSameType x y, cwVal x, cwVal y) of-                            (True, CWAlgReal  a, CWAlgReal  b) -> normCW $ CW (kindOf x) (CWAlgReal  (r a b))-                            (True, CWInteger  a, CWInteger  b) -> normCW $ CW (kindOf x) (CWInteger  (i a b))-                            (True, CWFloat    a, CWFloat    b) -> normCW $ CW (kindOf x) (CWFloat    (f a b))-                            (True, CWDouble   a, CWDouble   b) -> normCW $ CW (kindOf x) (CWDouble   (d a b))-                            (True, CWChar     a, CWChar     b) -> normCW $ CW (kindOf x) (CWChar     (c a b))-                            (True, CWString   a, CWString   b) -> normCW $ CW (kindOf x) (CWString   (s a b))-                            (True, CWUserSort a, CWUserSort b) -> normCW $ CW (kindOf x) (CWUserSort (u a b))-                            (True, CWList{},     CWList{})     -> error "Data.SBV.mapCW2: Unexpected call through mapCW2 with lists!"-                            _                                  -> error $ "SBV.mapCW2: impossible, incompatible args received: " ++ show (x, y)+-- | Map a binary function through a 'CV'.+mapCV2 :: (AlgReal -> AlgReal -> AlgReal) -> (Integer -> Integer -> Integer) -> (Float -> Float -> Float) -> (Double -> Double -> Double) -> (Char -> Char -> Char) -> (String -> String -> String) -> ((Maybe Int, String) -> (Maybe Int, String) -> (Maybe Int, String)) -> CV -> CV -> CV+mapCV2 r i f d c s u x y = case (cvSameType x y, cvVal x, cvVal y) of+                            (True, CAlgReal  a, CAlgReal  b) -> normCV $ CV (kindOf x) (CAlgReal  (r a b))+                            (True, CInteger  a, CInteger  b) -> normCV $ CV (kindOf x) (CInteger  (i a b))+                            (True, CFloat    a, CFloat    b) -> normCV $ CV (kindOf x) (CFloat    (f a b))+                            (True, CDouble   a, CDouble   b) -> normCV $ CV (kindOf x) (CDouble   (d a b))+                            (True, CChar     a, CChar     b) -> normCV $ CV (kindOf x) (CChar     (c a b))+                            (True, CString   a, CString   b) -> normCV $ CV (kindOf x) (CString   (s a b))+                            (True, CUserSort a, CUserSort b) -> normCV $ CV (kindOf x) (CUserSort (u a b))+                            (True, CList{},     CList{})     -> error "Data.SBV.mapCV2: Unexpected call through mapCV2 with lists!"+                            _                                -> error $ "SBV.mapCV2: impossible, incompatible args received: " ++ show (x, y) --- | Show instance for 'CW'.-instance Show CW where-  show = showCW True+-- | Show instance for 'CV'.+instance Show CV where+  show = showCV True --- | Show instance for Generalized 'CW'-instance Show GeneralizedCW where-  show (ExtendedCW k) = showExtCW True k-  show (RegularCW  c) = showCW    True c+-- | Show instance for Generalized 'CV'+instance Show GeneralizedCV where+  show (ExtendedCV k) = showExtCV True k+  show (RegularCV  c) = showCV    True c --- | Show a CW, with kind info if bool is True-showCW :: Bool -> CW -> String-showCW shk w | isBoolean w = show (cwToBool w) ++ (if shk then " :: Bool" else "")-showCW shk w               = liftCW show show show show show show snd shL w ++ kInfo+-- | Show a CV, with kind info if bool is True+showCV :: Bool -> CV -> String+showCV shk w | isBoolean w = show (cvToBool w) ++ (if shk then " :: Bool" else "")+showCV shk w               = liftCV show show show show show show snd shL shT w ++ kInfo       where kInfo | shk  = " :: " ++ showBaseKind (kindOf w)                   | True = ""-            shL xs = "[" ++ intercalate "," (map (showCW False . CW ke) xs) ++ "]"++            shL xs = "[" ++ intercalate "," (map (showCV False . CV ke) xs) ++ "]"               where ke = case kindOf w of                            KList k -> k-                           kw      -> error $ "Data.SBV.showCW: Impossible happened, expected list, got: " ++ show kw+                           kw      -> error $ "Data.SBV.showCV: Impossible happened, expected list, got: " ++ show kw +            shT :: [CVal] -> String+            shT xs = "(" ++ intercalate "," xs' ++ ")"+              where xs' = case kindOf w of+                            KTuple ks | length ks == length xs -> zipWith (\k x -> showCV False (CV k x)) ks xs+                            kw -> error $ "Data.SBV.showCV: Impossible happened, expected tuple (of length " ++ show (length xs) ++ "), got: " ++ show kw+ -- | A version of show for kinds that says Bool instead of SBool showBaseKind :: Kind -> String-showBaseKind k@KUserSort {} = show k   -- Leave user-sorts untouched!+showBaseKind k@KUninterpreted{} = show k   -- Leave user-sorts untouched!+showBaseKind (KList k)          = "[" ++ showBaseKind k ++ "]"+showBaseKind (KTuple ks)        = "(" ++ intercalate ", " (map showBaseKind ks) ++ ")" showBaseKind k = case show k of                    ('S':sk) -> sk                    s        -> s  -- | Create a constant word from an integral.-mkConstCW :: Integral a => Kind -> a -> CW-mkConstCW KBool        a = normCW $ CW KBool      (CWInteger (toInteger a))-mkConstCW k@KBounded{} a = normCW $ CW k          (CWInteger (toInteger a))-mkConstCW KUnbounded   a = normCW $ CW KUnbounded (CWInteger (toInteger a))-mkConstCW KReal        a = normCW $ CW KReal      (CWAlgReal (fromInteger (toInteger a)))-mkConstCW KFloat       a = normCW $ CW KFloat     (CWFloat   (fromInteger (toInteger a)))-mkConstCW KDouble      a = normCW $ CW KDouble    (CWDouble  (fromInteger (toInteger a)))-mkConstCW KChar        a = error $ "Unexpected call to mkConstCW (Char) with value: " ++ show (toInteger a)-mkConstCW KString      a = error $ "Unexpected call to mkConstCW (String) with value: " ++ show (toInteger a)-mkConstCW k@KList{}    a = error $ "Unexpected call to mkConstCW (" ++ show k ++ ") with value: " ++ show (toInteger a)-mkConstCW (KUserSort s _) a = error $ "Unexpected call to mkConstCW with uninterpreted kind: " ++ s ++ " with value: " ++ show (toInteger a)+mkConstCV :: Integral a => Kind -> a -> CV+mkConstCV KBool                a = normCV $ CV KBool      (CInteger (toInteger a))+mkConstCV k@KBounded{}         a = normCV $ CV k          (CInteger (toInteger a))+mkConstCV KUnbounded           a = normCV $ CV KUnbounded (CInteger (toInteger a))+mkConstCV KReal                a = normCV $ CV KReal      (CAlgReal (fromInteger (toInteger a)))+mkConstCV KFloat               a = normCV $ CV KFloat     (CFloat   (fromInteger (toInteger a)))+mkConstCV KDouble              a = normCV $ CV KDouble    (CDouble  (fromInteger (toInteger a)))+mkConstCV KChar                a = error $ "Unexpected call to mkConstCV (Char) with value: " ++ show (toInteger a)+mkConstCV KString              a = error $ "Unexpected call to mkConstCV (String) with value: " ++ show (toInteger a)+mkConstCV (KUninterpreted s _) a = error $ "Unexpected call to mkConstCV with uninterpreted kind: " ++ s ++ " with value: " ++ show (toInteger a)+mkConstCV k@KList{}            a = error $ "Unexpected call to mkConstCV (" ++ show k ++ ") with value: " ++ show (toInteger a)+mkConstCV k@KTuple{}           a = error $ "Unexpected call to mkConstCV (" ++ show k ++ ") with value: " ++ show (toInteger a) --- | Generate a random constant value ('CWVal') of the correct kind.-randomCWVal :: Kind -> IO CWVal-randomCWVal k =+-- | Generate a random constant value ('CVal') of the correct kind.+randomCVal :: Kind -> IO CVal+randomCVal k =   case k of-    KBool         -> CWInteger <$> randomRIO (0, 1)-    KBounded s w  -> CWInteger <$> randomRIO (bounds s w)-    KUnbounded    -> CWInteger <$> randomIO-    KReal         -> CWAlgReal <$> randomIO-    KFloat        -> CWFloat   <$> randomIO-    KDouble       -> CWDouble  <$> randomIO+    KBool              -> CInteger <$> randomRIO (0, 1)+    KBounded s w       -> CInteger <$> randomRIO (bounds s w)+    KUnbounded         -> CInteger <$> randomIO+    KReal              -> CAlgReal <$> randomIO+    KFloat             -> CFloat   <$> randomIO+    KDouble            -> CDouble  <$> randomIO     -- TODO: KString/KChar currently only go for 0..255; include unicode?-    KString       -> do l <- randomRIO (0, 100)-                        CWString <$> replicateM l (chr <$> randomRIO (0, 255))-    KChar         -> CWChar . chr <$> randomRIO (0, 255)-    KUserSort s _ -> error $ "Unexpected call to randomCWVal with uninterpreted kind: " ++ s-    KList ek      -> do l <- randomRIO (0, 100)-                        CWList <$> replicateM l (randomCWVal ek)+    KString            -> do l <- randomRIO (0, 100)+                             CString <$> replicateM l (chr <$> randomRIO (0, 255))+    KChar              -> CChar . chr <$> randomRIO (0, 255)+    KUninterpreted s _ -> error $ "Unexpected call to randomCVal with uninterpreted kind: " ++ s+    KList ek           -> do l <- randomRIO (0, 100)+                             CList <$> replicateM l (randomCVal ek)+    KTuple ks          -> CTuple <$> traverse randomCVal ks   where     bounds :: Bool -> Int -> (Integer, Integer)     bounds False w = (0, 2^w - 1)     bounds True  w = (-x, x-1) where x = 2^(w-1) --- | Generate a random constant value ('CW') of the correct kind.-randomCW :: Kind -> IO CW-randomCW k = CW k <$> randomCWVal k+-- | Generate a random constant value ('CV') of the correct kind.+randomCV :: Kind -> IO CV+randomCV k = CV k <$> randomCVal k
Data/SBV/Core/Data.hs view
@@ -1,43 +1,46 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Core.Data--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Core.Data+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Internal data-structures for the sbv library -----------------------------------------------------------------------------  {-# LANGUAGE CPP                   #-}-{-# LANGUAGE TypeSynonymInstances  #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE DeriveAnyClass        #-}+{-# LANGUAGE DeriveGeneric         #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE InstanceSigs          #-}-{-# LANGUAGE PatternGuards         #-}-{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns        #-}-{-# LANGUAGE DeriveAnyClass        #-}-{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE PatternGuards         #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE TypeSynonymInstances  #-}  module Data.SBV.Core.Data  ( SBool, SWord8, SWord16, SWord32, SWord64  , SInt8, SInt16, SInt32, SInt64, SInteger, SReal, SFloat, SDouble, SChar, SString, SList+ , STuple2, STuple3, STuple4, STuple5, STuple6, STuple7, STuple8  , nan, infinity, sNaN, sInfinity, RoundingMode(..), SRoundingMode  , sRoundNearestTiesToEven, sRoundNearestTiesToAway, sRoundTowardPositive, sRoundTowardNegative, sRoundTowardZero  , sRNE, sRNA, sRTP, sRTN, sRTZ- , SymWord(..)- , CW(..), CWVal(..), AlgReal(..), AlgRealPoly, ExtCW(..), GeneralizedCW(..), isRegularCW, cwSameType, cwToBool- , mkConstCW ,liftCW2, mapCW, mapCW2- , SW(..), trueSW, falseSW, trueCW, falseCW, normCW+ , SymVal(..)+ , CV(..), CVal(..), AlgReal(..), AlgRealPoly, ExtCV(..), GeneralizedCV(..), isRegularCV, cvSameType, cvToBool+ , mkConstCV ,liftCV2, mapCV, mapCV2+ , SV(..), trueSV, falseSV, trueCV, falseCV, normCV  , SVal(..)+ , sTrue, sFalse, sNot, (.&&), (.||), (.<+>), (.~&), (.~|), (.=>), (.<=>), sAnd, sOr, sAny, sAll, fromBool  , SBV(..), NodeId(..), mkSymSBV  , ArrayContext(..), ArrayInfo, SymArray(..), SFunArray(..), SArray(..)- , sbvToSW, sbvToSymSW, forceSWArg+ , sbvToSV, sbvToSymSV, forceSVArg  , SBVExpr(..), newExpr  , cache, Cached, uncache, uncacheAI, HasKind(..)  , Op(..), PBOp(..), FPOp(..), StrOp(..), SeqOp(..), RegExp(..), NamedSymVar, getTableIndex@@ -51,21 +54,22 @@  , extractSymbolicSimulationState  , SMTScript(..), Solver(..), SMTSolver(..), SMTResult(..), SMTModel(..), SMTConfig(..)  , OptimizeStyle(..), Penalty(..), Objective(..)- , QueryState(..), Query(..), SMTProblem(..)+ , QueryState(..), QueryT(..), SMTProblem(..)  ) where  import GHC.Generics (Generic) import GHC.Exts     (IsList(..)) -import Control.DeepSeq      (NFData(..))-import Control.Monad.Reader (ask)-import Control.Monad.Trans  (liftIO)-import Data.Int             (Int8, Int16, Int32, Int64)-import Data.Word            (Word8, Word16, Word32, Word64)-import Data.List            (elemIndex)-import Data.Maybe           (fromMaybe)-import Data.Typeable        (Typeable)+import Control.DeepSeq        (NFData(..))+import Control.Monad.Trans    (liftIO)+import Data.Int               (Int8, Int16, Int32, Int64)+import Data.Word              (Word8, Word16, Word32, Word64)+import Data.List              (elemIndex)+import Data.Maybe             (fromMaybe) +import Data.Proxy+import Data.Typeable          (Typeable)+ import qualified Data.Generics as G    (Data(..))  import System.Random@@ -81,7 +85,6 @@ import Data.SBV.SMT.SMTLibNames  import Data.SBV.Utils.Lib-import Data.SBV.Utils.Boolean  -- | Get the current path condition getPathCondition :: State -> SBool@@ -158,8 +161,29 @@ -- Note that lists can be nested, i.e., we do allow lists of lists of ... items. type SList a = SBV [a] +-- | Symbolic 2-tuple.+type STuple2 a b = SBV (a, b)++-- | Symbolic 3-tuple.+type STuple3 a b c = SBV (a, b, c)++-- | Symbolic 4-tuple.+type STuple4 a b c d = SBV (a, b, c, d)++-- | Symbolic 5-tuple.+type STuple5 a b c d e = SBV (a, b, c, d, e)++-- | Symbolic 6-tuple.+type STuple6 a b c d e f = SBV (a, b, c, d, e, f)++-- | Symbolic 7-tuple.+type STuple7 a b c d e f g = SBV (a, b, c, d, e, f, g)++-- | Symbolic 8-tuple.+type STuple8 a b c d e f g h = SBV (a, b, c, d, e, f, g, h)+ -- | IsList instance allows list literals to be written compactly.-instance SymWord [a] => IsList (SList a) where+instance SymVal [a] => IsList (SList a) where   type Item (SList a) = a   fromList = literal   toList x = fromMaybe (error "IsList.toList used in a symbolic context!") (unliteral x)@@ -176,28 +200,87 @@  -- | Symbolic variant of Not-A-Number. This value will inhabit both -- 'SDouble' and 'SFloat'.-sNaN :: (Floating a, SymWord a) => SBV a+sNaN :: (Floating a, SymVal a) => SBV a sNaN = literal nan  -- | Symbolic variant of infinity. This value will inhabit both -- 'SDouble' and 'SFloat'.-sInfinity :: (Floating a, SymWord a) => SBV a+sInfinity :: (Floating a, SymVal a) => SBV a sInfinity = literal infinity  -- | Internal representation of a symbolic simulation result newtype SMTProblem = SMTProblem {smtLibPgm :: SMTConfig -> SMTLibPgm} -- ^ SMTLib representation, given the config --- Boolean combinators-instance Boolean SBool where-  true  = SBV (svBool True)-  false = SBV (svBool False)-  bnot (SBV b) = SBV (svNot b)-  SBV a &&& SBV b = SBV (svAnd a b)-  SBV a ||| SBV b = SBV (svOr a b)-  SBV a <+> SBV b = SBV (svXOr a b)+-- | Symbolic 'True'+sTrue :: SBool+sTrue = SBV (svBool True) +-- | Symbolic 'False'+sFalse :: SBool+sFalse = SBV (svBool False)++-- | Symbolic boolean negation+sNot :: SBool -> SBool+sNot (SBV b) = SBV (svNot b)++-- | Symbolic conjunction+infixr 3 .&&+(.&&) :: SBool -> SBool -> SBool+SBV x .&& SBV y = SBV (x `svAnd` y)++-- | Symbolic disjunction+infixr 2 .||+(.||) :: SBool -> SBool -> SBool+SBV x .|| SBV y = SBV (x `svOr` y)++-- | Symbolic logical xor+infixl 6 .<+>+(.<+>) :: SBool -> SBool -> SBool+SBV x .<+> SBV y = SBV (x `svXOr` y)++-- | Symbolic nand+infixr 3 .~&+(.~&) :: SBool -> SBool -> SBool+x .~& y = sNot (x .&& y)++-- | Symbolic nor+infixr 2 .~|+(.~|) :: SBool -> SBool -> SBool+x .~| y = sNot (x .|| y)++-- | Symbolic implication+infixr 1 .=>+(.=>) :: SBool -> SBool -> SBool+x .=> y = sNot x .|| y++-- | Symbolic boolean equivalence+infixr 1 .<=>+(.<=>) :: SBool -> SBool -> SBool+x .<=> y = (x .&& y) .|| (sNot x .&& sNot y)++-- | Conversion from 'Bool' to 'SBool'+fromBool :: Bool -> SBool+fromBool True  = sTrue+fromBool False = sFalse++-- | Generalization of 'and'+sAnd :: [SBool] -> SBool+sAnd = foldr (.&&) sTrue++-- | Generalization of 'or'+sOr :: [SBool] -> SBool+sOr  = foldr (.||) sFalse++-- | Generalization of 'any'+sAny :: (a -> SBool) -> [a] -> SBool+sAny f = sOr  . map f++-- | Generalization of 'all'+sAll :: (a -> SBool) -> [a] -> SBool+sAll f = sAnd . map f+ -- | 'RoundingMode' can be used symbolically-instance SymWord RoundingMode+instance SymVal RoundingMode  -- | The symbolic variant of 'RoundingMode' type SRoundingMode = SBV RoundingMode@@ -255,26 +338,26 @@   SBV a == SBV b = a == b   SBV a /= SBV b = a /= b -instance HasKind (SBV a) where-  kindOf (SBV (SVal k _)) = k+instance HasKind a => HasKind (SBV a) where+  kindOf _ = kindOf (Proxy @a)  -- | Convert a symbolic value to a symbolic-word-sbvToSW :: State -> SBV a -> IO SW-sbvToSW st (SBV s) = svToSW st s+sbvToSV :: State -> SBV a -> IO SV+sbvToSV st (SBV s) = svToSV st s  ------------------------------------------------------------------------- -- * Symbolic Computations ------------------------------------------------------------------------- --- | Create a symbolic variable.-mkSymSBV :: forall a. Maybe Quantifier -> Kind -> Maybe String -> Symbolic (SBV a)-mkSymSBV mbQ k mbNm = SBV <$> (ask >>= liftIO . svMkSymVar mbQ k mbNm)+-- | Generalization of 'Data.SBV.mkSymSBV'+mkSymSBV :: forall a m. MonadSymbolic m => Maybe Quantifier -> Kind -> Maybe String -> m (SBV a)+mkSymSBV mbQ k mbNm = SBV <$> (symbolicEnv >>= liftIO . svMkSymVar mbQ k mbNm) --- | Convert a symbolic value to an SW, inside the Symbolic monad-sbvToSymSW :: SBV a -> Symbolic SW-sbvToSymSW sbv = do-        st <- ask-        liftIO $ sbvToSW st sbv+-- | Generalization of 'Data.SBV.sbvToSymSW'+sbvToSymSV :: MonadSymbolic m => SBV a -> m SV+sbvToSymSV sbv = do+        st <- symbolicEnv+        liftIO $ sbvToSV st sbv  -- | Actions we can do in a context: Either at problem description -- time or while we are dynamically querying. 'Symbolic' and 'Query' are@@ -309,9 +392,8 @@  -- | A class representing what can be returned from a symbolic computation. class Outputtable a where-  -- | Mark an interim result as an output. Useful when constructing Symbolic programs-  -- that return multiple values, or when the result is programmatically computed.-  output :: a -> Symbolic a+  -- | Generalization of 'Data.SBV.output'+  output :: MonadSymbolic m => a -> m a  instance Outputtable (SBV a) where   output i = do@@ -346,90 +428,106 @@   output = mlift8 (,,,,,,,) output output output output output output output output  ---------------------------------------------------------------------------------- * Symbolic Words+-- * Symbolic Values ---------------------------------------------------------------------------------- | A 'SymWord' is a potential symbolic bitvector that can be created instances of--- to be fed to a symbolic program. Note that these methods are typically not needed--- in casual uses with 'Data.SBV.prove', 'Data.SBV.sat', 'Data.SBV.allSat' etc, as--- default instances automatically provide the necessary bits.-class (HasKind a, Ord a, Typeable a) => SymWord a where-  -- | Create a user named input (universal)-  forall :: String -> Symbolic (SBV a)-  -- | Create an automatically named input-  forall_ :: Symbolic (SBV a)-  -- | Get a bunch of new words-  mkForallVars :: Int -> Symbolic [SBV a]-  -- | Create an existential variable-  exists  :: String -> Symbolic (SBV a)-  -- | Create an automatically named existential variable-  exists_ :: Symbolic (SBV a)-  -- | Create a bunch of existentials-  mkExistVars :: Int -> Symbolic [SBV a]-  -- | Create a free variable, universal in a proof, existential in sat-  free :: String -> Symbolic (SBV a)-  -- | Create an unnamed free variable, universal in proof, existential in sat-  free_ :: Symbolic (SBV a)-  -- | Create a bunch of free vars-  mkFreeVars :: Int -> Symbolic [SBV a]-  -- | Similar to free; Just a more convenient name-  symbolic  :: String -> Symbolic (SBV a)-  -- | Similar to mkFreeVars; but automatically gives names based on the strings-  symbolics :: [String] -> Symbolic [SBV a]+-- | A 'SymVal' is a potential symbolic value that can be created instances of to be fed to a symbolic program.+class (HasKind a, Ord a, Typeable a) => SymVal a where+  -- | Generalization of 'Data.SBV.mkSymVal'+  mkSymVal :: MonadSymbolic m => Maybe Quantifier -> Maybe String -> m (SBV a)   -- | Turn a literal constant to symbolic   literal :: a -> SBV a-  -- | Extract a literal, if the value is concrete-  unliteral :: SBV a -> Maybe a-  -- | Extract a literal, from a CW representation-  fromCW :: CW -> a-  -- | Is the symbolic word concrete?-  isConcrete :: SBV a -> Bool-  -- | Is the symbolic word really symbolic?-  isSymbolic :: SBV a -> Bool+  -- | Extract a literal, from a CV representation+  fromCV :: CV -> a   -- | Does it concretely satisfy the given predicate?   isConcretely :: SBV a -> (a -> Bool) -> Bool-  -- | One stop allocator-  mkSymWord :: Maybe Quantifier -> Maybe String -> Symbolic (SBV a) -  -- minimal complete definition:: Nothing.-  -- Giving no instances is ok when defining an uninterpreted/enumerated sort, but otherwise you really-  -- want to define: literal, fromCW, mkSymWord-  forall   = mkSymWord (Just ALL) . Just-  forall_  = mkSymWord (Just ALL)   Nothing-  exists   = mkSymWord (Just EX)  . Just-  exists_  = mkSymWord (Just EX)    Nothing-  free     = mkSymWord Nothing    . Just-  free_    = mkSymWord Nothing      Nothing-  mkForallVars n = mapM (const forall_) [1 .. n]-  mkExistVars n  = mapM (const exists_) [1 .. n]-  mkFreeVars n   = mapM (const free_)   [1 .. n]-  symbolic       = free-  symbolics      = mapM symbolic-  unliteral (SBV (SVal _ (Left c)))  = Just $ fromCW c-  unliteral _                        = Nothing-  isConcrete (SBV (SVal _ (Left _))) = True-  isConcrete _                       = False-  isSymbolic = not . isConcrete-  isConcretely s p-    | Just i <- unliteral s = p i-    | True                  = False+  -- minimal complete definition: Nothing.+  -- Giving no instances is okay when defining an uninterpreted/enumerated sort, but otherwise you really+  -- want to define: literal, fromCV, mkSymVal +  default mkSymVal :: (MonadSymbolic m, Read a, G.Data a) => Maybe Quantifier -> Maybe String -> m (SBV a)+  mkSymVal mbQ mbNm = SBV <$> (symbolicEnv >>= liftIO . svMkSymVar mbQ k mbNm)+    where -- NB.A call of the form+          --      constructUKind (Proxy @a)+          -- would be wrong here, as it would uninterpret the Proxy datatype!+          -- So, we have to use the dreaded undefined value in this case.+          k = constructUKind (undefined :: a)+   default literal :: Show a => a -> SBV a-  literal x = let k@(KUserSort  _ conts) = kindOf x-                  sx                     = show x+  literal x = let k@(KUninterpreted  _ conts) = kindOf x+                  sx                          = show x                   mbIdx = case conts of                             Right xs -> sx `elemIndex` xs                             _        -> Nothing-              in SBV $ SVal k (Left (CW k (CWUserSort (mbIdx, sx))))+              in SBV $ SVal k (Left (CV k (CUserSort (mbIdx, sx)))) -  default fromCW :: Read a => CW -> a-  fromCW (CW _ (CWUserSort (_, s))) = read s-  fromCW cw                         = error $ "Cannot convert CW " ++ show cw ++ " to kind " ++ show (kindOf (undefined :: a))+  default fromCV :: Read a => CV -> a+  fromCV (CV _ (CUserSort (_, s))) = read s+  fromCV cv                        = error $ "Cannot convert CV " ++ show cv ++ " to kind " ++ show (kindOf (Proxy @a)) -  default mkSymWord :: (Read a, G.Data a) => Maybe Quantifier -> Maybe String -> Symbolic (SBV a)-  mkSymWord mbQ mbNm = SBV <$> (ask >>= liftIO . svMkSymVar mbQ k mbNm)-    where k = constructUKind (undefined :: a)+  isConcretely s p+    | Just i <- unliteral s = p i+    | True                  = False -instance (Random a, SymWord a) => Random (SBV a) where+  -- | Generalization of 'Data.SBV.forall'+  forall :: MonadSymbolic m => String -> m (SBV a)+  forall = mkSymVal (Just ALL) . Just++  -- | Generalization of 'Data.SBV.forall_'+  forall_ :: MonadSymbolic m => m (SBV a)+  forall_ = mkSymVal (Just ALL) Nothing++  -- | Generalization of 'Data.SBV.mkForallVars'+  mkForallVars :: MonadSymbolic m => Int -> m [SBV a]+  mkForallVars n = mapM (const forall_) [1 .. n]++  -- | Generalization of 'Data.SBV.exists'+  exists :: MonadSymbolic m => String -> m (SBV a)+  exists = mkSymVal (Just EX) . Just++  -- | Generalization of 'Data.SBV.exists_'+  exists_ :: MonadSymbolic m => m (SBV a)+  exists_ = mkSymVal (Just EX) Nothing++  -- | Generalization of 'Data.SBV.mkExistVars'+  mkExistVars :: MonadSymbolic m => Int -> m [SBV a]+  mkExistVars n = mapM (const exists_) [1 .. n]++  -- | Generalization of 'Data.SBV.free'+  free :: MonadSymbolic m => String -> m (SBV a)+  free = mkSymVal Nothing . Just++  -- | Generalization of 'Data.SBV.free_'+  free_ :: MonadSymbolic m => m (SBV a)+  free_ = mkSymVal Nothing Nothing++  -- | Generalization of 'Data.SBV.mkFreeVars'+  mkFreeVars :: MonadSymbolic m => Int -> m [SBV a]+  mkFreeVars n = mapM (const free_) [1 .. n]++  -- | Generalization of 'Data.SBV.symbolic'+  symbolic :: MonadSymbolic m => String -> m (SBV a)+  symbolic = free++  -- | Generalization of 'Data.SBV.symbolics'+  symbolics :: MonadSymbolic m => [String] -> m [SBV a]+  symbolics = mapM symbolic++  -- | Extract a literal, if the value is concrete+  unliteral :: SBV a -> Maybe a+  unliteral (SBV (SVal _ (Left c))) = Just $ fromCV c+  unliteral _                       = Nothing++  -- | Is the symbolic word concrete?+  isConcrete :: SBV a -> Bool+  isConcrete (SBV (SVal _ (Left _))) = True+  isConcrete _                       = False++  -- | Is the symbolic word really symbolic?+  isSymbolic :: SBV a -> Bool+  isSymbolic = not . isConcrete++instance (Random a, SymVal a) => Random (SBV a) where   randomR (l, h) g = case (unliteral l, unliteral h) of                        (Just lb, Just hb) -> let (v, g') = randomR (lb, hb) g in (literal (v :: a), g')                        _                  -> error "SBV.Random: Cannot generate random values with symbolic bounds"@@ -477,31 +575,35 @@ --      'SFunArray', SBV only generates code for individual elements and the array itself never --      shows up in the resulting SMTLib program. This puts more onus on the SBV side and might --      have some performance impacts, but it might generate problems that are easier for the SMT---      solvers to handle. +--      solvers to handle. -- -- As a rule of thumb, try 'SArray' first. These should generate compact code. However, if -- the backend solver has hard time solving the generated problems, switch to -- 'SFunArray'. If you still have issues, please report so we can see what the problem might be! class SymArray array where-  -- | Create a new anonymous array, possibly with a default initial value.-  newArray_      :: (HasKind a, HasKind b) => Maybe (SBV b) -> Symbolic (array a b)-  -- | Create a named new array, possibly with a default initial value.-  newArray       :: (HasKind a, HasKind b) => String -> Maybe (SBV b) -> Symbolic (array a b)+  -- | Generalization of 'Data.SBV.newArray_'+  newArray_      :: (MonadSymbolic m, HasKind a, HasKind b) => Maybe (SBV b) -> m (array a b)+  -- | Generalization of 'Data.SBV.newArray'+  newArray       :: (MonadSymbolic m, HasKind a, HasKind b) => String -> Maybe (SBV b) -> m (array a b)   -- | Read the array element at @a@   readArray      :: array a b -> SBV a -> SBV b   -- | Update the element at @a@ to be @b@-  writeArray     :: SymWord b => array a b -> SBV a -> SBV b -> array a b+  writeArray     :: SymVal b => array a b -> SBV a -> SBV b -> array a b   -- | Merge two given arrays on the symbolic condition   -- Intuitively: @mergeArrays cond a b = if cond then a else b@.   -- Merging pushes the if-then-else choice down on to elements-  mergeArrays    :: SymWord b => SBV Bool -> array a b -> array a b -> array a b+  mergeArrays    :: SymVal b => SBV Bool -> array a b -> array a b -> array a b   -- | Internal function, not exported to the user   newArrayInState :: (HasKind a, HasKind b) => Maybe String -> Maybe (SBV b) -> State -> IO (array a b) -  {-# MINIMAL readArray, writeArray, mergeArrays, newArrayInState #-}-  newArray_   mbVal = ask >>= liftIO . newArrayInState Nothing   mbVal-  newArray nm mbVal = ask >>= liftIO . newArrayInState (Just nm) mbVal+  {-# MINIMAL readArray, writeArray, mergeArrays, ((newArray_, newArray) | newArrayInState) #-}+  newArray_   mbVal = symbolicEnv >>= liftIO . newArrayInState Nothing   mbVal+  newArray nm mbVal = symbolicEnv >>= liftIO . newArrayInState (Just nm) mbVal +  -- Despite our MINIMAL pragma and default implementations for newArray_ and+  -- newArray, we must provide a dummy implementation for newArrayInState:+  newArrayInState = error "undefined: newArrayInState"+ -- | Arrays implemented in terms of SMT-arrays: <http://smtlib.cs.uiowa.edu/theories-ArraysEx.shtml> -- --   * Maps directly to SMT-lib arrays@@ -519,7 +621,7 @@ newtype SArray a b = SArray { unSArray :: SArr }  instance (HasKind a, HasKind b) => Show (SArray a b) where-  show SArray{} = "SArray<" ++ showType (undefined :: a) ++ ":" ++ showType (undefined :: b) ++ ">"+  show SArray{} = "SArray<" ++ showType (Proxy @a) ++ ":" ++ showType (Proxy @b) ++ ">"  instance SymArray SArray where   readArray   (SArray arr) (SBV a)               = SBV (readSArr arr a)@@ -531,8 +633,8 @@                                      SArray <$> newSArr st (aknd, bknd) (mkNm mbNm) (unSBV <$> mbVal)      where mkNm Nothing   t = "array_" ++ show t            mkNm (Just nm) _ = nm-           aknd = kindOf (undefined :: a)-           bknd = kindOf (undefined :: b)+           aknd = kindOf (Proxy @a)+           bknd = kindOf (Proxy @b)  -- | Arrays implemented internally, without translating to SMT-Lib functions: --@@ -552,7 +654,7 @@ newtype SFunArray a b = SFunArray { unSFunArray :: SFunArr }  instance (HasKind a, HasKind b) => Show (SFunArray a b) where-  show SFunArray{} = "SFunArray<" ++ showType (undefined :: a) ++ ":" ++ showType (undefined :: b) ++ ">"+  show SFunArray{} = "SFunArray<" ++ showType (Proxy @a) ++ ":" ++ showType (Proxy @b) ++ ">"  instance SymArray SFunArray where   readArray   (SFunArray arr) (SBV a)             = SBV (readSFunArr arr a)@@ -564,5 +666,5 @@                                      SFunArray <$> newSFunArr st (aknd, bknd) (mkNm mbNm) (unSBV <$> mbVal)     where mkNm Nothing t   = "funArray_" ++ show t           mkNm (Just nm) _ = nm-          aknd = kindOf (undefined :: a)-          bknd = kindOf (undefined :: b)+          aknd = kindOf (Proxy @a)+          bknd = kindOf (Proxy @b)
Data/SBV/Core/Floating.hs view
@@ -1,16 +1,17 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Core.Floating--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Core.Floating+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Implementation of floating-point operations mapping to SMT-Lib2 floats -----------------------------------------------------------------------------  {-# LANGUAGE Rank2Types          #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}  module Data.SBV.Core.Floating (          IEEEFloating(..), IEEEFloatConvertable(..)@@ -23,17 +24,18 @@ import Data.Int            (Int8,  Int16,  Int32,  Int64) import Data.Word           (Word8, Word16, Word32, Word64) +import Data.Proxy+ import Data.SBV.Core.Data import Data.SBV.Core.Model import Data.SBV.Core.AlgReals (isExactRational)-import Data.SBV.Utils.Boolean import Data.SBV.Utils.Numeric  -- | A class of floating-point (IEEE754) operations, some of -- which behave differently based on rounding modes. Note that unless -- the rounding mode is concretely RoundNearestTiesToEven, we will -- not concretely evaluate these, but rather pass down to the SMT solver.-class (SymWord a, RealFloat a) => IEEEFloating a where+class (SymVal a, RealFloat a) => IEEEFloating a where   -- | Compute the floating point absolute value.   fpAbs             ::                  SBV a -> SBV a @@ -129,9 +131,9 @@   fpIsNaN            = lift1B FP_IsNaN           isNaN   fpIsNegative       = lift1B FP_IsNegative      (\x -> x < 0 ||       isNegativeZero x)   fpIsPositive       = lift1B FP_IsPositive      (\x -> x >= 0 && not (isNegativeZero x))-  fpIsNegativeZero x = fpIsZero x &&& fpIsNegative x-  fpIsPositiveZero x = fpIsZero x &&& fpIsPositive x-  fpIsPoint        x = bnot (fpIsNaN x ||| fpIsInfinite x)+  fpIsNegativeZero x = fpIsZero x .&& fpIsNegative x+  fpIsPositiveZero x = fpIsZero x .&& fpIsPositive x+  fpIsPoint        x = sNot (fpIsNaN x .|| fpIsInfinite x)  -- | SFloat instance instance IEEEFloating Float@@ -150,7 +152,7 @@   toSDouble   :: SRoundingMode -> SBV a   -> SDouble  -- | A generic converter that will work for most of our instances. (But not all!)-genericFPConverter :: forall a r. (SymWord a, HasKind r, SymWord r, Num r) => Maybe (a -> Bool) -> Maybe (SBV a -> SBool) -> (a -> r) -> SRoundingMode -> SBV a -> SBV r+genericFPConverter :: forall a r. (SymVal a, HasKind r, SymVal r, Num r) => Maybe (a -> Bool) -> Maybe (SBV a -> SBool) -> (a -> r) -> SRoundingMode -> SBV a -> SBV r genericFPConverter mbConcreteOK mbSymbolicOK converter rm f   | Just w <- unliteral f, Just RoundNearestTiesToEven <- unliteral rm, check w   = literal $ converter w@@ -161,10 +163,10 @@   where result  = SBV (SVal kTo (Right (cache y)))         check w = maybe True ($ w) mbConcreteOK         kFrom   = kindOf f-        kTo     = kindOf (undefined :: r)-        y st    = do msw <- sbvToSW st rm-                     xsw <- sbvToSW st f-                     newExpr st kTo (SBVApp (IEEEFP (FP_Cast kFrom kTo msw)) [xsw])+        kTo     = kindOf (Proxy @r)+        y st    = do msv <- sbvToSV st rm+                     xsv <- sbvToSV st f+                     newExpr st kTo (SBVApp (IEEEFP (FP_Cast kFrom kTo msv)) [xsv])  -- | Check that a given float is a point ptCheck :: IEEEFloating a => Maybe (SBV a -> SBool)@@ -244,7 +246,7 @@   toSDouble   = genericFPConverter (Just isExactRational) Nothing (fromRational . toRational)  -- | Concretely evaluate one arg function, if rounding mode is RoundNearestTiesToEven and we have enough concrete data-concEval1 :: SymWord a => Maybe (a -> a) -> Maybe SRoundingMode -> SBV a -> Maybe (SBV a)+concEval1 :: SymVal a => Maybe (a -> a) -> Maybe SRoundingMode -> SBV a -> Maybe (SBV a) concEval1 mbOp mbRm a = do op <- mbOp                            v  <- unliteral a                            case unliteral =<< mbRm of@@ -253,7 +255,7 @@                              _                           -> Nothing  -- | Concretely evaluate two arg function, if rounding mode is RoundNearestTiesToEven and we have enough concrete data-concEval2 :: SymWord a => Maybe (a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> Maybe (SBV a)+concEval2 :: SymVal a => Maybe (a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> Maybe (SBV a) concEval2 mbOp mbRm a b  = do op <- mbOp                               v1 <- unliteral a                               v2 <- unliteral b@@ -263,7 +265,7 @@                                 _                           -> Nothing  -- | Concretely evaluate a bool producing two arg function, if rounding mode is RoundNearestTiesToEven and we have enough concrete data-concEval2B :: SymWord a => Maybe (a -> a -> Bool) -> Maybe SRoundingMode -> SBV a -> SBV a -> Maybe SBool+concEval2B :: SymVal a => Maybe (a -> a -> Bool) -> Maybe SRoundingMode -> SBV a -> SBV a -> Maybe SBool concEval2B mbOp mbRm a b  = do op <- mbOp                                v1 <- unliteral a                                v2 <- unliteral b@@ -273,7 +275,7 @@                                  _                           -> Nothing  -- | Concretely evaluate two arg function, if rounding mode is RoundNearestTiesToEven and we have enough concrete data-concEval3 :: SymWord a => Maybe (a -> a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBV a -> Maybe (SBV a)+concEval3 :: SymVal a => Maybe (a -> a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBV a -> Maybe (SBV a) concEval3 mbOp mbRm a b c = do op <- mbOp                                v1 <- unliteral a                                v2 <- unliteral b@@ -284,48 +286,48 @@                                  _                           -> Nothing  -- | Add the converted rounding mode if given as an argument-addRM :: State -> Maybe SRoundingMode -> [SW] -> IO [SW]+addRM :: State -> Maybe SRoundingMode -> [SV] -> IO [SV] addRM _  Nothing   as = return as-addRM st (Just rm) as = do swm <- sbvToSW st rm-                           return (swm : as)+addRM st (Just rm) as = do svm <- sbvToSV st rm+                           return (svm : as)  -- | Lift a 1 arg FP-op-lift1 :: SymWord a => FPOp -> Maybe (a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a+lift1 :: SymVal a => FPOp -> Maybe (a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a lift1 w mbOp mbRm a   | Just cv <- concEval1 mbOp mbRm a   = cv   | True   = SBV $ SVal k $ Right $ cache r   where k    = kindOf a-        r st = do swa  <- sbvToSW st a-                  args <- addRM st mbRm [swa]+        r st = do sva  <- sbvToSV st a+                  args <- addRM st mbRm [sva]                   newExpr st k (SBVApp (IEEEFP w) args)  -- | Lift an FP predicate-lift1B :: SymWord a => FPOp -> (a -> Bool) -> SBV a -> SBool+lift1B :: SymVal a => FPOp -> (a -> Bool) -> SBV a -> SBool lift1B w f a    | Just v <- unliteral a = literal $ f v    | True                  = SBV $ SVal KBool $ Right $ cache r-   where r st = do swa <- sbvToSW st a-                   newExpr st KBool (SBVApp (IEEEFP w) [swa])+   where r st = do sva <- sbvToSV st a+                   newExpr st KBool (SBVApp (IEEEFP w) [sva])   -- | Lift a 2 arg FP-op-lift2 :: SymWord a => FPOp -> Maybe (a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBV a+lift2 :: SymVal a => FPOp -> Maybe (a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBV a lift2 w mbOp mbRm a b   | Just cv <- concEval2 mbOp mbRm a b   = cv   | True   = SBV $ SVal k $ Right $ cache r   where k    = kindOf a-        r st = do swa  <- sbvToSW st a-                  swb  <- sbvToSW st b-                  args <- addRM st mbRm [swa, swb]+        r st = do sva  <- sbvToSV st a+                  svb  <- sbvToSV st b+                  args <- addRM st mbRm [sva, svb]                   newExpr st k (SBVApp (IEEEFP w) args)  -- | Lift min/max: Note that we protect against constant folding if args are alternating sign 0's, since -- SMTLib is deliberately nondeterministic in this case-liftMM :: (SymWord a, RealFloat a) => FPOp -> Maybe (a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBV a+liftMM :: (SymVal a, RealFloat a) => FPOp -> Maybe (a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBV a liftMM w mbOp mbRm a b   | Just v1 <- unliteral a   , Just v2 <- unliteral b@@ -337,35 +339,35 @@   where isN0   = isNegativeZero         isP0 x = x == 0 && not (isN0 x)         k    = kindOf a-        r st = do swa  <- sbvToSW st a-                  swb  <- sbvToSW st b-                  args <- addRM st mbRm [swa, swb]+        r st = do sva  <- sbvToSV st a+                  svb  <- sbvToSV st b+                  args <- addRM st mbRm [sva, svb]                   newExpr st k (SBVApp (IEEEFP w) args)  -- | Lift a 2 arg FP-op, producing bool-lift2B :: SymWord a => FPOp -> Maybe (a -> a -> Bool) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBool+lift2B :: SymVal a => FPOp -> Maybe (a -> a -> Bool) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBool lift2B w mbOp mbRm a b   | Just cv <- concEval2B mbOp mbRm a b   = cv   | True   = SBV $ SVal KBool $ Right $ cache r-  where r st = do swa  <- sbvToSW st a-                  swb  <- sbvToSW st b-                  args <- addRM st mbRm [swa, swb]+  where r st = do sva  <- sbvToSV st a+                  svb  <- sbvToSV st b+                  args <- addRM st mbRm [sva, svb]                   newExpr st KBool (SBVApp (IEEEFP w) args)  -- | Lift a 3 arg FP-op-lift3 :: SymWord a => FPOp -> Maybe (a -> a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBV a -> SBV a+lift3 :: SymVal a => FPOp -> Maybe (a -> a -> a -> a) -> Maybe SRoundingMode -> SBV a -> SBV a -> SBV a -> SBV a lift3 w mbOp mbRm a b c   | Just cv <- concEval3 mbOp mbRm a b c   = cv   | True   = SBV $ SVal k $ Right $ cache r   where k    = kindOf a-        r st = do swa  <- sbvToSW st a-                  swb  <- sbvToSW st b-                  swc  <- sbvToSW st c-                  args <- addRM st mbRm [swa, swb, swc]+        r st = do sva  <- sbvToSV st a+                  svb  <- sbvToSV st b+                  svc  <- sbvToSV st c+                  args <- addRM st mbRm [sva, svb, svc]                   newExpr st k (SBVApp (IEEEFP w) args)  -- | Convert an 'SFloat' to an 'SWord32', preserving the bit-correspondence. Note that since the@@ -385,7 +387,7 @@   where w32  = KBounded False 32         y st = do cg <- isCodeGenMode st                   if cg-                     then do f <- sbvToSW st fVal+                     then do f <- sbvToSV st fVal                              newExpr st w32 (SBVApp (IEEEFP (FP_Reinterpret KFloat w32)) [f])                      else do n   <- internalVariable st w32                              ysw <- newExpr st KFloat (SBVApp (IEEEFP (FP_Reinterpret w32 KFloat)) [n])@@ -406,7 +408,7 @@   where w64  = KBounded False 64         y st = do cg <- isCodeGenMode st                   if cg-                     then do f <- sbvToSW st fVal+                     then do f <- sbvToSV st fVal                              newExpr st w64 (SBVApp (IEEEFP (FP_Reinterpret KDouble w64)) [f])                      else do n   <- internalVariable st w64                              ysw <- newExpr st KDouble (SBVApp (IEEEFP (FP_Reinterpret w64 KDouble)) [n])@@ -430,15 +432,15 @@ sWord32AsSFloat fVal   | Just f <- unliteral fVal = literal $ CN.wordToFloat f   | True                     = SBV (SVal KFloat (Right (cache y)))-  where y st = do xsw <- sbvToSW st fVal-                  newExpr st KFloat (SBVApp (IEEEFP (FP_Reinterpret (kindOf fVal) KFloat)) [xsw])+  where y st = do xsv <- sbvToSV st fVal+                  newExpr st KFloat (SBVApp (IEEEFP (FP_Reinterpret (kindOf fVal) KFloat)) [xsv])  -- | Reinterpret the bits in a 32-bit word as a single-precision floating point number sWord64AsSDouble :: SWord64 -> SDouble sWord64AsSDouble dVal   | Just d <- unliteral dVal = literal $ CN.wordToDouble d   | True                     = SBV (SVal KDouble (Right (cache y)))-  where y st = do xsw <- sbvToSW st dVal-                  newExpr st KDouble (SBVApp (IEEEFP (FP_Reinterpret (kindOf dVal) KDouble)) [xsw])+  where y st = do xsv <- sbvToSV st dVal+                  newExpr st KDouble (SBVApp (IEEEFP (FP_Reinterpret (kindOf dVal) KDouble)) [xsv])  {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
Data/SBV/Core/Kind.hs view
@@ -1,20 +1,23 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Core.Kind--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Core.Kind+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Internal data-structures for the sbv library -----------------------------------------------------------------------------  {-# LANGUAGE DefaultSignatures    #-} {-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE LambdaCase           #-} {-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeApplications     #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ViewPatterns         #-} -{-# OPTIONS_GHC -fno-warn-orphans    #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  module Data.SBV.Core.Kind (Kind(..), HasKind(..), constructUKind, smtType) where @@ -24,6 +27,8 @@ import Data.Word import Data.SBV.Core.AlgReals +import Data.Proxy+ import Data.List (isPrefixOf, intercalate)  import Data.Typeable (Typeable)@@ -35,42 +40,46 @@           | KBounded !Bool !Int           | KUnbounded           | KReal-          | KUserSort String (Either String [String])  -- name. Left: uninterpreted. Right: enum constructors.+          | KUninterpreted String (Either String [String])  -- name. Left: uninterpreted. Right: enum constructors.           | KFloat           | KDouble           | KChar           | KString           | KList Kind+          | KTuple [Kind]           deriving (Eq, Ord)  -- | The interesting about the show instance is that it can tell apart two kinds nicely; since it conveniently--- ignores the enumeration constructors. Also, when we construct a 'KUserSort', we make sure we don't use any of+-- ignores the enumeration constructors. Also, when we construct a 'KUninterpreted', we make sure we don't use any of -- the reserved names; see 'constructUKind' for details. instance Show Kind where-  show KBool              = "SBool"-  show (KBounded False n) = "SWord" ++ show n-  show (KBounded True n)  = "SInt"  ++ show n-  show KUnbounded         = "SInteger"-  show KReal              = "SReal"-  show (KUserSort s _)    = s-  show KFloat             = "SFloat"-  show KDouble            = "SDouble"-  show KString            = "SString"-  show KChar              = "SChar"-  show (KList e)          = "[" ++ show e ++ "]"+  show KBool                = "SBool"+  show (KBounded False n)   = "SWord" ++ show n+  show (KBounded True n)    = "SInt"  ++ show n+  show KUnbounded           = "SInteger"+  show KReal                = "SReal"+  show (KUninterpreted s _) = s+  show KFloat               = "SFloat"+  show KDouble              = "SDouble"+  show KString              = "SString"+  show KChar                = "SChar"+  show (KList e)            = "[" ++ show e ++ "]"+  show (KTuple m)           = "(" ++ intercalate ", " (show <$> m) ++ ")"  -- | How the type maps to SMT land smtType :: Kind -> String-smtType KBool           = "Bool"-smtType (KBounded _ sz) = "(_ BitVec " ++ show sz ++ ")"-smtType KUnbounded      = "Int"-smtType KReal           = "Real"-smtType KFloat          = "(_ FloatingPoint  8 24)"-smtType KDouble         = "(_ FloatingPoint 11 53)"-smtType KString         = "String"-smtType KChar           = "(_ BitVec 8)"-smtType (KList k)       = "(Seq " ++ smtType k ++ ")"-smtType (KUserSort s _) = s+smtType KBool                = "Bool"+smtType (KBounded _ sz)      = "(_ BitVec " ++ show sz ++ ")"+smtType KUnbounded           = "Int"+smtType KReal                = "Real"+smtType KFloat               = "(_ FloatingPoint  8 24)"+smtType KDouble              = "(_ FloatingPoint 11 53)"+smtType KString              = "String"+smtType KChar                = "(_ BitVec 8)"+smtType (KList k)            = "(Seq " ++ smtType k ++ ")"+smtType (KUninterpreted s _) = s+smtType (KTuple [])          = "SBVTuple0"+smtType (KTuple kinds)       = "(SBVTuple" ++ show (length kinds) ++ " " ++ unwords (smtType <$> kinds) ++ ")"  instance Eq  G.DataType where    a == b = G.tyconUQname (G.dataTypeName a) == G.tyconUQname (G.dataTypeName b)@@ -80,18 +89,17 @@  -- | Does this kind represent a signed quantity? kindHasSign :: Kind -> Bool-kindHasSign k =-  case k of-    KBool        -> False-    KBounded b _ -> b-    KUnbounded   -> True-    KReal        -> True-    KFloat       -> True-    KDouble      -> True-    KUserSort{}  -> False-    KString      -> False-    KChar        -> False-    KList{}      -> False+kindHasSign = \case KBool            -> False+                    KBounded b _     -> b+                    KUnbounded       -> True+                    KReal            -> True+                    KFloat           -> True+                    KDouble          -> True+                    KUninterpreted{} -> False+                    KString          -> False+                    KChar            -> False+                    KList{}          -> False+                    KTuple{}         -> False  -- | Construct an uninterpreted/enumerated kind from a piece of data; we distinguish simple enumerations as those -- are mapped to proper SMT-Lib2 data-types; while others go completely uninterpreted@@ -100,7 +108,7 @@   | any (`isPrefixOf` sortName) badPrefixes   = error $ "Data.SBV: Cannot construct user-sort with name: " ++ show sortName ++ ": Must not start with any of " ++ intercalate ", " badPrefixes   | True-  = KUserSort sortName mbEnumFields+  = KUninterpreted sortName mbEnumFields   where -- make sure we don't step on ourselves:         badPrefixes   = ["SBool", "SWord", "SInt", "SInteger", "SReal", "SFloat", "SDouble", "SString", "SChar", "["] @@ -138,58 +146,68 @@   isChar          :: a -> Bool   isString        :: a -> Bool   isList          :: a -> Bool+  isTuple         :: a -> Bool   showType        :: a -> String   -- defaults   hasSign x = kindHasSign (kindOf x)    intSizeOf x = case kindOf x of-                  KBool         -> error "SBV.HasKind.intSizeOf((S)Bool)"-                  KBounded _ s  -> s-                  KUnbounded    -> error "SBV.HasKind.intSizeOf((S)Integer)"-                  KReal         -> error "SBV.HasKind.intSizeOf((S)Real)"-                  KFloat        -> error "SBV.HasKind.intSizeOf((S)Float)"-                  KDouble       -> error "SBV.HasKind.intSizeOf((S)Double)"-                  KUserSort s _ -> error $ "SBV.HasKind.intSizeOf: Uninterpreted sort: " ++ s-                  KString       -> error "SBV.HasKind.intSizeOf((S)Double)"-                  KChar         -> error "SBV.HasKind.intSizeOf((S)Char)"-                  KList ek      -> error $ "SBV.HasKind.intSizeOf((S)List)" ++ show ek+                  KBool              -> error "SBV.HasKind.intSizeOf((S)Bool)"+                  KBounded _ s       -> s+                  KUnbounded         -> error "SBV.HasKind.intSizeOf((S)Integer)"+                  KReal              -> error "SBV.HasKind.intSizeOf((S)Real)"+                  KFloat             -> error "SBV.HasKind.intSizeOf((S)Float)"+                  KDouble            -> error "SBV.HasKind.intSizeOf((S)Double)"+                  KUninterpreted s _ -> error $ "SBV.HasKind.intSizeOf: Uninterpreted sort: " ++ s+                  KString            -> error "SBV.HasKind.intSizeOf((S)Double)"+                  KChar              -> error "SBV.HasKind.intSizeOf((S)Char)"+                  KList ek           -> error $ "SBV.HasKind.intSizeOf((S)List)" ++ show ek+                  KTuple tys         -> error $ "SBV.HasKind.intSizeOf((S)Tuple)" ++ show tys -  isBoolean       x | KBool{}      <- kindOf x = True-                    | True                     = False+  isBoolean       (kindOf -> KBool{})          = True+  isBoolean       _                            = False -  isBounded       x | KBounded{}   <- kindOf x = True-                    | True                     = False+  isBounded       (kindOf -> KBounded{})       = True+  isBounded       _                            = False -  isReal          x | KReal{}      <- kindOf x = True-                    | True                     = False+  isReal          (kindOf -> KReal{})          = True+  isReal          _                            = False -  isFloat         x | KFloat{}     <- kindOf x = True-                    | True                     = False+  isFloat         (kindOf -> KFloat{})         = True+  isFloat         _                            = False -  isDouble        x | KDouble{}    <- kindOf x = True-                    | True                     = False+  isDouble        (kindOf -> KDouble{})        = True+  isDouble        _                            = False -  isInteger       x | KUnbounded{} <- kindOf x = True-                    | True                     = False+  isInteger       (kindOf -> KUnbounded{})     = True+  isInteger       _                            = False -  isUninterpreted x | KUserSort{}  <- kindOf x = True-                    | True                     = False+  isUninterpreted (kindOf -> KUninterpreted{}) = True+  isUninterpreted _                            = False -  isString        x | KString{}    <- kindOf x = True-                    | True                     = False+  isChar          (kindOf -> KChar{})          = True+  isChar          _                            = False -  isChar          x | KChar{}      <- kindOf x = True-                    | True                     = False+  isString        (kindOf -> KString{})        = True+  isString        _                            = False -  isList          x | KList{}      <- kindOf x = True-                    | True                     = False+  isList          (kindOf -> KList{})          = True+  isList          _                            = False +  isTuple         (kindOf -> KTuple{})         = True+  isTuple         _                            = False+   showType = show . kindOf    -- default signature for uninterpreted/enumerated kinds   default kindOf :: (Read a, G.Data a) => a -> Kind   kindOf = constructUKind +-- | This instance allows us to use the `kindOf (Proxy @a)` idiom instead of+-- the `kindOf (undefined :: a)`, which is safer and looks more idiomatic.+instance HasKind a => HasKind (Proxy a) where+  kindOf _ = kindOf (undefined :: a)+ instance HasKind Bool    where kindOf _ = KBool instance HasKind Int8    where kindOf _ = KBounded True  8 instance HasKind Word8   where kindOf _ = KBounded False 8@@ -206,8 +224,32 @@ instance HasKind Char    where kindOf _ = KChar  instance (Typeable a, HasKind a) => HasKind [a] where-   kindOf _ | isKString (undefined :: [a]) = KString-            | True                         = KList (kindOf (undefined :: a))+   kindOf x | isKString @[a] x = KString+            | True             = KList (kindOf (Proxy @a))  instance HasKind Kind where   kindOf = id++instance HasKind () where+  kindOf _ = KTuple []++instance (HasKind a, HasKind b) => HasKind (a, b) where+  kindOf _ = KTuple [kindOf (Proxy @a), kindOf (Proxy @b)]++instance (HasKind a, HasKind b, HasKind c) => HasKind (a, b, c) where+  kindOf _ = KTuple [kindOf (Proxy @a), kindOf (Proxy @b), kindOf (Proxy @c)]++instance (HasKind a, HasKind b, HasKind c, HasKind d) => HasKind (a, b, c, d) where+  kindOf _ = KTuple [kindOf (Proxy @a), kindOf (Proxy @b), kindOf (Proxy @c), kindOf (Proxy @d)]++instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e) => HasKind (a, b, c, d, e) where+  kindOf _ = KTuple [kindOf (Proxy @a), kindOf (Proxy @b), kindOf (Proxy @c), kindOf (Proxy @d), kindOf (Proxy @e)]++instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f) => HasKind (a, b, c, d, e, f) where+  kindOf _ = KTuple [kindOf (Proxy @a), kindOf (Proxy @b), kindOf (Proxy @c), kindOf (Proxy @d), kindOf (Proxy @e), kindOf (Proxy @f)]++instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g) => HasKind (a, b, c, d, e, f, g) where+  kindOf _ = KTuple [kindOf (Proxy @a), kindOf (Proxy @b), kindOf (Proxy @c), kindOf (Proxy @d), kindOf (Proxy @e), kindOf (Proxy @f), kindOf (Proxy @g)]++instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g, HasKind h) => HasKind (a, b, c, d, e, f, g, h) where+  kindOf _ = KTuple [kindOf (Proxy @a), kindOf (Proxy @b), kindOf (Proxy @c), kindOf (Proxy @d), kindOf (Proxy @e), kindOf (Proxy @f), kindOf (Proxy @g), kindOf (Proxy @h)]
Data/SBV/Core/Model.hs view
@@ -1,1903 +1,2059 @@ ----------------------------------------------------------------------------- -- |--- 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 DefaultSignatures     #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE FlexibleInstances     #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE PatternGuards         #-}-{-# LANGUAGE ScopedTypeVariables   #-}-{-# LANGUAGE Rank2Types            #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE TypeSynonymInstances  #-}--{-# OPTIONS_GHC -fno-warn-orphans  #-}--module Data.SBV.Core.Model (-    Mergeable(..), EqSymbolic(..), OrdSymbolic(..), SDivisible(..), Uninterpreted(..), Metric(..), assertWithPenalty, SIntegral, SFiniteBits(..)-  , ite, iteLazy, sFromIntegral, sShiftLeft, sShiftRight, sRotateLeft, sRotateRight, sSignedShiftArithRight, (.^)-  , oneIf, genVar, genVar_, forall, forall_, exists, exists_-  , pbAtMost, pbAtLeast, pbExactly, pbLe, pbGe, pbEq, pbMutexed, pbStronglyMutexed-  , sBool, sBools, sWord8, sWord8s, sWord16, sWord16s, sWord32-  , sWord32s, sWord64, sWord64s, sInt8, sInt8s, sInt16, sInt16s, sInt32, sInt32s, sInt64-  , sInt64s, sInteger, sIntegers, sReal, sReals, sFloat, sFloats, sDouble, sDoubles, sChar, sChars, sString, sStrings, sList, sLists-  , slet-  , sRealToSInteger, label, observe-  , sAssert-  , liftQRem, liftDMod, symbolicMergeWithKind-  , genLiteral, genFromCW, genMkSymVar-  , sbvQuickCheck-  )-  where--import Control.Applicative  (ZipList(ZipList))-import Control.Monad        (when, unless, mplus)--import GHC.Generics (U1(..), M1(..), (:*:)(..), K1(..))-import qualified GHC.Generics as G--import GHC.Stack--import Data.Array  (Array, Ix, listArray, elems, bounds, rangeSize)-import Data.Bits   (Bits(..))-import Data.Char   (toLower, isDigit)-import Data.Int    (Int8, Int16, Int32, Int64)-import Data.List   (genericLength, genericIndex, genericTake, unzip4, unzip5, unzip6, unzip7, intercalate, isPrefixOf)-import Data.Maybe  (fromMaybe)-import Data.String (IsString(..))-import Data.Word   (Word8, Word16, Word32, Word64)--import Data.Dynamic (fromDynamic, toDyn)--import Test.QuickCheck                         (Testable(..), Arbitrary(..))-import qualified Test.QuickCheck.Test    as QC (isSuccess)-import qualified Test.QuickCheck         as QC (quickCheckResult, counterexample)-import qualified Test.QuickCheck.Monadic as QC (monadicIO, run, assert, pre, monitor)--import Data.SBV.Core.AlgReals-import Data.SBV.Core.Data-import Data.SBV.Core.Symbolic-import Data.SBV.Core.Operations--import Data.SBV.Provers.Prover (defaultSMTCfg, SafeResult(..))-import Data.SBV.SMT.SMT        (showModel)--import Data.SBV.Utils.Boolean-import Data.SBV.Utils.Lib      (isKString)---- Symbolic-Word class instances---- | Generate a finite symbolic bitvector, named-genVar :: Maybe Quantifier -> Kind -> String -> Symbolic (SBV a)-genVar q k = mkSymSBV q k . Just---- | Generate a finite symbolic bitvector, unnamed-genVar_ :: Maybe Quantifier -> Kind -> Symbolic (SBV a)-genVar_ q k = mkSymSBV q k Nothing---- | Generate a finite constant bitvector-genLiteral :: Integral a => Kind -> a -> SBV b-genLiteral k = SBV . SVal k . Left . mkConstCW k---- | Convert a constant to an integral value-genFromCW :: Integral a => CW -> a-genFromCW (CW _ (CWInteger x)) = fromInteger x-genFromCW c                    = error $ "genFromCW: Unsupported non-integral value: " ++ show c---- | Generically make a symbolic var-genMkSymVar :: Kind -> Maybe Quantifier -> Maybe String -> Symbolic (SBV a)-genMkSymVar k mbq Nothing  = genVar_ mbq k-genMkSymVar k mbq (Just s) = genVar  mbq k s---- | Base type of () allows simple construction for uninterpreted types.-instance SymWord ()-instance HasKind ()--instance SymWord Bool where-  mkSymWord  = genMkSymVar KBool-  literal x  = SBV (svBool x)-  fromCW     = cwToBool--instance SymWord Word8 where-  mkSymWord  = genMkSymVar (KBounded False 8)-  literal    = genLiteral  (KBounded False 8)-  fromCW     = genFromCW--instance SymWord Int8 where-  mkSymWord  = genMkSymVar (KBounded True 8)-  literal    = genLiteral  (KBounded True 8)-  fromCW     = genFromCW--instance SymWord Word16 where-  mkSymWord  = genMkSymVar (KBounded False 16)-  literal    = genLiteral  (KBounded False 16)-  fromCW     = genFromCW--instance SymWord Int16 where-  mkSymWord  = genMkSymVar (KBounded True 16)-  literal    = genLiteral  (KBounded True 16)-  fromCW     = genFromCW--instance SymWord Word32 where-  mkSymWord  = genMkSymVar (KBounded False 32)-  literal    = genLiteral  (KBounded False 32)-  fromCW     = genFromCW--instance SymWord Int32 where-  mkSymWord  = genMkSymVar (KBounded True 32)-  literal    = genLiteral  (KBounded True 32)-  fromCW     = genFromCW--instance SymWord Word64 where-  mkSymWord  = genMkSymVar (KBounded False 64)-  literal    = genLiteral  (KBounded False 64)-  fromCW     = genFromCW--instance SymWord Int64 where-  mkSymWord  = genMkSymVar (KBounded True 64)-  literal    = genLiteral  (KBounded True 64)-  fromCW     = genFromCW--instance SymWord Integer where-  mkSymWord  = genMkSymVar KUnbounded-  literal    = SBV . SVal KUnbounded . Left . mkConstCW KUnbounded-  fromCW     = genFromCW--instance SymWord AlgReal where-  mkSymWord  = genMkSymVar KReal-  literal    = SBV . SVal KReal . Left . CW KReal . CWAlgReal-  fromCW (CW _ (CWAlgReal a)) = a-  fromCW c                    = error $ "SymWord.AlgReal: Unexpected non-real value: " ++ show c-  -- AlgReal needs its own definition of isConcretely-  -- to make sure we avoid using unimplementable Haskell functions-  isConcretely (SBV (SVal KReal (Left (CW KReal (CWAlgReal v))))) p-     | isExactRational v = p v-  isConcretely _ _       = False--instance SymWord Float where-  mkSymWord  = genMkSymVar KFloat-  literal    = SBV . SVal KFloat . Left . CW KFloat . CWFloat-  fromCW (CW _ (CWFloat a)) = a-  fromCW c                  = error $ "SymWord.Float: Unexpected non-float value: " ++ show c-  -- For Float, we conservatively return 'False' for isConcretely. The reason is that-  -- this function is used for optimizations when only one of the argument is concrete,-  -- and in the presence of NaN's it would be incorrect to do any optimization-  isConcretely _ _ = False--instance SymWord Double where-  mkSymWord  = genMkSymVar KDouble-  literal    = SBV . SVal KDouble . Left . CW KDouble . CWDouble-  fromCW (CW _ (CWDouble a)) = a-  fromCW c                   = error $ "SymWord.Double: Unexpected non-double value: " ++ show c-  -- For Double, we conservatively return 'False' for isConcretely. The reason is that-  -- this function is used for optimizations when only one of the argument is concrete,-  -- and in the presence of NaN's it would be incorrect to do any optimization-  isConcretely _ _ = False--instance SymWord Char where-  mkSymWord = genMkSymVar KChar-  literal c = SBV . SVal KChar . Left . CW KChar $ CWChar c-  fromCW (CW _ (CWChar a)) = a-  fromCW c                 = error $ "SymWord.String: Unexpected non-char value: " ++ show c--instance SymWord a => SymWord [a] where-  mkSymWord-    | isKString (undefined :: [a]) = genMkSymVar KString-    | True                         = genMkSymVar (KList (kindOf (undefined :: a)))--  literal as-    | isKString (undefined :: [a]) = case fromDynamic (toDyn as) of-                                       Just s  -> SBV . SVal KString . Left . CW KString . CWString $ s-                                       Nothing -> error "SString: Cannot construct literal string!"-    | True                         = let k = KList (kindOf (undefined :: a))-                                         toCWVal a = case literal a of-                                                       SBV (SVal _ (Left (CW _ cwval))) -> cwval-                                                       _                                -> error "SymWord.Sequence: could not produce a concrete word for value"-                                     in SBV $ SVal k $ Left $ CW k $ CWList $ map toCWVal as--  fromCW (CW _ (CWString a)) = fromMaybe (error "SString: Cannot extract a literal string!")-                                         (fromDynamic (toDyn a))-  fromCW (CW _ (CWList a))   = fromCW . CW (kindOf (undefined :: a)) <$> a-  fromCW c                   = error $ "SymWord.fromCW: Unexpected non-list value: " ++ show c--instance IsString SString where-  fromString = 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.---------------------------------------------------------------------------------------- | Declare an 'SBool'-sBool :: String -> Symbolic SBool-sBool = symbolic---- | Declare a list of 'SBool's-sBools :: [String] -> Symbolic [SBool]-sBools = symbolics---- | Declare an 'SWord8'-sWord8 :: String -> Symbolic SWord8-sWord8 = symbolic---- | Declare a list of 'SWord8's-sWord8s :: [String] -> Symbolic [SWord8]-sWord8s = symbolics---- | Declare an 'SWord16'-sWord16 :: String -> Symbolic SWord16-sWord16 = symbolic---- | Declare a list of 'SWord16's-sWord16s :: [String] -> Symbolic [SWord16]-sWord16s = symbolics---- | Declare an 'SWord32'-sWord32 :: String -> Symbolic SWord32-sWord32 = symbolic---- | Declare a list of 'SWord32's-sWord32s :: [String] -> Symbolic [SWord32]-sWord32s = symbolics---- | Declare an 'SWord64'-sWord64 :: String -> Symbolic SWord64-sWord64 = symbolic---- | Declare a list of 'SWord64's-sWord64s :: [String] -> Symbolic [SWord64]-sWord64s = symbolics---- | Declare an 'SInt8'-sInt8 :: String -> Symbolic SInt8-sInt8 = symbolic---- | Declare a list of 'SInt8's-sInt8s :: [String] -> Symbolic [SInt8]-sInt8s = symbolics---- | Declare an 'SInt16'-sInt16 :: String -> Symbolic SInt16-sInt16 = symbolic---- | Declare a list of 'SInt16's-sInt16s :: [String] -> Symbolic [SInt16]-sInt16s = symbolics---- | Declare an 'SInt32'-sInt32 :: String -> Symbolic SInt32-sInt32 = symbolic---- | Declare a list of 'SInt32's-sInt32s :: [String] -> Symbolic [SInt32]-sInt32s = symbolics---- | Declare an 'SInt64'-sInt64 :: String -> Symbolic SInt64-sInt64 = symbolic---- | Declare a list of 'SInt64's-sInt64s :: [String] -> Symbolic [SInt64]-sInt64s = symbolics---- | Declare an 'SInteger'-sInteger:: String -> Symbolic SInteger-sInteger = symbolic---- | Declare a list of 'SInteger's-sIntegers :: [String] -> Symbolic [SInteger]-sIntegers = symbolics---- | Declare an 'SReal'-sReal:: String -> Symbolic SReal-sReal = symbolic---- | Declare a list of 'SReal's-sReals :: [String] -> Symbolic [SReal]-sReals = symbolics---- | Declare an 'SFloat'-sFloat :: String -> Symbolic SFloat-sFloat = symbolic---- | Declare a list of 'SFloat's-sFloats :: [String] -> Symbolic [SFloat]-sFloats = symbolics---- | Declare an 'SDouble'-sDouble :: String -> Symbolic SDouble-sDouble = symbolic---- | Declare a list of 'SDouble's-sDoubles :: [String] -> Symbolic [SDouble]-sDoubles = symbolics---- | Declare an 'SChar'-sChar :: String -> Symbolic SChar-sChar = symbolic---- | Declare an 'SString'-sString :: String -> Symbolic SString-sString = symbolic---- | Declare a list of 'SChar's-sChars :: [String] -> Symbolic [SChar]-sChars = symbolics---- | Declare a list of 'SString's-sStrings :: [String] -> Symbolic [SString]-sStrings = symbolics---- | Declare an 'SList'-sList :: forall a. SymWord a => String -> Symbolic (SList a)-sList = symbolic---- | Declare a list of 'SList's-sLists :: forall a. SymWord a => [String] -> Symbolic [SList a]-sLists = symbolics---- | 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 x-  | Just i <- unliteral x, isExactRational i-  = literal $ floor (toRational i)-  | True-  = SBV (SVal KUnbounded (Right (cache y)))-  where y st = do xsw <- sbvToSW st x-                  newExpr st KUnbounded (SBVApp (KindCast KReal KUnbounded) [xsw])---- | 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 :: SymWord a => String -> SBV a -> SBV a-label m x-   | Just _ <- unliteral x = x-   | True                  = SBV $ SVal k $ Right $ cache r-  where k    = kindOf x-        r st = do xsw <- sbvToSW st x-                  newExpr st k (SBVApp (Label m) [xsw])---- | Observe the value of an expression.  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.-observe :: SymWord a => String -> SBV a -> SBV a-observe m x-  | null m-  = error "SBV.observe: Bad empty name!"-  | map toLower m `elem` smtLibReservedNames-  = error $ "SBV.observe: The name chosen is reserved, please change it!: " ++ show m-  | "s" `isPrefixOf` m && all isDigit (drop 1 m)-  = error $ "SBV.observe: Names of the form sXXX are internal to SBV, please use a different name: " ++ show m-  | True-  = SBV $ SVal k $ Right $ cache r-  where k = kindOf x-        r st = do xsw <- sbvToSW st x-                  recordObservable st m xsw-                  return xsw---- | Symbolic Equality. Note that we can't use Haskell's 'Eq' class since Haskell insists on returning Bool--- Comparing symbolic values will necessarily return a symbolic value.-infix 4 .==, ./=-class EqSymbolic a where-  -- | Symbolic equality.-  (.==) :: a -> a -> SBool-  -- | Symbolic inequality.-  (./=) :: a -> a -> SBool--  -- | Returns (symbolic) true if all the elements of the given list are different.-  distinct :: [a] -> SBool--  -- | Returns (symbolic) true if all the elements of the given list are the same.-  allEqual :: [a] -> SBool--  -- | Symbolic membership test.-  sElem    :: a -> [a] -> SBool-  {-# MINIMAL (.==) #-}--  x ./= y = bnot (x .== y)--  allEqual []     = true-  allEqual (x:xs) = bAll (x .==) xs--  -- Default implementation of distinct. Note that we override-  -- this method for the base types to generate better code.-  distinct []     = true-  distinct (x:xs) = bAll (x ./=) xs &&& distinct xs--  sElem x xs = bAny (.== x) xs---- | Symbolic Comparisons. Similar to 'Eq', we cannot implement Haskell's 'Ord' class--- since there is no way to return an 'Ordering' value from a symbolic comparison.--- Furthermore, 'OrdSymbolic' requires 'Mergeable' to implement if-then-else, for the--- benefit of implementing symbolic versions of 'max' and 'min' functions.-infix 4 .<, .<=, .>, .>=-class (Mergeable a, EqSymbolic a) => OrdSymbolic a where-  -- | Symbolic less than.-  (.<)  :: a -> a -> SBool-  -- | Symbolic less than or equal to.-  (.<=) :: a -> a -> SBool-  -- | Symbolic greater than.-  (.>)  :: a -> a -> SBool-  -- | Symbolic greater than or equal to.-  (.>=) :: a -> a -> SBool-  -- | Symbolic minimum.-  smin  :: a -> a -> a-  -- | Symbolic maximum.-  smax  :: a -> a -> a-  -- | Is the value withing the allowed /inclusive/ range?-  inRange    :: a -> (a, a) -> SBool--  {-# MINIMAL (.<) #-}--  a .<= b    = a .< b ||| a .== b-  a .>  b    = b .<  a-  a .>= b    = b .<= a--  a `smin` b = ite (a .<= b) a b-  a `smax` b = ite (a .<= b) b a--  inRange x (y, z) = x .>= y &&& x .<= 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 false--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..--}--instance EqSymbolic (SBV a) where-  SBV x .== SBV y = SBV (svEqual x y)-  SBV x ./= SBV y = SBV (svNotEqual x y)--  -- Custom version of distinct that generates better code for base types-  distinct []  = true-  distinct [_] = true-  distinct xs-    | all isConc xs-    = checkDiff xs-    | True-    = SBV (SVal KBool (Right (cache r)))-    where r st = do xsw <- mapM (sbvToSW st) xs-                    newExpr st KBool (SBVApp NotEqual xsw)--          -- 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 []     = true-          checkDiff (a:as) = bAll (a ./=) as &&& checkDiff as--          -- Sigh, we can't use isConcrete since that requires SymWord-          -- constraint that we don't have here. (To support SBools.)-          isConc (SBV (SVal _ (Left _))) = True-          isConc _                       = False--instance SymWord a => OrdSymbolic (SBV a) where-  SBV x .<  SBV y = SBV (svLessThan x y)-  SBV x .<= SBV y = SBV (svLessEq x y)-  SBV x .>  SBV y = SBV (svGreaterThan x y)-  SBV x .>= SBV y = SBV (svGreaterEq x y)---- Bool-instance EqSymbolic Bool where-  x .== y = if x == y then true else false---- Lists-instance EqSymbolic a => EqSymbolic [a] where-  []     .== []     = true-  (x:xs) .== (y:ys) = x .== y &&& xs .== ys-  _      .== _      = false--instance OrdSymbolic a => OrdSymbolic [a] where-  []     .< []     = false-  []     .< _      = true-  _      .< []     = false-  (x:xs) .< (y:ys) = x .< y ||| (x .== y &&& xs .< ys)---- Maybe-instance EqSymbolic a => EqSymbolic (Maybe a) where-  Nothing .== Nothing = true-  Just a  .== Just b  = a .== b-  _       .== _       = false--instance (OrdSymbolic a) => OrdSymbolic (Maybe a) where-  Nothing .<  Nothing = false-  Nothing .<  _       = true-  Just _  .<  Nothing = false-  Just a  .<  Just b  = a .< b---- Either-instance (EqSymbolic a, EqSymbolic b) => EqSymbolic (Either a b) where-  Left a  .== Left b  = a .== b-  Right a .== Right b = a .== b-  _       .== _       = false--instance (OrdSymbolic a, OrdSymbolic b) => OrdSymbolic (Either a b) where-  Left a  .< Left b  = a .< b-  Left _  .< Right _ = true-  Right _ .< Left _  = false-  Right a .< Right b = a .< b---- 2-Tuple-instance (EqSymbolic a, EqSymbolic b) => EqSymbolic (a, b) where-  (a0, b0) .== (a1, b1) = a0 .== a1 &&& b0 .== b1--instance (OrdSymbolic a, OrdSymbolic b) => OrdSymbolic (a, b) where-  (a0, b0) .< (a1, b1) = a0 .< a1 ||| (a0 .== a1 &&& b0 .< b1)---- 3-Tuple-instance (EqSymbolic a, EqSymbolic b, EqSymbolic c) => EqSymbolic (a, b, c) where-  (a0, b0, c0) .== (a1, b1, c1) = (a0, b0) .== (a1, b1) &&& c0 .== c1--instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c) => OrdSymbolic (a, b, c) where-  (a0, b0, c0) .< (a1, b1, c1) = (a0, b0) .< (a1, b1) ||| ((a0, b0) .== (a1, b1) &&& c0 .< c1)---- 4-Tuple-instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d) => EqSymbolic (a, b, c, d) where-  (a0, b0, c0, d0) .== (a1, b1, c1, d1) = (a0, b0, c0) .== (a1, b1, c1) &&& d0 .== d1--instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d) => OrdSymbolic (a, b, c, d) where-  (a0, b0, c0, d0) .< (a1, b1, c1, d1) = (a0, b0, c0) .< (a1, b1, c1) ||| ((a0, b0, c0) .== (a1, b1, c1) &&& d0 .< d1)---- 5-Tuple-instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d, EqSymbolic e) => EqSymbolic (a, b, c, d, e) where-  (a0, b0, c0, d0, e0) .== (a1, b1, c1, d1, e1) = (a0, b0, c0, d0) .== (a1, b1, c1, d1) &&& e0 .== e1--instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e) => OrdSymbolic (a, b, c, d, e) where-  (a0, b0, c0, d0, e0) .< (a1, b1, c1, d1, e1) = (a0, b0, c0, d0) .< (a1, b1, c1, d1) ||| ((a0, b0, c0, d0) .== (a1, b1, c1, d1) &&& e0 .< e1)---- 6-Tuple-instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d, EqSymbolic e, EqSymbolic f) => EqSymbolic (a, b, c, d, e, f) where-  (a0, b0, c0, d0, e0, f0) .== (a1, b1, c1, d1, e1, f1) = (a0, b0, c0, d0, e0) .== (a1, b1, c1, d1, e1) &&& f0 .== f1--instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e, OrdSymbolic f) => OrdSymbolic (a, b, c, d, e, f) where-  (a0, b0, c0, d0, e0, f0) .< (a1, b1, c1, d1, e1, f1) =    (a0, b0, c0, d0, e0) .<  (a1, b1, c1, d1, e1)-                                                       ||| ((a0, b0, c0, d0, e0) .== (a1, b1, c1, d1, e1) &&& f0 .< 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-  (a0, b0, c0, d0, e0, f0, g0) .== (a1, b1, c1, d1, e1, f1, g1) = (a0, b0, c0, d0, e0, f0) .== (a1, b1, c1, d1, e1, f1) &&& g0 .== 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-  (a0, b0, c0, d0, e0, f0, g0) .< (a1, b1, c1, d1, e1, f1, g1) =    (a0, b0, c0, d0, e0, f0) .<  (a1, b1, c1, d1, e1, f1)-                                                               ||| ((a0, b0, c0, d0, e0, f0) .== (a1, b1, c1, d1, e1, f1) &&& g0 .< g1)---- | 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 (SymWord a, Num a, Bits a, Integral a) => SIntegral a---- 'SIntegral' Instances, skips Real/Float/Bool-instance SIntegral Word8-instance SIntegral Word16-instance SIntegral Word32-instance SIntegral Word64-instance SIntegral Int8-instance SIntegral Int16-instance SIntegral Int32-instance SIntegral Int64-instance SIntegral Integer---- | Finite bit-length symbolic values. Essentially the same as 'SIntegral', but further leaves out 'Integer'. Loosely--- based on Haskell's @FiniteBits@ class, but with more methods defined and structured differently to fit into the--- symbolic world view. Minimal complete definition: 'sFiniteBitSize'.-class (SymWord a, Num a, Bits a) => SFiniteBits a where-    -- | Bit size.-    sFiniteBitSize      :: SBV a -> Int-    -- | Least significant bit of a word, always stored at index 0.-    lsb                 :: SBV a -> SBool-    -- | Most significant bit of a word, always stored at the last position.-    msb                 :: SBV a -> SBool-    -- | Big-endian blasting of a word into its bits.-    blastBE             :: SBV a -> [SBool]-    -- | Little-endian blasting of a word into its bits.-    blastLE             :: SBV a -> [SBool]-    -- | Reconstruct from given bits, given in little-endian.-    fromBitsBE          :: [SBool] -> SBV a-    -- | Reconstruct from given bits, given in little-endian.-    fromBitsLE          :: [SBool] -> SBV a-    -- | Replacement for 'testBit', returning 'SBool' instead of 'Bool'.-    sTestBit            :: SBV a -> Int -> SBool-    -- | Variant of 'sTestBit', where we want to extract multiple bit positions.-    sExtractBits        :: SBV a -> [Int] -> [SBool]-    -- | Variant of 'popCount', returning a symbolic value.-    sPopCount           :: SBV a -> SWord8-    -- | A combo of 'setBit' and 'clearBit', when the bit to be set is symbolic.-    setBitTo            :: SBV a -> Int -> SBool -> SBV a-    -- | Full adder, returns carry-out from the addition. Only for unsigned quantities.-    fullAdder           :: SBV a -> SBV a -> (SBool, SBV a)-    -- | Full multipler, 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--    -- Default implementations-    lsb (SBV v) = SBV (svTestBit v 0)-    msb x       = sTestBit x (sFiniteBitSize x - 1)--    blastBE   = reverse . blastLE-    blastLE x = map (sTestBit x) [0 .. intSizeOf x - 1]--    fromBitsBE = fromBitsLE . reverse-    fromBitsLE bs-       | length bs /= w-       = error $ "SBV.SFiniteBits.fromBitsLE/BE: Expected: " ++ show w ++ " bits, received: " ++ show (length bs)-       | True-       = result-       where w = sFiniteBitSize result-             result = go 0 0 bs--             go !acc _  []     = acc-             go !acc !i (x:xs) = go (ite x (setBit acc i) acc) (i+1) xs--    sTestBit (SBV x) i = SBV (svTestBit x i)-    sExtractBits x     = map (sTestBit 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 x-      | isConcrete x  = go 0 x-      | True          = sum [ite b 1 0 | b <- blastLE x]-      where -- concrete case-            go !c 0 = c-            go !c w = go (c+1) (w .&. (w-1))--    setBitTo x i b = ite b (setBit x i) (clearBit x i)--    fullAdder a b-      | isSigned a = error "fullAdder: only works on unsigned numbers"-      | True       = (a .> s ||| b .> s, s)-      where s = 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 a b-      | isSigned a = error "fullMultiplier: only works on unsigned numbers"-      | True       = (go (sFiniteBitSize a) 0 a, a*b)-      where go 0 p _ = p-            go n p x = let (c, p')  = ite (lsb x) (fullAdder p b) (false, p)-                           (o, p'') = shiftIn c p'-                           (_, x')  = shiftIn o x-                       in go (n-1) p'' x'-            shiftIn k v = (lsb v, mask .|. (v `shiftR` 1))-               where mask = ite k (bit (sFiniteBitSize v - 1)) 0--    -- See the note for 'sPopCount' for a comment on why we return 'SWord8'-    sCountLeadingZeros x = fromIntegral m - go m-      where m = sFiniteBitSize x - 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 i | i < 0 = i8-                 | True  = ite (sTestBit x i) i8 (go (i-1))-               where i8 = literal (fromIntegral i :: Word8)--    -- See the note for 'sPopCount' for a comment on why we return 'SWord8'-    sCountTrailingZeros x = go 0-       where m = sFiniteBitSize x--             go :: Int -> SWord8-             go i | i >= m = i8-                  | True   = ite (sTestBit x i) i8 (go (i+1))-                where i8 = literal (fromIntegral i :: Word8)---- 'SIntegral' Instances, skips Real/Float/Bool/Integer-instance SFiniteBits Word8  where sFiniteBitSize _ =  8-instance SFiniteBits Word16 where sFiniteBitSize _ = 16-instance SFiniteBits Word32 where sFiniteBitSize _ = 32-instance SFiniteBits Word64 where sFiniteBitSize _ = 64-instance SFiniteBits Int8   where sFiniteBitSize _ =  8-instance SFiniteBits Int16  where sFiniteBitSize _ = 16-instance SFiniteBits Int32  where sFiniteBitSize _ = 32-instance SFiniteBits Int64  where sFiniteBitSize _ = 64---- | Returns 1 if the boolean is true, otherwise 0.-oneIf :: (Num a, SymWord a) => SBool -> SBV a-oneIf t = ite t 1 0---- | Lift a pseudo-boolean op, performing checks-liftPB :: String -> PBOp -> [SBool] -> SBool-liftPB w o xs-  | Just e <- check o-  = error $ "SBV." ++ w ++ ": " ++ e-  | True-  = result-  where check (PB_AtMost  k) = pos k-        check (PB_AtLeast k) = pos k-        check (PB_Exactly k) = pos k-        check (PB_Le cs   k) = pos k `mplus` match cs-        check (PB_Ge cs   k) = pos k `mplus` match cs-        check (PB_Eq cs   k) = pos k `mplus` match cs--        pos k-          | k < 0 = Just $ "comparison value must be positive, received: " ++ show k-          | True  = Nothing--        match cs-          | any (< 0) cs = Just $ "coefficients must be non-negative. Received: " ++ show cs-          | lxs /= lcs   = Just $ "coefficient length must match number of arguments. Received: " ++ show (lcs, lxs)-          | True         = Nothing-          where lxs = length xs-                lcs = length cs--        result = SBV (SVal KBool (Right (cache r)))-        r st   = do xsw <- mapM (sbvToSW st) xs-                    -- PseudoBoolean's implicitly require support for integers, so make sure to register that kind!-                    registerKind st KUnbounded-                    newExpr st KBool (SBVApp (PseudoBoolean o) xsw)---- | 'true' if at most @k@ of the input arguments are 'true'-pbAtMost :: [SBool] -> Int -> SBool-pbAtMost xs k- | k < 0             = error $ "SBV.pbAtMost: Non-negative value required, received: " ++ show k- | all isConcrete xs = literal $ sum (map (pbToInteger "pbAtMost" 1) xs) <= fromIntegral k- | True              = liftPB "pbAtMost" (PB_AtMost k) xs---- | 'true' if at least @k@ of the input arguments are 'true'-pbAtLeast :: [SBool] -> Int -> SBool-pbAtLeast xs k- | k < 0             = error $ "SBV.pbAtLeast: Non-negative value required, received: " ++ show k- | all isConcrete xs = literal $ sum (map (pbToInteger "pbAtLeast" 1) xs) >= fromIntegral k- | True              = liftPB "pbAtLeast" (PB_AtLeast k) xs---- | 'true' if exactly @k@ of the input arguments are 'true'-pbExactly :: [SBool] -> Int -> SBool-pbExactly xs k- | k < 0             = error $ "SBV.pbExactly: Non-negative value required, received: " ++ show k- | all isConcrete xs = literal $ sum (map (pbToInteger "pbExactly" 1) xs) == fromIntegral k- | True              = liftPB "pbExactly" (PB_Exactly k) xs---- | 'true' if the sum of coefficients for 'true' elements is at most @k@. Generalizes 'pbAtMost'.-pbLe :: [(Int, SBool)] -> Int -> SBool-pbLe xs k- | k < 0                       = error $ "SBV.pbLe: Non-negative value required, received: " ++ show k- | all isConcrete (map snd xs) = literal $ sum [pbToInteger "pbLe" c b | (c, b) <- xs] <= fromIntegral k- | True                        = liftPB "pbLe" (PB_Le (map fst xs) k) (map snd xs)---- | 'true' if the sum of coefficients for 'true' elements is at least @k@. Generalizes 'pbAtLeast'.-pbGe :: [(Int, SBool)] -> Int -> SBool-pbGe xs k- | k < 0                       = error $ "SBV.pbGe: Non-negative value required, received: " ++ show k- | all isConcrete (map snd xs) = literal $ sum [pbToInteger "pbGe" c b | (c, b) <- xs] >= fromIntegral k- | True                        = liftPB "pbGe" (PB_Ge (map fst xs) k) (map snd xs)---- | 'true' if the sum of coefficients for 'true' elements is exactly least @k@. Useful for coding--- /exactly K-of-N/ constraints, and in particular mutex constraints.-pbEq :: [(Int, SBool)] -> Int -> SBool-pbEq xs k- | k < 0                       = error $ "SBV.pbEq: Non-negative value required, received: " ++ show k- | all isConcrete (map snd xs) = literal $ sum [pbToInteger "pbEq" c b | (c, b) <- xs] == fromIntegral k- | True                        = liftPB "pbEq" (PB_Eq (map fst xs) k) (map snd xs)---- | 'true' if there is at most one set bit-pbMutexed :: [SBool] -> SBool-pbMutexed xs = pbAtMost xs 1---- | 'true' if there is exactly one set bit-pbStronglyMutexed :: [SBool] -> SBool-pbStronglyMutexed xs = pbExactly xs 1---- | Convert a concrete pseudo-boolean to given int; converting to integer-pbToInteger :: String -> Int -> SBool -> Integer-pbToInteger w c b- | c < 0                 = error $ "SBV." ++ w ++ ": Non-negative coefficient required, received: " ++ show c- | Just v <- unliteral b = if v then fromIntegral c else 0- | True                  = error $ "SBV.pbToInteger: Received a symbolic boolean: " ++ show (c, b)---- | Predicate for optimizing word operations like (+) and (*).-isConcreteZero :: SBV a -> Bool-isConcreteZero (SBV (SVal _     (Left (CW _     (CWInteger n))))) = n == 0-isConcreteZero (SBV (SVal KReal (Left (CW KReal (CWAlgReal v))))) = isExactRational v && v == 0-isConcreteZero _                                                  = False---- | Predicate for optimizing word operations like (+) and (*).-isConcreteOne :: SBV a -> Bool-isConcreteOne (SBV (SVal _     (Left (CW _     (CWInteger 1))))) = True-isConcreteOne (SBV (SVal KReal (Left (CW KReal (CWAlgReal v))))) = isExactRational v && v == 1-isConcreteOne _                                                  = False---- Num instance for symbolic words.-instance (Ord a, Num a, SymWord a) => Num (SBV a) where-  fromInteger = literal . fromIntegral-  SBV x + SBV y = SBV (svPlus x y)-  SBV x * SBV y = SBV (svTimes x y)-  SBV x - SBV y = SBV (svMinus x y)-  -- Abs is problematic for floating point, due to -0; case, so we carefully shuttle it down-  -- to the solver to avoid the can of worms. (Alternative would be to do an if-then-else here.)-  abs (SBV x) = SBV (svAbs x)-  signum a-    -- NB. The following "carefully" tests the number for == 0, as Float/Double's NaN and +/-0-    -- cases would cause trouble with explicit equality tests.-    | hasSign a = ite (a .> z) i-                $ ite (a .< z) (negate i) a-    | True      = ite (a .> z) i a-    where z = genLiteral (kindOf a) (0::Integer)-          i = genLiteral (kindOf a) (1::Integer)-  -- negate is tricky because on double/float -0 is different than 0; so we cannot-  -- just rely on the default definition; which would be 0-0, which is not -0!-  negate (SBV x) = SBV (svUNeg x)---- | Symbolic exponentiation using bit blasting and repeated squaring.------ N.B. The exponent must be unsigned/bounded if symbolic. Signed exponents will be rejected.-(.^) :: (Mergeable b, Num b, SIntegral e) => b -> SBV e -> b-b .^ e-  | isConcrete e, Just (x :: Integer) <- unliteral (sFromIntegral e)-  = if x >= 0 then let go n v-                        | n == 0 = 1-                        | even n =     go (n `div` 2) (v * v)-                        | True   = v * go (n `div` 2) (v * v)-                   in  go x b-              else error $ "(.^): exponentiation: negative exponent: " ++ show x-  | not (isBounded e) || isSigned e-  = error $ "(.^): exponentiation only works with unsigned bounded symbolic exponents, kind: " ++ show (kindOf e)-  | 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 expt = e-         expBit i = SBV (svTestBit expt i)-         blasted  = map expBit [0 .. intSizeOf e - 1]-     in product $ zipWith (\use n -> ite use n 1)-                          blasted-                          (iterate (\x -> x*x) b)--instance (SymWord a, Fractional a) => Fractional (SBV a) where-  fromRational  = literal . fromRational-  SBV x / sy@(SBV y) | div0 = ite (sy .== 0) 0 res-                     | True = res-       where res  = SBV (svDivide x y)-             -- Identify those kinds where we have a div-0 equals 0 exception-             div0 = case kindOf sy of-                      KFloat        -> False-                      KDouble       -> False-                      KReal         -> True-                      -- Following two cases should not happen since these types should *not* be instances of Fractional-                      k@KBounded{}  -> error $ "Unexpected Fractional case for: " ++ show k-                      k@KUnbounded  -> error $ "Unexpected Fractional case for: " ++ show k-                      k@KBool       -> error $ "Unexpected Fractional case for: " ++ show k-                      k@KString     -> error $ "Unexpected Fractional case for: " ++ show k-                      k@KChar       -> error $ "Unexpected Fractional case for: " ++ show k-                      k@KList{}     -> error $ "Unexpected Fractional case for: " ++ show k-                      k@KUserSort{} -> error $ "Unexpected Fractional case for: " ++ show k---- | Define Floating instance on SBV's; only for base types that are already floating; i.e., SFloat and SDouble--- Note that most of the fields are "undefined" for symbolic values, we add methods as they are supported by SMTLib.--- Currently, the only symbolicly available function in this class is sqrt.-instance (SymWord a, Fractional a, Floating a) => Floating (SBV a) where-    pi      = literal pi-    exp     = lift1FNS "exp"     exp-    log     = lift1FNS "log"     log-    sqrt    = lift1F   FP_Sqrt   sqrt-    sin     = lift1FNS "sin"     sin-    cos     = lift1FNS "cos"     cos-    tan     = lift1FNS "tan"     tan-    asin    = lift1FNS "asin"    asin-    acos    = lift1FNS "acos"    acos-    atan    = lift1FNS "atan"    atan-    sinh    = lift1FNS "sinh"    sinh-    cosh    = lift1FNS "cosh"    cosh-    tanh    = lift1FNS "tanh"    tanh-    asinh   = lift1FNS "asinh"   asinh-    acosh   = lift1FNS "acosh"   acosh-    atanh   = lift1FNS "atanh"   atanh-    (**)    = lift2FNS "**"      (**)-    logBase = lift2FNS "logBase" logBase---- | Lift a 1 arg FP-op, using sRNE default-lift1F :: SymWord a => FPOp -> (a -> a) -> SBV a -> SBV a-lift1F w op a-  | Just v <- unliteral a-  = literal $ op v-  | True-  = SBV $ SVal k $ Right $ cache r-  where k    = kindOf a-        r st = do swa  <- sbvToSW st a-                  swm  <- sbvToSW st sRNE-                  newExpr st k (SBVApp (IEEEFP w) [swm, swa])---- | Lift a float/double unary function, only over constants-lift1FNS :: (SymWord a, Floating a) => String -> (a -> a) -> SBV a -> SBV a-lift1FNS nm f sv-  | Just v <- unliteral sv = literal $ f v-  | True                   = error $ "SBV." ++ nm ++ ": not supported for symbolic values of type " ++ show (kindOf sv)---- | Lift a float/double binary function, only over constants-lift2FNS :: (SymWord a, Floating a) => String -> (a -> a -> a) -> SBV a -> SBV a -> SBV a-lift2FNS nm f sv1 sv2-  | Just v1 <- unliteral sv1-  , Just v2 <- unliteral sv2 = literal $ f v1 v2-  | True                     = error $ "SBV." ++ nm ++ ": not supported for symbolic values of type " ++ show (kindOf sv1)---- 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 (Num a, Bits a, SymWord a) => Bits (SBV a) where-  SBV x .&. SBV y    = SBV (svAnd x y)-  SBV x .|. SBV y    = SBV (svOr x y)-  SBV x `xor` SBV y  = SBV (svXOr x y)-  complement (SBV x) = SBV (svNot x)-  bitSize  x         = intSizeOf x-  bitSizeMaybe x     = Just $ intSizeOf x-  isSigned x         = hasSign x-  bit i              = 1 `shiftL` i-  setBit        x i  = x .|. genLiteral (kindOf x) (bit i :: Integer)-  clearBit      x i  = x .&. genLiteral (kindOf x) (complement (bit i) :: Integer)-  complementBit x i  = x `xor` genLiteral (kindOf x) (bit i :: Integer)-  shiftL  (SBV x) i  = SBV (svShl x i)-  shiftR  (SBV x) i  = SBV (svShr x i)-  rotateL (SBV x) i  = SBV (svRol x i)-  rotateR (SBV x) i  = SBV (svRor x i)-  -- NB. testBit is *not* implementable on non-concrete symbolic words-  x `testBit` i-    | SBV (SVal _ (Left (CW _ (CWInteger n)))) <- x-    = testBit n i-    | True-    = error $ "SBV.testBit: Called on symbolic value: " ++ show x ++ ". Use sTestBit instead."-  -- NB. popCount is *not* implementable on non-concrete symbolic words-  popCount x-    | SBV (SVal _ (Left (CW (KBounded _ w) (CWInteger n)))) <- x-    = popCount (n .&. (bit w - 1))-    | True-    = error $ "SBV.popCount: Called on symbolic value: " ++ show x ++ ". Use sPopCount instead."---- | Conversion between integral-symbolic values, akin to Haskell's `fromIntegral`-sFromIntegral :: forall a b. (Integral a, HasKind a, Num a, SymWord a, HasKind b, Num b, SymWord b) => SBV a -> SBV b-sFromIntegral x-  | isReal x-  = error "SBV.sFromIntegral: Called on a real value" -- can't really happen due to types, but being overcautious-  | Just v <- unliteral x-  = literal (fromIntegral v)-  | True-  = result-  where result = SBV (SVal kTo (Right (cache y)))-        kFrom  = kindOf x-        kTo    = kindOf (undefined :: b)-        y st   = do xsw <- sbvToSW st x-                    newExpr st kTo (SBVApp (KindCast kFrom kTo) [xsw])---- | 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 f (SBV a) (SBV b) = SBV $ f a 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 = liftViaSVal 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 = liftViaSVal 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 x i-  | isSigned i = error "sSignedShiftArithRight: shift amount should be unsigned"-  | isSigned x = ssa x i-  | True       = ite (msb x)-                     (complement (ssa (complement x) i))-                     (ssa x i)-  where ssa = liftViaSVal 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, SDivisible (SBV b)) => SBV a -> SBV b -> SBV a-sRotateLeft = liftViaSVal svRotateLeft---- | 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, SDivisible (SBV b)) => SBV a -> SBV b -> SBV a-sRotateRight = liftViaSVal svRotateRight---- Enum instance. These instances are suitable for use with concrete values,--- and will be less useful for symbolic values around. Note that `fromEnum` requires--- a concrete argument for obvious reasons. Other variants (succ, pred, [x..]) etc are similarly--- limited. While symbolic variants can be defined for many of these, they will just diverge--- as final sizes cannot be determined statically.-instance (Show a, Bounded a, Integral a, Num a, SymWord a) => Enum (SBV a) where-  succ x-    | v == (maxBound :: a) = error $ "Enum.succ{" ++ showType x ++ "}: tried to take `succ' of maxBound"-    | True                 = fromIntegral $ v + 1-    where v = enumCvt "succ" x-  pred x-    | v == (minBound :: a) = error $ "Enum.pred{" ++ showType x ++ "}: tried to take `pred' of minBound"-    | True                 = fromIntegral $ v - 1-    where v = enumCvt "pred" x-  toEnum x-    | xi < fromIntegral (minBound :: a) || xi > fromIntegral (maxBound :: a)-    = error $ "Enum.toEnum{" ++ showType r ++ "}: " ++ show x ++ " is out-of-bounds " ++ show (minBound :: a, maxBound :: a)-    | True-    = r-    where xi :: Integer-          xi = fromIntegral x-          r  :: SBV a-          r  = fromIntegral x-  fromEnum x-     | r < fromIntegral (minBound :: Int) || r > fromIntegral (maxBound :: Int)-     = error $ "Enum.fromEnum{" ++ showType x ++ "}:  value " ++ show r ++ " is outside of Int's bounds " ++ show (minBound :: Int, maxBound :: Int)-     | True-     = fromIntegral r-    where r :: Integer-          r = enumCvt "fromEnum" x-  enumFrom x = map fromIntegral [xi .. fromIntegral (maxBound :: a)]-     where xi :: Integer-           xi = enumCvt "enumFrom" x-  enumFromThen x y-     | yi >= xi  = map fromIntegral [xi, yi .. fromIntegral (maxBound :: a)]-     | True      = map fromIntegral [xi, yi .. fromIntegral (minBound :: a)]-       where xi, yi :: Integer-             xi = enumCvt "enumFromThen.x" x-             yi = enumCvt "enumFromThen.y" y-  enumFromThenTo x y z = map fromIntegral [xi, yi .. zi]-       where xi, yi, zi :: Integer-             xi = enumCvt "enumFromThenTo.x" x-             yi = enumCvt "enumFromThenTo.y" y-             zi = enumCvt "enumFromThenTo.z" z---- | Helper function for use in enum operations-enumCvt :: (SymWord a, Integral a, Num b) => String -> SBV a -> b-enumCvt w x = case unliteral x of-                Nothing -> error $ "Enum." ++ w ++ "{" ++ showType x ++ "}: Called on symbolic value " ++ show x-                Just v  -> fromIntegral v---- | The 'SDivisible' class captures the essence of division.--- Unfortunately we cannot use Haskell's 'Integral' class since the 'Real'--- and 'Enum' superclasses are not implementable for symbolic bit-vectors.--- However, 'quotRem' and 'divMod' both make perfect sense, and the 'SDivisible' class captures--- this operation. One issue is how division by 0 behaves. The verification--- technology requires total functions, and there are several design choices--- here. We follow Isabelle/HOL approach of assigning the value 0 for division--- by 0. Therefore, we impose the following pair of laws:------ @---      x `sQuotRem` 0 = (0, x)---      x `sDivMod`  0 = (0, x)--- @------ Note that our instances implement this law even when @x@ is @0@ itself.------ NB. 'quot' truncates toward zero, while 'div' truncates toward negative infinity.------ Minimal complete definition: 'sQuotRem', 'sDivMod'-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--  x `sQuot` y = fst $ x `sQuotRem` y-  x `sRem`  y = snd $ x `sQuotRem` y-  x `sDiv`  y = fst $ x `sDivMod`  y-  x `sMod`  y = snd $ x `sDivMod`  y--instance SDivisible Word64 where-  sQuotRem x 0 = (0, x)-  sQuotRem x y = x `quotRem` y-  sDivMod  x 0 = (0, x)-  sDivMod  x y = x `divMod` y--instance SDivisible Int64 where-  sQuotRem x 0 = (0, x)-  sQuotRem x y = x `quotRem` y-  sDivMod  x 0 = (0, x)-  sDivMod  x y = x `divMod` y--instance SDivisible Word32 where-  sQuotRem x 0 = (0, x)-  sQuotRem x y = x `quotRem` y-  sDivMod  x 0 = (0, x)-  sDivMod  x y = x `divMod` y--instance SDivisible Int32 where-  sQuotRem x 0 = (0, x)-  sQuotRem x y = x `quotRem` y-  sDivMod  x 0 = (0, x)-  sDivMod  x y = x `divMod` y--instance SDivisible Word16 where-  sQuotRem x 0 = (0, x)-  sQuotRem x y = x `quotRem` y-  sDivMod  x 0 = (0, x)-  sDivMod  x y = x `divMod` y--instance SDivisible Int16 where-  sQuotRem x 0 = (0, x)-  sQuotRem x y = x `quotRem` y-  sDivMod  x 0 = (0, x)-  sDivMod  x y = x `divMod` y--instance SDivisible Word8 where-  sQuotRem x 0 = (0, x)-  sQuotRem x y = x `quotRem` y-  sDivMod  x 0 = (0, x)-  sDivMod  x y = x `divMod` y--instance SDivisible Int8 where-  sQuotRem x 0 = (0, x)-  sQuotRem x y = x `quotRem` y-  sDivMod  x 0 = (0, x)-  sDivMod  x y = x `divMod` y--instance SDivisible Integer where-  sQuotRem x 0 = (0, x)-  sQuotRem x y = x `quotRem` y-  sDivMod  x 0 = (0, x)-  sDivMod  x y = x `divMod` y--instance SDivisible CW where-  sQuotRem a b-    | CWInteger x <- cwVal a, CWInteger y <- cwVal b-    = let (r1, r2) = sQuotRem x y in (normCW a{ cwVal = CWInteger r1 }, normCW b{ cwVal = CWInteger r2 })-  sQuotRem a b = error $ "SBV.sQuotRem: impossible, unexpected args received: " ++ show (a, b)-  sDivMod a b-    | CWInteger x <- cwVal a, CWInteger y <- cwVal b-    = let (r1, r2) = sDivMod x y in (normCW a { cwVal = CWInteger r1 }, normCW b { cwVal = CWInteger r2 })-  sDivMod a b = error $ "SBV.sDivMod: impossible, unexpected args received: " ++ show (a, b)--instance SDivisible SWord64 where-  sQuotRem = liftQRem-  sDivMod  = liftDMod--instance SDivisible SInt64 where-  sQuotRem = liftQRem-  sDivMod  = liftDMod--instance SDivisible SWord32 where-  sQuotRem = liftQRem-  sDivMod  = liftDMod--instance SDivisible SInt32 where-  sQuotRem = liftQRem-  sDivMod  = liftDMod--instance SDivisible SWord16 where-  sQuotRem = liftQRem-  sDivMod  = liftDMod--instance SDivisible SInt16 where-  sQuotRem = liftQRem-  sDivMod  = liftDMod--instance SDivisible SWord8 where-  sQuotRem = liftQRem-  sDivMod  = liftDMod--instance SDivisible SInt8 where-  sQuotRem = liftQRem-  sDivMod  = liftDMod---- | Lift 'quotRem' to symbolic words. Division by 0 is defined s.t. @x/0 = 0@; which--- holds even when @x@ is @0@ itself.-liftQRem :: SymWord a => SBV a -> SBV a -> (SBV a, SBV a)-liftQRem x y-  | isConcreteZero x-  = (x, x)-  | isConcreteOne y-  = (x, 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)---------------------------------}-  | True-  = ite (y .== z) (z, x) (qr x y)-  where qr (SBV (SVal sgnsz (Left a))) (SBV (SVal _ (Left b))) = let (q, r) = sQuotRem a b in (SBV (SVal sgnsz (Left q)), SBV (SVal sgnsz (Left r)))-        qr a@(SBV (SVal sgnsz _))      b                       = (SBV (SVal sgnsz (Right (cache (mk Quot)))), SBV (SVal sgnsz (Right (cache (mk Rem)))))-                where mk o st = do sw1 <- sbvToSW st a-                                   sw2 <- sbvToSW st b-                                   mkSymOp o st sgnsz sw1 sw2-        z = genLiteral (kindOf x) (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 :: (SymWord a, Num a, SDivisible (SBV a)) => SBV a -> SBV a -> (SBV a, SBV a)-liftDMod x y-  | isConcreteZero x-  = (x, x)-  | isConcreteOne y-  = (x, 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)---------------------------------}-  | True-  = ite (y .== z) (z, x) $ ite (signum r .== negate (signum y)) (q-i, r+y) qr- where qr@(q, r) = x `sQuotRem` y-       z = genLiteral (kindOf x) (0::Integer)-       i = genLiteral (kindOf x) (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 = liftDMod-  sQuotRem x y-    | not (isSymbolic x || isSymbolic y)-    = liftQRem x y-    | True-    = ite (y .== 0) (0, x) (qE+i, rE-i*y)-    where (qE, rE) = liftQRem x y   -- for integers, this is euclidean due to SMTLib semantics-          i = ite (x .>= 0 ||| rE .== 0) 0-            $ ite (y .>  0)              1 (-1)---- Quickcheck interface-instance (SymWord a, Arbitrary a) => Arbitrary (SBV a) where-  arbitrary = literal `fmap` 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 :: (SymWord b, Num b) => [a] -> a -> SBV b -> a-   -- NB. Earlier implementation of select used the binary-search trick-   -- on the index to chop down the search space. While that is a good trick-   -- in general, it doesn't work for SBV since we do not have any notion of-   -- "concrete" subwords: If an index is symbolic, then all its bits are-   -- symbolic as well. So, the binary search only pays off only if the indexed-   -- list is really humongous, which is not very common in general. (Also,-   -- for the case when the list is bit-vectors, we use SMT tables anyhow.)-   select xs err ind-    | isReal   ind = bad "real"-    | isFloat  ind = bad "float"-    | isDouble ind = bad "double"-    | hasSign  ind = ite (ind .< 0) err (walk xs ind err)-    | True         =                     walk xs ind err-    where bad w = error $ "SBV.select: unsupported " ++ w ++ " valued select/index expression"-          walk []     _ acc = acc-          walk (e:es) i acc = walk es (i-1) (ite (i .== 0) e 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 = 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 t a b-  | Just r <- unliteral t = if r then a else b-  | True                  = symbolicMerge True t 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 t a b-  | Just r <- unliteral t = if r then a else b-  | True                  = symbolicMerge False t a b---- | Symbolic assert. Check that the given boolean condition is always true in the given path. The--- optional first argument can be used to provide call-stack info via GHC's location facilities.-sAssert :: Maybe CallStack -> String -> SBool -> SBV a -> SBV a-sAssert cs msg cond x-   | Just mustHold <- unliteral cond-   = if mustHold-     then x-     else error $ show $ SafeResult ((locInfo . getCallStack) `fmap` cs, msg, Satisfiable defaultSMTCfg (SMTModel [] []))-   | True-   = SBV $ SVal k $ Right $ cache r-  where k     = kindOf x-        r st  = do xsw <- sbvToSW st x-                   let pc = getPathCondition 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 = pc &&& bnot cond-                   cnd <- sbvToSW st mustNeverHappen-                   addAssertion st cs msg cnd-                   return xsw--        locInfo ps = intercalate ",\n " (map loc ps)-          where loc (f, sl) = concat [srcLocFile sl, ":", show (srcLocStartLine sl), ":", show (srcLocStartCol sl), ":", 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 k force (SBV t) (SBV a) (SBV b) = SBV (svSymbolicMerge k force t a b)--instance SymWord a => Mergeable (SBV a) where-    symbolicMerge force t x y-    -- Carefully use the kindOf instance to avoid strictness issues.-       | force = symbolicMergeWithKind (kindOf x)                True  t x y-       | True  = symbolicMergeWithKind (kindOf (undefined :: a)) False t x y-    -- Custom version of select that translates to SMT-Lib tables at the base type of words-    select xs err ind-      | SBV (SVal _ (Left c)) <- ind = case cwVal c of-                                         CWInteger i -> if i < 0 || i >= genericLength xs-                                                        then err-                                                        else xs `genericIndex` i-                                         _           -> error $ "SBV.select: unsupported " ++ show (kindOf ind) ++ " valued select/index expression"-    select xsOrig err ind = xs `seq` SBV (SVal kElt (Right (cache r)))-      where kInd = kindOf ind-            kElt = kindOf 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   = case kindOf ind of-                     KBounded False i -> genericTake ((2::Integer) ^ (fromIntegral i     :: Integer)) xsOrig-                     KBounded True  i -> genericTake ((2::Integer) ^ (fromIntegral (i-1) :: Integer)) xsOrig-                     KUnbounded       -> xsOrig-                     _                -> error $ "SBV.select: unsupported " ++ show (kindOf ind) ++ " valued select/index expression"-            r st  = do sws <- mapM (sbvToSW st) xs-                       swe <- sbvToSW st err-                       if all (== swe) sws  -- off-chance that all elts are the same. Note that this also correctly covers the case when list is empty.-                          then return swe-                          else do idx <- getTableIndex st kInd kElt sws-                                  swi <- sbvToSW st ind-                                  let len = length xs-                                  -- NB. No need to worry here that the index might be < 0; as the SMTLib translation takes care of that automatically-                                  newExpr st kElt (SBVApp (LkUp (idx, kInd, kElt, len) swi swe) [])---- Unit-instance Mergeable () where-   symbolicMerge _ _ _ _ = ()-   select _ _ _ = ()---- 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 f t xs ys-    | lxs == lys = zipWith (symbolicMerge f t) xs ys-    | True       = error $ "SBV.Mergeable.List: No least-upper-bound for lists of differing size " ++ show (lxs, lys)-    where (lxs, lys) = (length xs, length ys)---- ZipList-instance Mergeable a => Mergeable (ZipList a) where-  symbolicMerge force test (ZipList xs) (ZipList ys)-    = ZipList (symbolicMerge force test xs ys)---- Maybe-instance Mergeable a => Mergeable (Maybe a) where-  symbolicMerge _ _ Nothing  Nothing  = Nothing-  symbolicMerge f t (Just a) (Just b) = Just $ symbolicMerge f t a b-  symbolicMerge _ _ a b = error $ "SBV.Mergeable.Maybe: No least-upper-bound for " ++ show (k a, k b)-      where k Nothing = "Nothing"-            k _       = "Just"---- Either-instance (Mergeable a, Mergeable b) => Mergeable (Either a b) where-  symbolicMerge f t (Left a)  (Left b)  = Left  $ symbolicMerge f t a b-  symbolicMerge f t (Right a) (Right b) = Right $ symbolicMerge f t a b-  symbolicMerge _ _ a b = error $ "SBV.Mergeable.Either: No least-upper-bound for " ++ show (k a, k b)-     where k (Left _)  = "Left"-           k (Right _) = "Right"---- Arrays-instance (Ix a, Mergeable b) => Mergeable (Array a b) where-  symbolicMerge f t a b-    | ba == bb = listArray ba (zipWith (symbolicMerge f t) (elems a) (elems b))-    | True     = error $ "SBV.Mergeable.Array: No least-upper-bound for rangeSizes" ++ show (k ba, k bb)-    where [ba, bb] = map bounds [a, b]-          k = rangeSize---- Functions-instance Mergeable b => Mergeable (a -> b) where-  symbolicMerge f t g h x = symbolicMerge f t (g x) (h 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 f t (i0, i1) (j0, j1) = (i i0 j0, i i1 j1)-    where i a b = symbolicMerge f t a b-  select xs (err1, err2) ind = (select as err1 ind, select bs err2 ind)-    where (as, bs) = unzip xs---- 3-Tuple-instance (Mergeable a, Mergeable b, Mergeable c) => Mergeable (a, b, c) where-  symbolicMerge f t (i0, i1, i2) (j0, j1, j2) = (i i0 j0, i i1 j1, i i2 j2)-    where i a b = symbolicMerge f t a b-  select xs (err1, err2, err3) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind)-    where (as, bs, cs) = unzip3 xs---- 4-Tuple-instance (Mergeable a, Mergeable b, Mergeable c, Mergeable d) => Mergeable (a, b, c, d) where-  symbolicMerge f t (i0, i1, i2, i3) (j0, j1, j2, j3) = (i i0 j0, i i1 j1, i i2 j2, i i3 j3)-    where i a b = symbolicMerge f t a b-  select xs (err1, err2, err3, err4) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind, select ds err4 ind)-    where (as, bs, cs, ds) = unzip4 xs---- 5-Tuple-instance (Mergeable a, Mergeable b, Mergeable c, Mergeable d, Mergeable e) => Mergeable (a, b, c, d, e) where-  symbolicMerge f t (i0, i1, i2, i3, i4) (j0, j1, j2, j3, j4) = (i i0 j0, i i1 j1, i i2 j2, i i3 j3, i i4 j4)-    where i a b = symbolicMerge f t a b-  select xs (err1, err2, err3, err4, err5) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind, select ds err4 ind, select es err5 ind)-    where (as, bs, cs, ds, es) = unzip5 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 f t (i0, i1, i2, i3, i4, i5) (j0, j1, j2, j3, j4, j5) = (i i0 j0, i i1 j1, i i2 j2, i i3 j3, i i4 j4, i i5 j5)-    where i a b = symbolicMerge f t a b-  select xs (err1, err2, err3, err4, err5, err6) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind, select ds err4 ind, select es err5 ind, select fs err6 ind)-    where (as, bs, cs, ds, es, fs) = unzip6 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 f t (i0, i1, i2, i3, i4, i5, i6) (j0, j1, j2, j3, j4, j5, j6) = (i i0 j0, i i1 j1, i i2 j2, i i3 j3, i i4 j4, i i5 j5, i i6 j6)-    where i a b = symbolicMerge f t a b-  select xs (err1, err2, err3, err4, err5, err6, err7) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind, select ds err4 ind, select es err5 ind, select fs err6 ind, select gs err7 ind)-    where (as, bs, cs, ds, es, fs, gs) = unzip7 xs---- 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 force t x y = G.to $ symbolicMerge' force t (G.from x) (G.from y)---- | Not exported. Used only in 'symbolicMergeDefault'. Instances are provided for--- the generic representations of product types where each element is Mergeable.-class GMergeable f where-  symbolicMerge' :: Bool -> SBool -> f a -> f a -> f a--instance GMergeable U1 where-  symbolicMerge' _ _ _ _ = U1--instance (Mergeable c) => GMergeable (K1 i c) where-  symbolicMerge' force t (K1 x) (K1 y) = K1 $ symbolicMerge force t x y--instance (GMergeable f) => GMergeable (M1 i c f) where-  symbolicMerge' force t (M1 x) (M1 y) = M1 $ symbolicMerge' force t x y--instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where-  symbolicMerge' force t (x1 :*: y1) (x2 :*: y2) = symbolicMerge' force t x1 x2 :*: symbolicMerge' force t y1 y2---- Bounded instances-instance (SymWord a, Bounded a) => Bounded (SBV a) where-  minBound = literal minBound-  maxBound = literal maxBound---- Arrays---- SArrays are both "EqSymbolic" and "Mergeable"-instance EqSymbolic (SArray a b) where-  SArray a .== SArray b = SBV (a `eqSArr` b)---- When merging arrays; we'll ignore the force argument. This is arguably--- the right thing to do as we've too many things and likely we want to keep it efficient.-instance SymWord b => Mergeable (SArray a b) where-  symbolicMerge _ = mergeArrays---- When merging arrays; we'll ignore the force argument. This is arguably--- the right thing to do as we've too many things and likely we want to keep it efficient.-instance SymWord b => Mergeable (SFunArray a b) where-  symbolicMerge _ = mergeArrays---- | Uninterpreted constants and functions. An uninterpreted constant is--- a value that is indexed by its name. The only property the prover assumes--- about these values are that they are equivalent to themselves; i.e., (for--- functions) they return the same results when applied to same arguments.--- We support uninterpreted-functions as a general means of black-box'ing--- operations that are /irrelevant/ for the purposes of the proof; i.e., when--- the proofs can be performed without any knowledge about the function itself.------ Minimal complete definition: 'sbvUninterpret'. However, most instances in--- practice are already provided by SBV, so end-users should not need to define their--- own instances.-class Uninterpreted a where-  -- | Uninterpret a value, receiving an object that can be used instead. Use this version-  -- when you do not need to add an axiom about this value.-  uninterpret :: String -> a-  -- | Uninterpret a value, only for the purposes of code-generation. For execution-  -- and verification the value is used as is. For code-generation, the alternate-  -- definition is used. This is useful when we want to take advantage of native-  -- libraries on the target languages.-  cgUninterpret :: String -> [String] -> a -> a-  -- | Most generalized form of uninterpretation, this function should not be needed-  -- by end-user-code, but is rather useful for the library development.-  sbvUninterpret :: Maybe ([String], a) -> String -> a--  {-# MINIMAL sbvUninterpret #-}--  -- defaults:-  uninterpret             = sbvUninterpret Nothing-  cgUninterpret nm code v = sbvUninterpret (Just (code, v)) nm---- Plain constants-instance HasKind a => Uninterpreted (SBV a) where-  sbvUninterpret mbCgData nm-     | Just (_, v) <- mbCgData = v-     | True                    = SBV $ SVal ka $ Right $ cache result-    where ka = kindOf (undefined :: a)-          result st = do isSMT <- inSMTMode st-                         case (isSMT, mbCgData) of-                           (True, Just (_, v)) -> sbvToSW st v-                           _                   -> do newUninterpreted st nm (SBVType [ka]) (fst `fmap` mbCgData)-                                                     newExpr st ka $ SBVApp (Uninterpreted nm) []---- Functions of one argument-instance (SymWord b, HasKind a) => Uninterpreted (SBV b -> SBV a) where-  sbvUninterpret mbCgData nm = f-    where f arg0-           | Just (_, v) <- mbCgData, isConcrete arg0-           = v arg0-           | True-           = SBV $ SVal ka $ Right $ cache result-           where ka = kindOf (undefined :: a)-                 kb = kindOf (undefined :: b)-                 result st = do isSMT <- inSMTMode st-                                case (isSMT, mbCgData) of-                                  (True, Just (_, v)) -> sbvToSW st (v arg0)-                                  _                   -> do newUninterpreted st nm (SBVType [kb, ka]) (fst `fmap` mbCgData)-                                                            sw0 <- sbvToSW st arg0-                                                            mapM_ forceSWArg [sw0]-                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0]---- Functions of two arguments-instance (SymWord c, SymWord b, HasKind a) => Uninterpreted (SBV c -> SBV b -> SBV a) where-  sbvUninterpret mbCgData nm = f-    where f arg0 arg1-           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1-           = v arg0 arg1-           | True-           = SBV $ SVal ka $ Right $ cache result-           where ka = kindOf (undefined :: a)-                 kb = kindOf (undefined :: b)-                 kc = kindOf (undefined :: c)-                 result st = do isSMT <- inSMTMode st-                                case (isSMT, mbCgData) of-                                  (True, Just (_, v)) -> sbvToSW st (v arg0 arg1)-                                  _                   -> do newUninterpreted st nm (SBVType [kc, kb, ka]) (fst `fmap` mbCgData)-                                                            sw0 <- sbvToSW st arg0-                                                            sw1 <- sbvToSW st arg1-                                                            mapM_ forceSWArg [sw0, sw1]-                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1]---- Functions of three arguments-instance (SymWord d, SymWord c, SymWord b, HasKind a) => Uninterpreted (SBV d -> SBV c -> SBV b -> SBV a) where-  sbvUninterpret mbCgData nm = f-    where f arg0 arg1 arg2-           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2-           = v arg0 arg1 arg2-           | True-           = SBV $ SVal ka $ Right $ cache result-           where ka = kindOf (undefined :: a)-                 kb = kindOf (undefined :: b)-                 kc = kindOf (undefined :: c)-                 kd = kindOf (undefined :: d)-                 result st = do isSMT <- inSMTMode st-                                case (isSMT, mbCgData) of-                                  (True, Just (_, v)) -> sbvToSW st (v arg0 arg1 arg2)-                                  _                   -> do newUninterpreted st nm (SBVType [kd, kc, kb, ka]) (fst `fmap` mbCgData)-                                                            sw0 <- sbvToSW st arg0-                                                            sw1 <- sbvToSW st arg1-                                                            sw2 <- sbvToSW st arg2-                                                            mapM_ forceSWArg [sw0, sw1, sw2]-                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2]---- Functions of four arguments-instance (SymWord e, SymWord d, SymWord c, SymWord b, HasKind a) => Uninterpreted (SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where-  sbvUninterpret mbCgData nm = f-    where f arg0 arg1 arg2 arg3-           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3-           = v arg0 arg1 arg2 arg3-           | True-           = SBV $ SVal ka $ Right $ cache result-           where ka = kindOf (undefined :: a)-                 kb = kindOf (undefined :: b)-                 kc = kindOf (undefined :: c)-                 kd = kindOf (undefined :: d)-                 ke = kindOf (undefined :: e)-                 result st = do isSMT <- inSMTMode st-                                case (isSMT, mbCgData) of-                                  (True, Just (_, v)) -> sbvToSW st (v arg0 arg1 arg2 arg3)-                                  _                   -> do newUninterpreted st nm (SBVType [ke, kd, kc, kb, ka]) (fst `fmap` mbCgData)-                                                            sw0 <- sbvToSW st arg0-                                                            sw1 <- sbvToSW st arg1-                                                            sw2 <- sbvToSW st arg2-                                                            sw3 <- sbvToSW st arg3-                                                            mapM_ forceSWArg [sw0, sw1, sw2, sw3]-                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3]---- Functions of five arguments-instance (SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasKind a) => Uninterpreted (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where-  sbvUninterpret mbCgData nm = f-    where f arg0 arg1 arg2 arg3 arg4-           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3, isConcrete arg4-           = v arg0 arg1 arg2 arg3 arg4-           | True-           = SBV $ SVal ka $ Right $ cache result-           where ka = kindOf (undefined :: a)-                 kb = kindOf (undefined :: b)-                 kc = kindOf (undefined :: c)-                 kd = kindOf (undefined :: d)-                 ke = kindOf (undefined :: e)-                 kf = kindOf (undefined :: f)-                 result st = do isSMT <- inSMTMode st-                                case (isSMT, mbCgData) of-                                  (True, Just (_, v)) -> sbvToSW st (v arg0 arg1 arg2 arg3 arg4)-                                  _                   -> do newUninterpreted st nm (SBVType [kf, ke, kd, kc, kb, ka]) (fst `fmap` mbCgData)-                                                            sw0 <- sbvToSW st arg0-                                                            sw1 <- sbvToSW st arg1-                                                            sw2 <- sbvToSW st arg2-                                                            sw3 <- sbvToSW st arg3-                                                            sw4 <- sbvToSW st arg4-                                                            mapM_ forceSWArg [sw0, sw1, sw2, sw3, sw4]-                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3, sw4]---- Functions of six arguments-instance (SymWord g, SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasKind a) => Uninterpreted (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where-  sbvUninterpret mbCgData nm = f-    where f arg0 arg1 arg2 arg3 arg4 arg5-           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3, isConcrete arg4, isConcrete arg5-           = v arg0 arg1 arg2 arg3 arg4 arg5-           | True-           = SBV $ SVal ka $ Right $ cache result-           where ka = kindOf (undefined :: a)-                 kb = kindOf (undefined :: b)-                 kc = kindOf (undefined :: c)-                 kd = kindOf (undefined :: d)-                 ke = kindOf (undefined :: e)-                 kf = kindOf (undefined :: f)-                 kg = kindOf (undefined :: g)-                 result st = do isSMT <- inSMTMode st-                                case (isSMT, mbCgData) of-                                  (True, Just (_, v)) -> sbvToSW st (v arg0 arg1 arg2 arg3 arg4 arg5)-                                  _                   -> do newUninterpreted st nm (SBVType [kg, kf, ke, kd, kc, kb, ka]) (fst `fmap` mbCgData)-                                                            sw0 <- sbvToSW st arg0-                                                            sw1 <- sbvToSW st arg1-                                                            sw2 <- sbvToSW st arg2-                                                            sw3 <- sbvToSW st arg3-                                                            sw4 <- sbvToSW st arg4-                                                            sw5 <- sbvToSW st arg5-                                                            mapM_ forceSWArg [sw0, sw1, sw2, sw3, sw4, sw5]-                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3, sw4, sw5]---- Functions of seven arguments-instance (SymWord h, SymWord g, SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasKind a)-            => Uninterpreted (SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where-  sbvUninterpret mbCgData nm = f-    where f arg0 arg1 arg2 arg3 arg4 arg5 arg6-           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3, isConcrete arg4, isConcrete arg5, isConcrete arg6-           = v arg0 arg1 arg2 arg3 arg4 arg5 arg6-           | True-           = SBV $ SVal ka $ Right $ cache result-           where ka = kindOf (undefined :: a)-                 kb = kindOf (undefined :: b)-                 kc = kindOf (undefined :: c)-                 kd = kindOf (undefined :: d)-                 ke = kindOf (undefined :: e)-                 kf = kindOf (undefined :: f)-                 kg = kindOf (undefined :: g)-                 kh = kindOf (undefined :: h)-                 result st = do isSMT <- inSMTMode st-                                case (isSMT, mbCgData) of-                                  (True, Just (_, v)) -> sbvToSW st (v arg0 arg1 arg2 arg3 arg4 arg5 arg6)-                                  _                   -> do newUninterpreted st nm (SBVType [kh, kg, kf, ke, kd, kc, kb, ka]) (fst `fmap` mbCgData)-                                                            sw0 <- sbvToSW st arg0-                                                            sw1 <- sbvToSW st arg1-                                                            sw2 <- sbvToSW st arg2-                                                            sw3 <- sbvToSW st arg3-                                                            sw4 <- sbvToSW st arg4-                                                            sw5 <- sbvToSW st arg5-                                                            sw6 <- sbvToSW st arg6-                                                            mapM_ forceSWArg [sw0, sw1, sw2, sw3, sw4, sw5, sw6]-                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3, sw4, sw5, sw6]---- Uncurried functions of two arguments-instance (SymWord c, SymWord b, HasKind a) => Uninterpreted ((SBV c, SBV b) -> SBV a) where-  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc2 `fmap` mbCgData) nm in uncurry f-    where uc2 (cs, fn) = (cs, curry fn)---- Uncurried functions of three arguments-instance (SymWord d, SymWord c, SymWord b, HasKind a) => Uninterpreted ((SBV d, SBV c, SBV b) -> SBV a) where-  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc3 `fmap` mbCgData) nm in \(arg0, arg1, arg2) -> f arg0 arg1 arg2-    where uc3 (cs, fn) = (cs, \a b c -> fn (a, b, c))---- Uncurried functions of four arguments-instance (SymWord e, SymWord d, SymWord c, SymWord b, HasKind a)-            => Uninterpreted ((SBV e, SBV d, SBV c, SBV b) -> SBV a) where-  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc4 `fmap` mbCgData) nm in \(arg0, arg1, arg2, arg3) -> f arg0 arg1 arg2 arg3-    where uc4 (cs, fn) = (cs, \a b c d -> fn (a, b, c, d))---- Uncurried functions of five arguments-instance (SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasKind a)-            => Uninterpreted ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where-  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc5 `fmap` mbCgData) nm in \(arg0, arg1, arg2, arg3, arg4) -> f arg0 arg1 arg2 arg3 arg4-    where uc5 (cs, fn) = (cs, \a b c d e -> fn (a, b, c, d, e))---- Uncurried functions of six arguments-instance (SymWord g, SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasKind a)-            => Uninterpreted ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where-  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc6 `fmap` mbCgData) nm in \(arg0, arg1, arg2, arg3, arg4, arg5) -> f arg0 arg1 arg2 arg3 arg4 arg5-    where uc6 (cs, fn) = (cs, \a b c d e f -> fn (a, b, c, d, e, f))---- Uncurried functions of seven arguments-instance (SymWord h, SymWord g, SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasKind a)-            => Uninterpreted ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where-  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc7 `fmap` mbCgData) nm in \(arg0, arg1, arg2, arg3, arg4, arg5, arg6) -> f arg0 arg1 arg2 arg3 arg4 arg5 arg6-    where uc7 (cs, fn) = (cs, \a b c d e f g -> fn (a, b, c, d, e, f, g))---- | Symbolic computations provide a context for writing symbolic programs.-instance SolverContext Symbolic where-   constrain                   (SBV c) = imposeConstraint False []               c-   softConstrain               (SBV c) = imposeConstraint True  []               c-   namedConstraint        nm   (SBV c) = imposeConstraint False [(":named", nm)] c-   constrainWithAttribute atts (SBV c) = imposeConstraint False atts             c--   setOption o = addNewSMTOption  o---- | Introduce a soft assertion, with an optional penalty-assertWithPenalty :: String -> SBool -> Penalty -> Symbolic ()-assertWithPenalty nm o p = addSValOptGoal $ unSBV `fmap` AssertWithPenalty nm o p---- | Class of metrics we can optimize for. Currently,--- bounded signed/unsigned bit-vectors, unbounded integers,--- and algebraic reals can be optimized. (But not, say, SFloat, SDouble, or SBool.)--- Minimal complete definition: minimize/maximize.------ 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>.-class Metric a where-  -- | Minimize a named metric-  minimize :: String -> a -> Symbolic ()--  -- | Maximize a named metric-  maximize :: String -> a -> Symbolic ()--instance Metric SWord8   where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)-instance Metric SWord16  where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)-instance Metric SWord32  where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)-instance Metric SWord64  where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)-instance Metric SInt8    where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)-instance Metric SInt16   where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)-instance Metric SInt32   where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)-instance Metric SInt64   where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)-instance Metric SInteger where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)-instance Metric SReal    where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)---- Quickcheck interface on symbolic-booleans..-instance Testable SBool where-  property (SBV (SVal _ (Left b))) = property (cwToBool b)-  property _                       = error "Quick-check: Constant folding produced a symbolic value! Perhaps used a non-reducible expression? Please report!"--instance Testable (Symbolic SBool) where-   property prop = QC.monadicIO $ do (cond, r, modelVals) <- QC.run test-                                     QC.pre cond-                                     unless (r || null modelVals) $ QC.monitor (QC.counterexample (complain modelVals))-                                     QC.assert r-     where test = do (r, Result{resTraces=tvals, resObservables=ovals, resConsts=cs, resConstraints=cstrs, resUIConsts=unints}) <- runSymbolic Concrete prop--                     let cval = fromMaybe (error "Cannot quick-check in the presence of uninterpeted constants!") . (`lookup` cs)-                         cond = and [cwToBool (cval v) | (False, _, v) <- cstrs] -- Only pick-up "hard" constraints, as indicated by False in the fist component--                         getObservable (nm, v) = case v `lookup` cs of-                                                   Just cw -> (nm, cw)-                                                   Nothing -> error $ "Quick-check: Observable " ++ nm ++ " did not reduce to a constant!"--                     case map fst unints of-                       [] -> case unliteral r of-                               Nothing -> noQC [show r]-                               Just b  -> return (cond, b, tvals ++ map getObservable ovals)-                       us -> noQC us--           complain qcInfo = showModel defaultSMTCfg (SMTModel [] qcInfo)--           noQC us         = error $ "Cannot quick-check in the presence of uninterpreted constants: " ++ intercalate ", " us---- | 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 prop = QC.isSuccess `fmap` QC.quickCheckResult prop---- Quickcheck interface on dynamically-typed values. A run-time check--- ensures that the value has boolean type.-instance Testable (Symbolic SVal) where-  property m = property $ do s <- m-                             when (kindOf s /= KBool) $ error "Cannot quickcheck non-boolean value"-                             return (SBV s :: SBool)---- | Explicit sharing combinator. The SBV library has internal caching/hash-consing mechanisms--- built in, based on Andy Gill's type-safe obervable 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 x f = SBV $ SVal k $ Right $ cache r-    where k    = kindOf (undefined :: b)-          r st = do xsw <- sbvToSW st x-                    let xsbv = SBV $ SVal (kindOf x) (Right (cache (const (return xsw))))-                        res  = f xsbv-                    sbvToSW st res+-- Module    : Data.SBV.Core.Model+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Instance declarations for our symbolic world+-----------------------------------------------------------------------------++{-# LANGUAGE BangPatterns          #-}+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE Rank2Types            #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeApplications      #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE TypeSynonymInstances  #-}++{-# OPTIONS_GHC -fno-warn-orphans  #-}++module Data.SBV.Core.Model (+    Mergeable(..), Equality(..), EqSymbolic(..), OrdSymbolic(..), SDivisible(..), Uninterpreted(..), Metric(..), assertWithPenalty, SIntegral, SFiniteBits(..)+  , ite, iteLazy, sFromIntegral, sShiftLeft, sShiftRight, sRotateLeft, sRotateRight, sSignedShiftArithRight, (.^)+  , oneIf, genVar, genVar_, forall, forall_, exists, exists_+  , pbAtMost, pbAtLeast, pbExactly, pbLe, pbGe, pbEq, pbMutexed, pbStronglyMutexed+  , sBool, sBools, sWord8, sWord8s, sWord16, sWord16s, sWord32+  , sWord32s, sWord64, sWord64s, sInt8, sInt8s, sInt16, sInt16s, sInt32, sInt32s, sInt64+  , sInt64s, sInteger, sIntegers, sReal, sReals, sFloat, sFloats, sDouble, sDoubles, sChar, sChars, sString, sStrings, sList, sLists, sTuple, sTuples+  , solve+  , slet+  , sRealToSInteger, label, observe, observeIf+  , sAssert+  , liftQRem, liftDMod, symbolicMergeWithKind+  , genLiteral, genFromCV, genMkSymVar+  , sbvQuickCheck+  )+  where++import Control.Applicative    (ZipList(ZipList))+import Control.Monad          (when, unless, mplus)+import Control.Monad.IO.Class (MonadIO)++import GHC.Generics (U1(..), M1(..), (:*:)(..), K1(..))+import qualified GHC.Generics as G++import GHC.Stack++import Data.Array  (Array, Ix, listArray, elems, bounds, rangeSize)+import Data.Bits   (Bits(..))+import Data.Char   (toLower, isDigit)+import Data.Int    (Int8, Int16, Int32, Int64)+import Data.List   (genericLength, genericIndex, genericTake, unzip4, unzip5, unzip6, unzip7, intercalate, isPrefixOf)+import Data.Maybe  (fromMaybe, mapMaybe)+import Data.String (IsString(..))+import Data.Word   (Word8, Word16, Word32, Word64)++import Data.Proxy+import Data.Dynamic (fromDynamic, toDyn)++import Test.QuickCheck                         (Testable(..), Arbitrary(..))+import qualified Test.QuickCheck.Test    as QC (isSuccess)+import qualified Test.QuickCheck         as QC (quickCheckResult, counterexample)+import qualified Test.QuickCheck.Monadic as QC (monadicIO, run, assert, pre, monitor)++import Data.SBV.Core.AlgReals+import Data.SBV.Core.Data+import Data.SBV.Core.Symbolic+import Data.SBV.Core.Operations++import Data.SBV.Provers.Prover (defaultSMTCfg, SafeResult(..), prove)+import Data.SBV.SMT.SMT        (ThmResult, showModel)++import Data.SBV.Utils.Lib      (isKString)++-- Symbolic-Word class instances++-- | Generate a finite symbolic bitvector, named+genVar :: MonadSymbolic m => Maybe Quantifier -> Kind -> String -> m (SBV a)+genVar q k = mkSymSBV q k . Just++-- | Generate a finite symbolic bitvector, unnamed+genVar_ :: MonadSymbolic m => Maybe Quantifier -> Kind -> m (SBV a)+genVar_ q k = mkSymSBV q k Nothing++-- | Generate a finite constant bitvector+genLiteral :: Integral a => Kind -> a -> SBV b+genLiteral k = SBV . SVal k . Left . mkConstCV k++-- | Convert a constant to an integral value+genFromCV :: Integral a => CV -> a+genFromCV (CV _ (CInteger x)) = fromInteger x+genFromCV c                   = error $ "genFromCV: Unsupported non-integral value: " ++ show c++-- | Generalization of 'Data.SBV.genMkSymVar'+genMkSymVar :: MonadSymbolic m => Kind -> Maybe Quantifier -> Maybe String -> m (SBV a)+genMkSymVar k mbq Nothing  = genVar_ mbq k+genMkSymVar k mbq (Just s) = genVar  mbq k s++instance SymVal Bool where+  mkSymVal = genMkSymVar KBool+  literal  = SBV . svBool+  fromCV   = cvToBool++instance SymVal Word8 where+  mkSymVal = genMkSymVar (KBounded False 8)+  literal  = genLiteral  (KBounded False 8)+  fromCV   = genFromCV++instance SymVal Int8 where+  mkSymVal = genMkSymVar (KBounded True 8)+  literal  = genLiteral  (KBounded True 8)+  fromCV   = genFromCV++instance SymVal Word16 where+  mkSymVal = genMkSymVar (KBounded False 16)+  literal  = genLiteral  (KBounded False 16)+  fromCV   = genFromCV++instance SymVal Int16 where+  mkSymVal = genMkSymVar (KBounded True 16)+  literal  = genLiteral  (KBounded True 16)+  fromCV   = genFromCV++instance SymVal Word32 where+  mkSymVal = genMkSymVar (KBounded False 32)+  literal  = genLiteral  (KBounded False 32)+  fromCV   = genFromCV++instance SymVal Int32 where+  mkSymVal = genMkSymVar (KBounded True 32)+  literal  = genLiteral  (KBounded True 32)+  fromCV   = genFromCV++instance SymVal Word64 where+  mkSymVal = genMkSymVar (KBounded False 64)+  literal  = genLiteral  (KBounded False 64)+  fromCV   = genFromCV++instance SymVal Int64 where+  mkSymVal = genMkSymVar (KBounded True 64)+  literal  = genLiteral  (KBounded True 64)+  fromCV   = genFromCV++instance SymVal Integer where+  mkSymVal = genMkSymVar KUnbounded+  literal  = SBV . SVal KUnbounded . Left . mkConstCV KUnbounded+  fromCV   = genFromCV++instance SymVal AlgReal where+  mkSymVal                   = genMkSymVar KReal+  literal                    = SBV . SVal KReal . Left . CV KReal . CAlgReal+  fromCV (CV _ (CAlgReal a)) = a+  fromCV c                   = error $ "SymVal.AlgReal: Unexpected non-real value: " ++ show c++  -- AlgReal needs its own definition of isConcretely+  -- to make sure we avoid using unimplementable Haskell functions+  isConcretely (SBV (SVal KReal (Left (CV KReal (CAlgReal v))))) p+     | isExactRational v = p v+  isConcretely _ _       = False++instance SymVal Float where+  mkSymVal                 = genMkSymVar KFloat+  literal                  = SBV . SVal KFloat . Left . CV KFloat . CFloat+  fromCV (CV _ (CFloat a)) = a+  fromCV c                 = error $ "SymVal.Float: Unexpected non-float value: " ++ show c++  -- For Float, we conservatively return 'False' for isConcretely. The reason is that+  -- this function is used for optimizations when only one of the argument is concrete,+  -- and in the presence of NaN's it would be incorrect to do any optimization+  isConcretely _ _ = False++instance SymVal Double where+  mkSymVal                  = genMkSymVar KDouble+  literal                   = SBV . SVal KDouble . Left . CV KDouble . CDouble+  fromCV (CV _ (CDouble a)) = a+  fromCV c                  = error $ "SymVal.Double: Unexpected non-double value: " ++ show c++  -- For Double, we conservatively return 'False' for isConcretely. The reason is that+  -- this function is used for optimizations when only one of the argument is concrete,+  -- and in the presence of NaN's it would be incorrect to do any optimization+  isConcretely _ _ = False++instance SymVal Char where+  mkSymVal                = genMkSymVar KChar+  literal c               = SBV . SVal KChar . Left . CV KChar $ CChar c+  fromCV (CV _ (CChar a)) = a+  fromCV c                = error $ "SymVal.String: Unexpected non-char value: " ++ show c++instance SymVal a => SymVal [a] where+  mkSymVal+    | isKString @[a] undefined = genMkSymVar KString+    | True                     = genMkSymVar (KList (kindOf (Proxy @a)))++  literal as+    | isKString @[a] undefined = case fromDynamic (toDyn as) of+                                   Just s  -> SBV . SVal KString . Left . CV KString . CString $ s+                                   Nothing -> error "SString: Cannot construct literal string!"+    | True                     = let k = KList (kindOf (Proxy @a))+                                 in SBV $ SVal k $ Left $ CV k $ CList $ map toCV as++  fromCV (CV _ (CString a)) = fromMaybe (error "SString: Cannot extract a literal string!")+                                        (fromDynamic (toDyn a))+  fromCV (CV _ (CList a))   = fromCV . CV (kindOf (Proxy @a)) <$> a+  fromCV c                  = error $ "SymVal.fromCV: Unexpected non-list value: " ++ show c++toCV :: SymVal a => a -> CVal+toCV a = case literal a of+           SBV (SVal _ (Left cv)) -> cvVal cv+           _                      -> error "SymVal.toCV: Impossible happened, couldn't produce a concrete value"++mkCVTup :: Int -> Kind -> [CVal] -> SBV a+mkCVTup i k@(KTuple ks) cs+  | lks == lcs && lks == i+  = SBV $ SVal k $ Left $ CV k $ CTuple cs+  | True+  = error $ "SymVal.mkCVTup: Impossible happened. Malformed tuple received: " ++ show (i, k)+   where lks = length ks+         lcs = length cs+mkCVTup i k _+  = error $ "SymVal.mkCVTup: Impossible happened. Non-tuple received: " ++ show (i, k)++fromCVTup :: Int -> CV -> [CV]+fromCVTup i inp@(CV (KTuple ks) (CTuple cs))+   | lks == lcs && lks == i+   = zipWith CV ks cs+   | True+   = error $ "SymVal.fromCTup: Impossible happened. Malformed tuple received: " ++ show (i, inp)+   where lks = length ks+         lcs = length cs+fromCVTup i inp = error $ "SymVal.fromCVTup: Impossible happened. Non-tuple received: " ++ show (i, inp)++-- | SymVal for 0-tuple (i.e., unit)+instance SymVal () where+  mkSymVal   = genMkSymVar (KTuple [])+  literal () = mkCVTup 0   (kindOf (Proxy @())) []+  fromCV cv  = fromCVTup 0 cv `seq` ()++-- | SymVal for 2-tuples+instance (SymVal a, SymVal b) => SymVal (a, b) where+   mkSymVal         = genMkSymVar (kindOf (Proxy @(a, b)))+   literal (v1, v2) = mkCVTup 2   (kindOf (Proxy @(a, b))) [toCV v1, toCV v2]+   fromCV  cv       = let ~[v1, v2] = fromCVTup 2 cv+                      in (fromCV v1, fromCV v2)++-- | SymVal for 3-tuples+instance (SymVal a, SymVal b, SymVal c) => SymVal (a, b, c) where+   mkSymVal             = genMkSymVar (kindOf (Proxy @(a, b, c)))+   literal (v1, v2, v3) = mkCVTup 3   (kindOf (Proxy @(a, b, c))) [toCV v1, toCV v2, toCV v3]+   fromCV  cv           = let ~[v1, v2, v3] = fromCVTup 3 cv+                          in (fromCV v1, fromCV v2, fromCV v3)++-- | SymVal for 4-tuples+instance (SymVal a, SymVal b, SymVal c, SymVal d) => SymVal (a, b, c, d) where+   mkSymVal                 = genMkSymVar (kindOf (Proxy @(a, b, c, d)))+   literal (v1, v2, v3, v4) = mkCVTup 4   (kindOf (Proxy @(a, b, c, d))) [toCV v1, toCV v2, toCV v3, toCV v4]+   fromCV  cv               = let ~[v1, v2, v3, v4] = fromCVTup 4 cv+                              in (fromCV v1, fromCV v2, fromCV v3, fromCV v4)++-- | SymVal for 5-tuples+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e) => SymVal (a, b, c, d, e) where+   mkSymVal                     = genMkSymVar (kindOf (Proxy @(a, b, c, d, e)))+   literal (v1, v2, v3, v4, v5) = mkCVTup 5   (kindOf (Proxy @(a, b, c, d, e))) [toCV v1, toCV v2, toCV v3, toCV v4, toCV v5]+   fromCV  cv                   = let ~[v1, v2, v3, v4, v5] = fromCVTup 5 cv+                                  in (fromCV v1, fromCV v2, fromCV v3, fromCV v4, fromCV v5)++-- | SymVal for 6-tuples+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f) => SymVal (a, b, c, d, e, f) where+   mkSymVal                         = genMkSymVar (kindOf (Proxy @(a, b, c, d, e, f)))+   literal (v1, v2, v3, v4, v5, v6) = mkCVTup 6   (kindOf (Proxy @(a, b, c, d, e, f))) [toCV v1, toCV v2, toCV v3, toCV v4, toCV v5, toCV v6]+   fromCV  cv                       = let ~[v1, v2, v3, v4, v5, v6] = fromCVTup 6 cv+                                      in (fromCV v1, fromCV v2, fromCV v3, fromCV v4, fromCV v5, fromCV v6)++-- | SymVal for 7-tuples+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g) => SymVal (a, b, c, d, e, f, g) where+   mkSymVal                             = genMkSymVar (kindOf (Proxy @(a, b, c, d, e, f, g)))+   literal (v1, v2, v3, v4, v5, v6, v7) = mkCVTup 7   (kindOf (Proxy @(a, b, c, d, e, f, g))) [toCV v1, toCV v2, toCV v3, toCV v4, toCV v5, toCV v6, toCV v7]+   fromCV  cv                           = let ~[v1, v2, v3, v4, v5, v6, v7] = fromCVTup 7 cv+                                          in (fromCV v1, fromCV v2, fromCV v3, fromCV v4, fromCV v5, fromCV v6, fromCV v7)++-- | SymVal for 8-tuples+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g, SymVal h) => SymVal (a, b, c, d, e, f, g, h) where+   mkSymVal                                 = genMkSymVar (kindOf (Proxy @(a, b, c, d, e, f, g, h)))+   literal (v1, v2, v3, v4, v5, v6, v7, v8) = mkCVTup 8   (kindOf (Proxy @(a, b, c, d, e, f, g, h))) [toCV v1, toCV v2, toCV v3, toCV v4, toCV v5, toCV v6, toCV v7, toCV v8]+   fromCV  cv                               = let ~[v1, v2, v3, v4, v5, v6, v7, v8] = fromCVTup 8 cv+                                              in (fromCV v1, fromCV v2, fromCV v3, fromCV v4, fromCV v5, fromCV v6, fromCV v7, fromCV v8)++instance IsString SString where+  fromString = 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 = symbolic++-- | Generalization of 'Data.SBV.sBools'+sBools :: MonadSymbolic m => [String] -> m [SBool]+sBools = symbolics++-- | Generalization of 'Data.SBV.sWord8'+sWord8 :: MonadSymbolic m => String -> m SWord8+sWord8 = symbolic++-- | Generalization of 'Data.SBV.sWord8s'+sWord8s :: MonadSymbolic m => [String] -> m [SWord8]+sWord8s = symbolics++-- | Generalization of 'Data.SBV.sWord16'+sWord16 :: MonadSymbolic m => String -> m SWord16+sWord16 = symbolic++-- | Generalization of 'Data.SBV.sWord16s'+sWord16s :: MonadSymbolic m => [String] -> m [SWord16]+sWord16s = symbolics++-- | Generalization of 'Data.SBV.sWord32'+sWord32 :: MonadSymbolic m => String -> m SWord32+sWord32 = symbolic++-- | Generalization of 'Data.SBV.sWord32s'+sWord32s :: MonadSymbolic m => [String] -> m [SWord32]+sWord32s = symbolics++-- | Generalization of 'Data.SBV.sWord64'+sWord64 :: MonadSymbolic m => String -> m SWord64+sWord64 = symbolic++-- | Generalization of 'Data.SBV.sWord64s'+sWord64s :: MonadSymbolic m => [String] -> m [SWord64]+sWord64s = symbolics++-- | Generalization of 'Data.SBV.sInt8'+sInt8 :: MonadSymbolic m => String -> m SInt8+sInt8 = symbolic++-- | Generalization of 'Data.SBV.sInt8s'+sInt8s :: MonadSymbolic m => [String] -> m [SInt8]+sInt8s = symbolics++-- | Generalization of 'Data.SBV.sInt16'+sInt16 :: MonadSymbolic m => String -> m SInt16+sInt16 = symbolic++-- | Generalization of 'Data.SBV.sInt16s'+sInt16s :: MonadSymbolic m => [String] -> m [SInt16]+sInt16s = symbolics++-- | Generalization of 'Data.SBV.sInt32'+sInt32 :: MonadSymbolic m => String -> m SInt32+sInt32 = symbolic++-- | Generalization of 'Data.SBV.sInt32s'+sInt32s :: MonadSymbolic m => [String] -> m [SInt32]+sInt32s = symbolics++-- | Generalization of 'Data.SBV.sInt64'+sInt64 :: MonadSymbolic m => String -> m SInt64+sInt64 = symbolic++-- | Generalization of 'Data.SBV.sInt64s'+sInt64s :: MonadSymbolic m => [String] -> m [SInt64]+sInt64s = symbolics++-- | Generalization of 'Data.SBV.sInteger'+sInteger:: MonadSymbolic m => String -> m SInteger+sInteger = symbolic++-- | Generalization of 'Data.SBV.sIntegers'+sIntegers :: MonadSymbolic m => [String] -> m [SInteger]+sIntegers = symbolics++-- | Generalization of 'Data.SBV.sReal'+sReal:: MonadSymbolic m => String -> m SReal+sReal = symbolic++-- | Generalization of 'Data.SBV.sReals'+sReals :: MonadSymbolic m => [String] -> m [SReal]+sReals = symbolics++-- | Generalization of 'Data.SBV.sFloat'+sFloat :: MonadSymbolic m => String -> m SFloat+sFloat = symbolic++-- | Generalization of 'Data.SBV.sFloats'+sFloats :: MonadSymbolic m => [String] -> m [SFloat]+sFloats = symbolics++-- | Generalization of 'Data.SBV.sDouble'+sDouble :: MonadSymbolic m => String -> m SDouble+sDouble = symbolic++-- | Generalization of 'Data.SBV.sDoubles'+sDoubles :: MonadSymbolic m => [String] -> m [SDouble]+sDoubles = symbolics++-- | Generalization of 'Data.SBV.sChar'+sChar :: MonadSymbolic m => String -> m SChar+sChar = symbolic++-- | Generalization of 'Data.SBV.sString'+sString :: MonadSymbolic m => String -> m SString+sString = symbolic++-- | Generalization of 'Data.SBV.sChars'+sChars :: MonadSymbolic m => [String] -> m [SChar]+sChars = symbolics++-- | Generalization of 'Data.SBV.sStrings'+sStrings :: MonadSymbolic m => [String] -> m [SString]+sStrings = symbolics++-- | Generalization of 'Data.SBV.sList'+sList :: (SymVal a, MonadSymbolic m) => String -> m (SList a)+sList = symbolic++-- | Generalization of 'Data.SBV.sLists'+sLists :: (SymVal a, MonadSymbolic m) => [String] -> m [SList a]+sLists = symbolics++-- | Generalization of 'Data.SBV.sTuple'+sTuple :: (SymVal tup, MonadSymbolic m) => String -> m (SBV tup)+sTuple = symbolic++-- | Generalization of 'Data.SBV.sTuples'+sTuples :: (SymVal tup, MonadSymbolic m) => [String] -> m [SBV tup]+sTuples = symbolics++-- | Generalization of 'Data.SBV.solve'+solve :: MonadSymbolic m => [SBool] -> m SBool+solve = return . 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 x+  | Just i <- unliteral x, isExactRational i+  = literal $ floor (toRational i)+  | True+  = SBV (SVal KUnbounded (Right (cache y)))+  where y st = do xsv <- sbvToSV st x+                  newExpr st KUnbounded (SBVApp (KindCast KReal KUnbounded) [xsv])++-- | label: Label the result of an expression. This is essentially a no-op, but useful as it generates a comment in the generated C/SMT-Lib code.+-- Note that if the argument is a constant, then the label is dropped completely, per the usual constant folding strategy. Compare this to 'observe'+-- which is good for printing counter-examples.+label :: SymVal a => String -> SBV a -> SBV a+label m x+   | Just _ <- unliteral x = x+   | True                  = SBV $ SVal k $ Right $ cache r+  where k    = kindOf x+        r st = do xsv <- sbvToSV st x+                  newExpr st k (SBVApp (Label m) [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.+observeIf :: SymVal a => (a -> Bool) -> String -> SBV a -> SBV a+observeIf cond m x+  | null m+  = error "SBV.observe: Bad empty name!"+  | map toLower m `elem` smtLibReservedNames+  = error $ "SBV.observe: The name chosen is reserved, please change it!: " ++ show m+  | "s" `isPrefixOf` m && all isDigit (drop 1 m)+  = error $ "SBV.observe: Names of the form sXXX are internal to SBV, please use a different name: " ++ show m+  | True+  = SBV $ SVal k $ Right $ cache r+  where k = kindOf x+        r st = do xsv <- sbvToSV st x+                  recordObservable st m (cond . fromCV) xsv+                  return xsv++-- | Observe the value of an expression, uncoditionally. See 'observeIf' for a generalized version.+observe :: SymVal a => String -> SBV a -> SBV a+observe = observeIf (const True)++-- | Symbolic Equality. Note that we can't use Haskell's 'Eq' class since Haskell insists on returning Bool+-- Comparing symbolic values will necessarily return a symbolic value.+infix 4 .==, ./=+class EqSymbolic a where+  -- | Symbolic equality.+  (.==) :: a -> a -> SBool+  -- | Symbolic inequality.+  (./=) :: a -> a -> SBool++  -- | Returns (symbolic) 'sTrue' if all the elements of the given list are different.+  distinct :: [a] -> SBool++  -- | Returns (symbolic) 'sTrue' if all the elements of the given list are the same.+  allEqual :: [a] -> SBool++  -- | Symbolic membership test.+  sElem    :: a -> [a] -> SBool+  {-# MINIMAL (.==) #-}++  x ./= y = sNot (x .== y)++  allEqual []     = sTrue+  allEqual (x:xs) = sAll (x .==) xs++  -- Default implementation of distinct. Note that we override+  -- this method for the base types to generate better code.+  distinct []     = sTrue+  distinct (x:xs) = sAll (x ./=) xs .&& distinct xs++  sElem x xs = sAny (.== x) xs++-- | Symbolic Comparisons. Similar to 'Eq', we cannot implement Haskell's 'Ord' class+-- since there is no way to return an 'Ordering' value from a symbolic comparison.+-- Furthermore, 'OrdSymbolic' requires 'Mergeable' to implement if-then-else, for the+-- benefit of implementing symbolic versions of 'max' and 'min' functions.+infix 4 .<, .<=, .>, .>=+class (Mergeable a, EqSymbolic a) => OrdSymbolic a where+  -- | Symbolic less than.+  (.<)  :: a -> a -> SBool+  -- | Symbolic less than or equal to.+  (.<=) :: a -> a -> SBool+  -- | Symbolic greater than.+  (.>)  :: a -> a -> SBool+  -- | Symbolic greater than or equal to.+  (.>=) :: a -> a -> SBool+  -- | Symbolic minimum.+  smin  :: a -> a -> a+  -- | Symbolic maximum.+  smax  :: a -> a -> a+  -- | Is the value withing the allowed /inclusive/ range?+  inRange    :: a -> (a, a) -> SBool++  {-# MINIMAL (.<) #-}++  a .<= b    = a .< b .|| a .== b+  a .>  b    = b .<  a+  a .>= b    = b .<= a++  a `smin` b = ite (a .<= b) a b+  a `smax` b = ite (a .<= b) b a++  inRange x (y, z) = x .>= y .&& x .<= 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..+-}++instance EqSymbolic (SBV a) where+  SBV x .== SBV y = SBV (svEqual x y)+  SBV x ./= SBV y = SBV (svNotEqual x y)++  -- Custom version of distinct that generates better code for base types+  distinct []                                             = sTrue+  distinct [_]                                            = sTrue+  distinct xs | all isConc xs                             = checkDiff xs+              | [SBV a, SBV b] <- xs, a `is` svBool True  = SBV $ svNot b+              | [SBV a, SBV b] <- xs, b `is` svBool True  = SBV $ svNot a+              | [SBV a, SBV b] <- xs, a `is` svBool False = SBV b+              | [SBV a, SBV b] <- xs, b `is` svBool False = SBV a+              | length xs > 2 && isBool (head xs)         = sFalse+              | True                                      = SBV (SVal KBool (Right (cache r)))+    where r st = do xsv <- mapM (sbvToSV st) xs+                    newExpr st KBool (SBVApp NotEqual 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 []     = sTrue+          checkDiff (a:as) = sAll (a ./=) as .&& checkDiff as++          -- Sigh, we can't use isConcrete since that requires SymVal+          -- constraint that we don't have here. (To support SBools.)+          isConc (SBV (SVal _ (Left _))) = True+          isConc _                       = False++          -- Likewise here; need to go lower.+          SVal k1 (Left c1) `is` SVal k2 (Left c2) = (k1, c1) == (k2, c2)+          _                 `is` _                 = False++          isBool (SBV (SVal KBool _)) = True+          isBool _                    = False++instance SymVal a => OrdSymbolic (SBV a) where+  SBV x .<  SBV y = SBV (svLessThan x y)+  SBV x .<= SBV y = SBV (svLessEq x y)+  SBV x .>  SBV y = SBV (svGreaterThan x y)+  SBV x .>= SBV y = SBV (svGreaterEq x y)++-- Bool+instance EqSymbolic Bool where+  x .== y = fromBool $ x == y++-- Lists+instance EqSymbolic a => EqSymbolic [a] where+  []     .== []     = sTrue+  (x:xs) .== (y:ys) = x .== y .&& xs .== ys+  _      .== _      = sFalse++instance OrdSymbolic a => OrdSymbolic [a] where+  []     .< []     = sFalse+  []     .< _      = sTrue+  _      .< []     = sFalse+  (x:xs) .< (y:ys) = x .< y .|| (x .== y .&& xs .< ys)++-- Maybe+instance EqSymbolic a => EqSymbolic (Maybe a) where+  Nothing .== Nothing = sTrue+  Just a  .== Just b  = a .== b+  _       .== _       = sFalse++instance (OrdSymbolic a) => OrdSymbolic (Maybe a) where+  Nothing .<  Nothing = sFalse+  Nothing .<  _       = sTrue+  Just _  .<  Nothing = sFalse+  Just a  .<  Just b  = a .< b++-- Either+instance (EqSymbolic a, EqSymbolic b) => EqSymbolic (Either a b) where+  Left a  .== Left b  = a .== b+  Right a .== Right b = a .== b+  _       .== _       = sFalse++instance (OrdSymbolic a, OrdSymbolic b) => OrdSymbolic (Either a b) where+  Left a  .< Left b  = a .< b+  Left _  .< Right _ = sTrue+  Right _ .< Left _  = sFalse+  Right a .< Right b = a .< b++-- 2-Tuple+instance (EqSymbolic a, EqSymbolic b) => EqSymbolic (a, b) where+  (a0, b0) .== (a1, b1) = a0 .== a1 .&& b0 .== b1++instance (OrdSymbolic a, OrdSymbolic b) => OrdSymbolic (a, b) where+  (a0, b0) .< (a1, b1) = a0 .< a1 .|| (a0 .== a1 .&& b0 .< b1)++-- 3-Tuple+instance (EqSymbolic a, EqSymbolic b, EqSymbolic c) => EqSymbolic (a, b, c) where+  (a0, b0, c0) .== (a1, b1, c1) = (a0, b0) .== (a1, b1) .&& c0 .== c1++instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c) => OrdSymbolic (a, b, c) where+  (a0, b0, c0) .< (a1, b1, c1) = (a0, b0) .< (a1, b1) .|| ((a0, b0) .== (a1, b1) .&& c0 .< c1)++-- 4-Tuple+instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d) => EqSymbolic (a, b, c, d) where+  (a0, b0, c0, d0) .== (a1, b1, c1, d1) = (a0, b0, c0) .== (a1, b1, c1) .&& d0 .== d1++instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d) => OrdSymbolic (a, b, c, d) where+  (a0, b0, c0, d0) .< (a1, b1, c1, d1) = (a0, b0, c0) .< (a1, b1, c1) .|| ((a0, b0, c0) .== (a1, b1, c1) .&& d0 .< d1)++-- 5-Tuple+instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d, EqSymbolic e) => EqSymbolic (a, b, c, d, e) where+  (a0, b0, c0, d0, e0) .== (a1, b1, c1, d1, e1) = (a0, b0, c0, d0) .== (a1, b1, c1, d1) .&& e0 .== e1++instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e) => OrdSymbolic (a, b, c, d, e) where+  (a0, b0, c0, d0, e0) .< (a1, b1, c1, d1, e1) = (a0, b0, c0, d0) .< (a1, b1, c1, d1) .|| ((a0, b0, c0, d0) .== (a1, b1, c1, d1) .&& e0 .< e1)++-- 6-Tuple+instance (EqSymbolic a, EqSymbolic b, EqSymbolic c, EqSymbolic d, EqSymbolic e, EqSymbolic f) => EqSymbolic (a, b, c, d, e, f) where+  (a0, b0, c0, d0, e0, f0) .== (a1, b1, c1, d1, e1, f1) = (a0, b0, c0, d0, e0) .== (a1, b1, c1, d1, e1) .&& f0 .== f1++instance (OrdSymbolic a, OrdSymbolic b, OrdSymbolic c, OrdSymbolic d, OrdSymbolic e, OrdSymbolic f) => OrdSymbolic (a, b, c, d, e, f) where+  (a0, b0, c0, d0, e0, f0) .< (a1, b1, c1, d1, e1, f1) =    (a0, b0, c0, d0, e0) .<  (a1, b1, c1, d1, e1)+                                                       .|| ((a0, b0, c0, d0, e0) .== (a1, b1, c1, d1, e1) .&& f0 .< 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+  (a0, b0, c0, d0, e0, f0, g0) .== (a1, b1, c1, d1, e1, f1, g1) = (a0, b0, c0, d0, e0, f0) .== (a1, b1, c1, d1, e1, f1) .&& g0 .== 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+  (a0, b0, c0, d0, e0, f0, g0) .< (a1, b1, c1, d1, e1, f1, g1) =    (a0, b0, c0, d0, e0, f0) .<  (a1, b1, c1, d1, e1, f1)+                                                               .|| ((a0, b0, c0, d0, e0, f0) .== (a1, b1, c1, d1, e1, f1) .&& g0 .< g1)++-- | Symbolic Numbers. This is a simple class that simply incorporates all number like+-- base types together, simplifying writing polymorphic type-signatures that work for all+-- symbolic numbers, such as 'SWord8', 'SInt8' etc. For instance, we can write a generic+-- list-minimum function as follows:+--+-- @+--    mm :: SIntegral a => [SBV a] -> SBV a+--    mm = foldr1 (\a b -> ite (a .<= b) a b)+-- @+--+-- It is similar to the standard 'Integral' class, except ranging over symbolic instances.+class (SymVal a, Num a, Bits a, Integral a) => SIntegral a++-- 'SIntegral' Instances, skips Real/Float/Bool+instance SIntegral Word8+instance SIntegral Word16+instance SIntegral Word32+instance SIntegral Word64+instance SIntegral Int8+instance SIntegral Int16+instance SIntegral Int32+instance SIntegral Int64+instance SIntegral Integer++-- | Finite bit-length symbolic values. Essentially the same as 'SIntegral', but further leaves out 'Integer'. Loosely+-- based on Haskell's @FiniteBits@ class, but with more methods defined and structured differently to fit into the+-- symbolic world view. Minimal complete definition: 'sFiniteBitSize'.+class (SymVal a, Num a, Bits a) => SFiniteBits a where+    -- | Bit size.+    sFiniteBitSize      :: SBV a -> Int+    -- | Least significant bit of a word, always stored at index 0.+    lsb                 :: SBV a -> SBool+    -- | Most significant bit of a word, always stored at the last position.+    msb                 :: SBV a -> SBool+    -- | Big-endian blasting of a word into its bits.+    blastBE             :: SBV a -> [SBool]+    -- | Little-endian blasting of a word into its bits.+    blastLE             :: SBV a -> [SBool]+    -- | Reconstruct from given bits, given in little-endian.+    fromBitsBE          :: [SBool] -> SBV a+    -- | Reconstruct from given bits, given in little-endian.+    fromBitsLE          :: [SBool] -> SBV a+    -- | Replacement for 'testBit', returning 'SBool' instead of 'Bool'.+    sTestBit            :: SBV a -> Int -> SBool+    -- | Variant of 'sTestBit', where we want to extract multiple bit positions.+    sExtractBits        :: SBV a -> [Int] -> [SBool]+    -- | Variant of 'popCount', returning a symbolic value.+    sPopCount           :: SBV a -> SWord8+    -- | A combo of 'setBit' and 'clearBit', when the bit to be set is symbolic.+    setBitTo            :: SBV a -> Int -> SBool -> SBV a+    -- | Full adder, returns carry-out from the addition. Only for unsigned quantities.+    fullAdder           :: SBV a -> SBV a -> (SBool, SBV a)+    -- | Full multipler, 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 v) = SBV (svTestBit v 0)+    msb x       = sTestBit x (sFiniteBitSize x - 1)++    blastBE   = reverse . blastLE+    blastLE x = map (sTestBit x) [0 .. intSizeOf x - 1]++    fromBitsBE = fromBitsLE . reverse+    fromBitsLE bs+       | length bs /= w+       = error $ "SBV.SFiniteBits.fromBitsLE/BE: Expected: " ++ show w ++ " bits, received: " ++ show (length bs)+       | True+       = result+       where w = sFiniteBitSize result+             result = go 0 0 bs++             go !acc _  []     = acc+             go !acc !i (x:xs) = go (ite x (setBit acc i) acc) (i+1) xs++    sTestBit (SBV x) i = SBV (svTestBit x i)+    sExtractBits x     = map (sTestBit 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 x+      | isConcrete x  = go 0 x+      | True          = sum [ite b 1 0 | b <- blastLE x]+      where -- concrete case+            go !c 0 = c+            go !c w = go (c+1) (w .&. (w-1))++    setBitTo x i b = ite b (setBit x i) (clearBit x i)++    fullAdder a b+      | isSigned a = error "fullAdder: only works on unsigned numbers"+      | True       = (a .> s .|| b .> s, s)+      where s = 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 a b+      | isSigned a = error "fullMultiplier: only works on unsigned numbers"+      | True       = (go (sFiniteBitSize a) 0 a, a*b)+      where go 0 p _ = p+            go n p x = let (c, p')  = ite (lsb x) (fullAdder p b) (sFalse, p)+                           (o, p'') = shiftIn c p'+                           (_, x')  = shiftIn o x+                       in go (n-1) p'' x'+            shiftIn k v = (lsb v, mask .|. (v `shiftR` 1))+               where mask = ite k (bit (sFiniteBitSize v - 1)) 0++    -- See the note for 'sPopCount' for a comment on why we return 'SWord8'+    sCountLeadingZeros x = fromIntegral m - go m+      where m = sFiniteBitSize x - 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 i | i < 0 = i8+                 | True  = ite (sTestBit x i) i8 (go (i-1))+               where i8 = literal (fromIntegral i :: Word8)++    -- See the note for 'sPopCount' for a comment on why we return 'SWord8'+    sCountTrailingZeros x = go 0+       where m = sFiniteBitSize x++             go :: Int -> SWord8+             go i | i >= m = i8+                  | True   = ite (sTestBit x i) i8 (go (i+1))+                where i8 = literal (fromIntegral i :: Word8)++-- 'SIntegral' Instances, skips Real/Float/Bool/Integer+instance SFiniteBits Word8  where sFiniteBitSize _ =  8+instance SFiniteBits Word16 where sFiniteBitSize _ = 16+instance SFiniteBits Word32 where sFiniteBitSize _ = 32+instance SFiniteBits Word64 where sFiniteBitSize _ = 64+instance SFiniteBits Int8   where sFiniteBitSize _ =  8+instance SFiniteBits Int16  where sFiniteBitSize _ = 16+instance SFiniteBits Int32  where sFiniteBitSize _ = 32+instance SFiniteBits Int64  where sFiniteBitSize _ = 64++-- | Returns 1 if the boolean is 'sTrue', otherwise 0.+oneIf :: (Num a, SymVal a) => SBool -> SBV a+oneIf t = ite t 1 0++-- | Lift a pseudo-boolean op, performing checks+liftPB :: String -> PBOp -> [SBool] -> SBool+liftPB w o xs+  | Just e <- check o+  = error $ "SBV." ++ w ++ ": " ++ e+  | True+  = result+  where check (PB_AtMost  k) = pos k+        check (PB_AtLeast k) = pos k+        check (PB_Exactly k) = pos k+        check (PB_Le cs   k) = pos k `mplus` match cs+        check (PB_Ge cs   k) = pos k `mplus` match cs+        check (PB_Eq cs   k) = pos k `mplus` match cs++        pos k+          | k < 0 = Just $ "comparison value must be positive, received: " ++ show k+          | True  = Nothing++        match cs+          | any (< 0) cs = Just $ "coefficients must be non-negative. Received: " ++ show cs+          | lxs /= lcs   = Just $ "coefficient length must match number of arguments. Received: " ++ show (lcs, lxs)+          | True         = Nothing+          where lxs = length xs+                lcs = length cs++        result = SBV (SVal KBool (Right (cache r)))+        r st   = do xsv <- mapM (sbvToSV st) xs+                    -- PseudoBoolean's implicitly require support for integers, so make sure to register that kind!+                    registerKind st KUnbounded+                    newExpr st KBool (SBVApp (PseudoBoolean o) xsv)++-- | 'sTrue' if at most @k@ of the input arguments are 'sTrue'+pbAtMost :: [SBool] -> Int -> SBool+pbAtMost xs k+ | k < 0             = error $ "SBV.pbAtMost: Non-negative value required, received: " ++ show k+ | all isConcrete xs = literal $ sum (map (pbToInteger "pbAtMost" 1) xs) <= fromIntegral k+ | True              = liftPB "pbAtMost" (PB_AtMost k) xs++-- | 'sTrue' if at least @k@ of the input arguments are 'sTrue'+pbAtLeast :: [SBool] -> Int -> SBool+pbAtLeast xs k+ | k < 0             = error $ "SBV.pbAtLeast: Non-negative value required, received: " ++ show k+ | all isConcrete xs = literal $ sum (map (pbToInteger "pbAtLeast" 1) xs) >= fromIntegral k+ | True              = liftPB "pbAtLeast" (PB_AtLeast k) xs++-- | 'sTrue' if exactly @k@ of the input arguments are 'sTrue'+pbExactly :: [SBool] -> Int -> SBool+pbExactly xs k+ | k < 0             = error $ "SBV.pbExactly: Non-negative value required, received: " ++ show k+ | all isConcrete xs = literal $ sum (map (pbToInteger "pbExactly" 1) xs) == fromIntegral k+ | True              = liftPB "pbExactly" (PB_Exactly k) xs++-- | 'sTrue' if the sum of coefficients for 'sTrue' elements is at most @k@. Generalizes 'pbAtMost'.+pbLe :: [(Int, SBool)] -> Int -> SBool+pbLe xs k+ | k < 0                       = error $ "SBV.pbLe: Non-negative value required, received: " ++ show k+ | all isConcrete (map snd xs) = literal $ sum [pbToInteger "pbLe" c b | (c, b) <- xs] <= fromIntegral k+ | True                        = liftPB "pbLe" (PB_Le (map fst xs) k) (map snd xs)++-- | 'sTrue' if the sum of coefficients for 'sTrue' elements is at least @k@. Generalizes 'pbAtLeast'.+pbGe :: [(Int, SBool)] -> Int -> SBool+pbGe xs k+ | k < 0                       = error $ "SBV.pbGe: Non-negative value required, received: " ++ show k+ | all isConcrete (map snd xs) = literal $ sum [pbToInteger "pbGe" c b | (c, b) <- xs] >= fromIntegral k+ | True                        = liftPB "pbGe" (PB_Ge (map fst xs) k) (map snd 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 xs k+ | k < 0                       = error $ "SBV.pbEq: Non-negative value required, received: " ++ show k+ | all isConcrete (map snd xs) = literal $ sum [pbToInteger "pbEq" c b | (c, b) <- xs] == fromIntegral k+ | True                        = liftPB "pbEq" (PB_Eq (map fst xs) k) (map snd xs)++-- | 'sTrue' if there is at most one set bit+pbMutexed :: [SBool] -> SBool+pbMutexed xs = pbAtMost xs 1++-- | 'sTrue' if there is exactly one set bit+pbStronglyMutexed :: [SBool] -> SBool+pbStronglyMutexed xs = pbExactly xs 1++-- | Convert a concrete pseudo-boolean to given int; converting to integer+pbToInteger :: String -> Int -> SBool -> Integer+pbToInteger w c b+ | c < 0                 = error $ "SBV." ++ w ++ ": Non-negative coefficient required, received: " ++ show c+ | Just v <- unliteral b = if v then fromIntegral c else 0+ | True                  = error $ "SBV.pbToInteger: Received a symbolic boolean: " ++ show (c, b)++-- | Predicate for optimizing word operations like (+) and (*).+isConcreteZero :: SBV a -> Bool+isConcreteZero (SBV (SVal _     (Left (CV _     (CInteger n))))) = n == 0+isConcreteZero (SBV (SVal KReal (Left (CV KReal (CAlgReal v))))) = isExactRational v && v == 0+isConcreteZero _                                                 = False++-- | Predicate for optimizing word operations like (+) and (*).+isConcreteOne :: SBV a -> Bool+isConcreteOne (SBV (SVal _     (Left (CV _     (CInteger 1))))) = True+isConcreteOne (SBV (SVal KReal (Left (CV KReal (CAlgReal v))))) = isExactRational v && v == 1+isConcreteOne _                                                 = False++-- Num instance for symbolic words.+instance (Ord a, Num a, SymVal a) => Num (SBV a) where+  fromInteger = literal . fromIntegral+  SBV x + SBV y = SBV (svPlus x y)+  SBV x * SBV y = SBV (svTimes x y)+  SBV x - SBV y = SBV (svMinus x y)+  -- Abs is problematic for floating point, due to -0; case, so we carefully shuttle it down+  -- to the solver to avoid the can of worms. (Alternative would be to do an if-then-else here.)+  abs (SBV x) = SBV (svAbs x)+  signum a+    -- NB. The following "carefully" tests the number for == 0, as Float/Double's NaN and +/-0+    -- cases would cause trouble with explicit equality tests.+    | hasSign a = ite (a .> z) i+                $ ite (a .< z) (negate i) a+    | True      = ite (a .> z) i a+    where z = genLiteral (kindOf a) (0::Integer)+          i = genLiteral (kindOf a) (1::Integer)+  -- negate is tricky because on double/float -0 is different than 0; so we cannot+  -- just rely on the default definition; which would be 0-0, which is not -0!+  negate (SBV x) = SBV (svUNeg x)++-- | Symbolic exponentiation using bit blasting and repeated squaring.+--+-- N.B. The exponent must be unsigned/bounded if symbolic. Signed exponents will be rejected.+(.^) :: (Mergeable b, Num b, SIntegral e) => b -> SBV e -> b+b .^ e+  | isConcrete e, Just (x :: Integer) <- unliteral (sFromIntegral e)+  = if x >= 0 then let go n v+                        | n == 0 = 1+                        | even n =     go (n `div` 2) (v * v)+                        | True   = v * go (n `div` 2) (v * v)+                   in  go x b+              else error $ "(.^): exponentiation: negative exponent: " ++ show x+  | not (isBounded e) || isSigned e+  = error $ "(.^): exponentiation only works with unsigned bounded symbolic exponents, kind: " ++ show (kindOf e)+  | 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 expt = e+         expBit i = SBV (svTestBit expt i)+         blasted  = map expBit [0 .. intSizeOf e - 1]+     in product $ zipWith (\use n -> ite use n 1)+                          blasted+                          (iterate (\x -> x*x) b)++instance (SymVal a, Fractional a) => Fractional (SBV a) where+  fromRational  = literal . fromRational+  SBV x / sy@(SBV y) | div0 = ite (sy .== 0) 0 res+                     | True = res+       where res  = SBV (svDivide x y)+             -- Identify those kinds where we have a div-0 equals 0 exception+             div0 = case kindOf sy of+                      KFloat             -> False+                      KDouble            -> False+                      KReal              -> True+                      -- Following cases should not happen since these types should *not* be instances of Fractional+                      k@KBounded{}       -> error $ "Unexpected Fractional case for: " ++ show k+                      k@KUnbounded       -> error $ "Unexpected Fractional case for: " ++ show k+                      k@KBool            -> error $ "Unexpected Fractional case for: " ++ show k+                      k@KString          -> error $ "Unexpected Fractional case for: " ++ show k+                      k@KChar            -> error $ "Unexpected Fractional case for: " ++ show k+                      k@KList{}          -> error $ "Unexpected Fractional case for: " ++ show k+                      k@KUninterpreted{} -> error $ "Unexpected Fractional case for: " ++ show k+                      k@KTuple{}         -> error $ "Unexpected Fractional case for: " ++ show k++-- | Define Floating instance on SBV's; only for base types that are already floating; i.e., SFloat and SDouble+-- Note that most of the fields are "undefined" for symbolic values, we add methods as they are supported by SMTLib.+-- Currently, the only symbolicly available function in this class is sqrt.+instance (SymVal a, Fractional a, Floating a) => Floating (SBV a) where+    pi      = literal pi+    exp     = lift1FNS "exp"     exp+    log     = lift1FNS "log"     log+    sqrt    = lift1F   FP_Sqrt   sqrt+    sin     = lift1FNS "sin"     sin+    cos     = lift1FNS "cos"     cos+    tan     = lift1FNS "tan"     tan+    asin    = lift1FNS "asin"    asin+    acos    = lift1FNS "acos"    acos+    atan    = lift1FNS "atan"    atan+    sinh    = lift1FNS "sinh"    sinh+    cosh    = lift1FNS "cosh"    cosh+    tanh    = lift1FNS "tanh"    tanh+    asinh   = lift1FNS "asinh"   asinh+    acosh   = lift1FNS "acosh"   acosh+    atanh   = lift1FNS "atanh"   atanh+    (**)    = lift2FNS "**"      (**)+    logBase = lift2FNS "logBase" logBase++-- | Lift a 1 arg FP-op, using sRNE default+lift1F :: SymVal a => FPOp -> (a -> a) -> SBV a -> SBV a+lift1F w op a+  | Just v <- unliteral a+  = literal $ op v+  | True+  = SBV $ SVal k $ Right $ cache r+  where k    = kindOf a+        r st = do swa  <- sbvToSV st a+                  swm  <- sbvToSV st sRNE+                  newExpr st k (SBVApp (IEEEFP w) [swm, swa])++-- | Lift a float/double unary function, only over constants+lift1FNS :: (SymVal a, Floating a) => String -> (a -> a) -> SBV a -> SBV a+lift1FNS nm f sv+  | Just v <- unliteral sv = literal $ f v+  | True                   = error $ "SBV." ++ nm ++ ": not supported for symbolic values of type " ++ show (kindOf 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 nm f sv1 sv2+  | Just v1 <- unliteral sv1+  , Just v2 <- unliteral sv2 = literal $ f v1 v2+  | True                     = error $ "SBV." ++ nm ++ ": not supported for symbolic values of type " ++ show (kindOf sv1)++-- 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 (Num a, Bits a, SymVal a) => Bits (SBV a) where+  SBV x .&. SBV y    = SBV (svAnd x y)+  SBV x .|. SBV y    = SBV (svOr x y)+  SBV x `xor` SBV y  = SBV (svXOr x y)+  complement (SBV x) = SBV (svNot x)+  bitSize  x         = intSizeOf x+  bitSizeMaybe x     = Just $ intSizeOf x+  isSigned x         = hasSign x+  bit i              = 1 `shiftL` i+  setBit        x i  = x .|. genLiteral (kindOf x) (bit i :: Integer)+  clearBit      x i  = x .&. genLiteral (kindOf x) (complement (bit i) :: Integer)+  complementBit x i  = x `xor` genLiteral (kindOf x) (bit i :: Integer)+  shiftL  (SBV x) i  = SBV (svShl x i)+  shiftR  (SBV x) i  = SBV (svShr x i)+  rotateL (SBV x) i  = SBV (svRol x i)+  rotateR (SBV x) i  = SBV (svRor x i)+  -- NB. testBit is *not* implementable on non-concrete symbolic words+  x `testBit` i+    | SBV (SVal _ (Left (CV _ (CInteger n)))) <- x+    = testBit n i+    | True+    = error $ "SBV.testBit: Called on symbolic value: " ++ show x ++ ". Use sTestBit instead."+  -- NB. popCount is *not* implementable on non-concrete symbolic words+  popCount x+    | SBV (SVal _ (Left (CV (KBounded _ w) (CInteger n)))) <- x+    = popCount (n .&. (bit w - 1))+    | True+    = error $ "SBV.popCount: Called on symbolic value: " ++ show x ++ ". 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 x+  | isReal x+  = error "SBV.sFromIntegral: Called on a real value" -- can't really happen due to types, but being overcautious+  | Just v <- unliteral x+  = literal (fromIntegral v)+  | True+  = result+  where result = SBV (SVal kTo (Right (cache y)))+        kFrom  = kindOf x+        kTo    = kindOf (Proxy @b)+        y st   = do xsv <- sbvToSV st x+                    newExpr st kTo (SBVApp (KindCast kFrom kTo) [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 f (SBV a) (SBV b) = SBV $ f a 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 = liftViaSVal 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 = liftViaSVal 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 x i+  | isSigned i = error "sSignedShiftArithRight: shift amount should be unsigned"+  | isSigned x = ssa x i+  | True       = ite (msb x)+                     (complement (ssa (complement x) i))+                     (ssa x i)+  where ssa = liftViaSVal 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, SDivisible (SBV b)) => SBV a -> SBV b -> SBV a+sRotateLeft = liftViaSVal svRotateLeft++-- | 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, SDivisible (SBV b)) => SBV a -> SBV b -> SBV a+sRotateRight = liftViaSVal svRotateRight++-- Enum instance. These instances are suitable for use with concrete values,+-- and will be less useful for symbolic values around. Note that `fromEnum` requires+-- a concrete argument for obvious reasons. Other variants (succ, pred, [x..]) etc are similarly+-- limited. While symbolic variants can be defined for many of these, they will just diverge+-- as final sizes cannot be determined statically.+instance (Show a, Bounded a, Integral a, Num a, SymVal a) => Enum (SBV a) where+  succ x+    | v == (maxBound :: a) = error $ "Enum.succ{" ++ showType x ++ "}: tried to take `succ' of maxBound"+    | True                 = fromIntegral $ v + 1+    where v = enumCvt "succ" x+  pred x+    | v == (minBound :: a) = error $ "Enum.pred{" ++ showType x ++ "}: tried to take `pred' of minBound"+    | True                 = fromIntegral $ v - 1+    where v = enumCvt "pred" x+  toEnum x+    | xi < fromIntegral (minBound :: a) || xi > fromIntegral (maxBound :: a)+    = error $ "Enum.toEnum{" ++ showType r ++ "}: " ++ show x ++ " is out-of-bounds " ++ show (minBound :: a, maxBound :: a)+    | True+    = r+    where xi :: Integer+          xi = fromIntegral x+          r  :: SBV a+          r  = fromIntegral x+  fromEnum x+     | r < fromIntegral (minBound :: Int) || r > fromIntegral (maxBound :: Int)+     = error $ "Enum.fromEnum{" ++ showType x ++ "}:  value " ++ show r ++ " is outside of Int's bounds " ++ show (minBound :: Int, maxBound :: Int)+     | True+     = fromIntegral r+    where r :: Integer+          r = enumCvt "fromEnum" x+  enumFrom x = map fromIntegral [xi .. fromIntegral (maxBound :: a)]+     where xi :: Integer+           xi = enumCvt "enumFrom" x+  enumFromThen x y+     | yi >= xi  = map fromIntegral [xi, yi .. fromIntegral (maxBound :: a)]+     | True      = map fromIntegral [xi, yi .. fromIntegral (minBound :: a)]+       where xi, yi :: Integer+             xi = enumCvt "enumFromThen.x" x+             yi = enumCvt "enumFromThen.y" y+  enumFromThenTo x y z = map fromIntegral [xi, yi .. zi]+       where xi, yi, zi :: Integer+             xi = enumCvt "enumFromThenTo.x" x+             yi = enumCvt "enumFromThenTo.y" y+             zi = enumCvt "enumFromThenTo.z" z++-- | Helper function for use in enum operations+enumCvt :: (SymVal a, Integral a, Num b) => String -> SBV a -> b+enumCvt w x = case unliteral x of+                Nothing -> error $ "Enum." ++ w ++ "{" ++ showType x ++ "}: Called on symbolic value " ++ show x+                Just v  -> fromIntegral v++-- | The 'SDivisible' class captures the essence of division.+-- Unfortunately we cannot use Haskell's 'Integral' class since the 'Real'+-- and 'Enum' superclasses are not implementable for symbolic bit-vectors.+-- However, 'quotRem' and 'divMod' both make perfect sense, and the 'SDivisible' class captures+-- this operation. One issue is how division by 0 behaves. The verification+-- technology requires total functions, and there are several design choices+-- here. We follow Isabelle/HOL approach of assigning the value 0 for division+-- by 0. Therefore, we impose the following pair of laws:+--+-- @+--      x `sQuotRem` 0 = (0, x)+--      x `sDivMod`  0 = (0, x)+-- @+--+-- Note that our instances implement this law even when @x@ is @0@ itself.+--+-- NB. 'quot' truncates toward zero, while 'div' truncates toward negative infinity.+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 #-}++  x `sQuot` y = fst $ x `sQuotRem` y+  x `sRem`  y = snd $ x `sQuotRem` y+  x `sDiv`  y = fst $ x `sDivMod`  y+  x `sMod`  y = snd $ x `sDivMod`  y++instance SDivisible Word64 where+  sQuotRem x 0 = (0, x)+  sQuotRem x y = x `quotRem` y+  sDivMod  x 0 = (0, x)+  sDivMod  x y = x `divMod` y++instance SDivisible Int64 where+  sQuotRem x 0 = (0, x)+  sQuotRem x y = x `quotRem` y+  sDivMod  x 0 = (0, x)+  sDivMod  x y = x `divMod` y++instance SDivisible Word32 where+  sQuotRem x 0 = (0, x)+  sQuotRem x y = x `quotRem` y+  sDivMod  x 0 = (0, x)+  sDivMod  x y = x `divMod` y++instance SDivisible Int32 where+  sQuotRem x 0 = (0, x)+  sQuotRem x y = x `quotRem` y+  sDivMod  x 0 = (0, x)+  sDivMod  x y = x `divMod` y++instance SDivisible Word16 where+  sQuotRem x 0 = (0, x)+  sQuotRem x y = x `quotRem` y+  sDivMod  x 0 = (0, x)+  sDivMod  x y = x `divMod` y++instance SDivisible Int16 where+  sQuotRem x 0 = (0, x)+  sQuotRem x y = x `quotRem` y+  sDivMod  x 0 = (0, x)+  sDivMod  x y = x `divMod` y++instance SDivisible Word8 where+  sQuotRem x 0 = (0, x)+  sQuotRem x y = x `quotRem` y+  sDivMod  x 0 = (0, x)+  sDivMod  x y = x `divMod` y++instance SDivisible Int8 where+  sQuotRem x 0 = (0, x)+  sQuotRem x y = x `quotRem` y+  sDivMod  x 0 = (0, x)+  sDivMod  x y = x `divMod` y++instance SDivisible Integer where+  sQuotRem x 0 = (0, x)+  sQuotRem x y = x `quotRem` y+  sDivMod  x 0 = (0, x)+  sDivMod  x y = x `divMod` y++instance SDivisible CV where+  sQuotRem a b+    | CInteger x <- cvVal a, CInteger y <- cvVal b+    = let (r1, r2) = sQuotRem x y in (normCV a{ cvVal = CInteger r1 }, normCV b{ cvVal = CInteger r2 })+  sQuotRem a b = error $ "SBV.sQuotRem: impossible, unexpected args received: " ++ show (a, b)+  sDivMod a b+    | CInteger x <- cvVal a, CInteger y <- cvVal b+    = let (r1, r2) = sDivMod x y in (normCV a{ cvVal = CInteger r1 }, normCV b{ cvVal = CInteger r2 })+  sDivMod a b = error $ "SBV.sDivMod: impossible, unexpected args received: " ++ show (a, b)++instance SDivisible SWord64 where+  sQuotRem = liftQRem+  sDivMod  = liftDMod++instance SDivisible SInt64 where+  sQuotRem = liftQRem+  sDivMod  = liftDMod++instance SDivisible SWord32 where+  sQuotRem = liftQRem+  sDivMod  = liftDMod++instance SDivisible SInt32 where+  sQuotRem = liftQRem+  sDivMod  = liftDMod++instance SDivisible SWord16 where+  sQuotRem = liftQRem+  sDivMod  = liftDMod++instance SDivisible SInt16 where+  sQuotRem = liftQRem+  sDivMod  = liftDMod++instance SDivisible SWord8 where+  sQuotRem = liftQRem+  sDivMod  = liftDMod++instance SDivisible SInt8 where+  sQuotRem = liftQRem+  sDivMod  = liftDMod++-- | Lift 'quotRem' to symbolic words. Division by 0 is defined s.t. @x/0 = 0@; which+-- holds even when @x@ is @0@ itself.+liftQRem :: SymVal a => SBV a -> SBV a -> (SBV a, SBV a)+liftQRem x y+  | isConcreteZero x+  = (x, x)+  | isConcreteOne y+  = (x, 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)+--------------------------------}+  | True+  = ite (y .== z) (z, x) (qr x y)+  where qr (SBV (SVal sgnsz (Left a))) (SBV (SVal _ (Left b))) = let (q, r) = sQuotRem a b in (SBV (SVal sgnsz (Left q)), SBV (SVal sgnsz (Left r)))+        qr a@(SBV (SVal sgnsz _))      b                       = (SBV (SVal sgnsz (Right (cache (mk Quot)))), SBV (SVal sgnsz (Right (cache (mk Rem)))))+                where mk o st = do sw1 <- sbvToSV st a+                                   sw2 <- sbvToSV st b+                                   mkSymOp o st sgnsz sw1 sw2+        z = genLiteral (kindOf x) (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 :: (SymVal a, Num a, SDivisible (SBV a)) => SBV a -> SBV a -> (SBV a, SBV a)+liftDMod x y+  | isConcreteZero x+  = (x, x)+  | isConcreteOne y+  = (x, 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)+--------------------------------}+  | True+  = ite (y .== z) (z, x) $ ite (signum r .== negate (signum y)) (q-i, r+y) qr+ where qr@(q, r) = x `sQuotRem` y+       z = genLiteral (kindOf x) (0::Integer)+       i = genLiteral (kindOf x) (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 = liftDMod+  sQuotRem x y+    | not (isSymbolic x || isSymbolic y)+    = liftQRem x y+    | True+    = ite (y .== 0) (0, x) (qE+i, rE-i*y)+    where (qE, rE) = liftQRem x y   -- for integers, this is euclidean due to SMTLib semantics+          i = ite (x .>= 0 .|| rE .== 0) 0+            $ ite (y .>  0)              1 (-1)++-- Quickcheck interface+instance (SymVal a, Arbitrary a) => Arbitrary (SBV a) where+  arbitrary = literal `fmap` 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 :: (SymVal b, Num b) => [a] -> a -> SBV b -> a+   -- NB. Earlier implementation of select used the binary-search trick+   -- on the index to chop down the search space. While that is a good trick+   -- in general, it doesn't work for SBV since we do not have any notion of+   -- "concrete" subwords: If an index is symbolic, then all its bits are+   -- symbolic as well. So, the binary search only pays off only if the indexed+   -- list is really humongous, which is not very common in general. (Also,+   -- for the case when the list is bit-vectors, we use SMT tables anyhow.)+   select xs err ind+    | isReal   ind = bad "real"+    | isFloat  ind = bad "float"+    | isDouble ind = bad "double"+    | hasSign  ind = ite (ind .< 0) err (walk xs ind err)+    | True         =                     walk xs ind err+    where bad w = error $ "SBV.select: unsupported " ++ w ++ " valued select/index expression"+          walk []     _ acc = acc+          walk (e:es) i acc = walk es (i-1) (ite (i .== 0) e 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 = 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 t a b+  | Just r <- unliteral t = if r then a else b+  | True                  = symbolicMerge True t 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 t a b+  | Just r <- unliteral t = if r then a else b+  | True                  = symbolicMerge False t 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 cs msg cond x+   | Just mustHold <- unliteral cond+   = if mustHold+     then x+     else error $ show $ SafeResult ((locInfo . getCallStack) `fmap` cs, msg, Satisfiable defaultSMTCfg (SMTModel [] []))+   | True+   = SBV $ SVal k $ Right $ cache r+  where k     = kindOf x+        r st  = do xsv <- sbvToSV st x+                   let pc = getPathCondition 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 = pc .&& sNot cond+                   cnd <- sbvToSV st mustNeverHappen+                   addAssertion st cs msg cnd+                   return xsv++        locInfo ps = intercalate ",\n " (map loc ps)+          where loc (f, sl) = concat [srcLocFile sl, ":", show (srcLocStartLine sl), ":", show (srcLocStartCol sl), ":", 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 k force (SBV t) (SBV a) (SBV b) = SBV (svSymbolicMerge k force t a b)++instance SymVal a => Mergeable (SBV a) where+    symbolicMerge force t x y+    -- Carefully use the kindOf instance to avoid strictness issues.+       | force = symbolicMergeWithKind (kindOf x)          True  t x y+       | True  = symbolicMergeWithKind (kindOf (Proxy @a)) False t x y+    -- Custom version of select that translates to SMT-Lib tables at the base type of words+    select xs err ind+      | SBV (SVal _ (Left c)) <- ind = case cvVal c of+                                         CInteger i -> if i < 0 || i >= genericLength xs+                                                       then err+                                                       else xs `genericIndex` i+                                         _          -> error $ "SBV.select: unsupported " ++ show (kindOf ind) ++ " valued select/index expression"+    select xsOrig err ind = xs `seq` SBV (SVal kElt (Right (cache r)))+      where kInd = kindOf ind+            kElt = kindOf 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   = case kindOf ind of+                     KBounded False i -> genericTake ((2::Integer) ^ (fromIntegral i     :: Integer)) xsOrig+                     KBounded True  i -> genericTake ((2::Integer) ^ (fromIntegral (i-1) :: Integer)) xsOrig+                     KUnbounded       -> xsOrig+                     _                -> error $ "SBV.select: unsupported " ++ show (kindOf ind) ++ " valued select/index expression"+            r st  = do sws <- mapM (sbvToSV st) xs+                       swe <- sbvToSV st err+                       if all (== swe) sws  -- off-chance that all elts are the same. Note that this also correctly covers the case when list is empty.+                          then return swe+                          else do idx <- getTableIndex st kInd kElt sws+                                  swi <- sbvToSV st ind+                                  let len = length xs+                                  -- NB. No need to worry here that the index might be < 0; as the SMTLib translation takes care of that automatically+                                  newExpr st kElt (SBVApp (LkUp (idx, kInd, kElt, len) swi swe) [])++-- Unit+instance Mergeable () where+   symbolicMerge _ _ _ _ = ()+   select _ _ _ = ()++-- 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 f t xs ys+    | lxs == lys = zipWith (symbolicMerge f t) xs ys+    | True       = error $ "SBV.Mergeable.List: No least-upper-bound for lists of differing size " ++ show (lxs, lys)+    where (lxs, lys) = (length xs, length ys)++-- ZipList+instance Mergeable a => Mergeable (ZipList a) where+  symbolicMerge force test (ZipList xs) (ZipList ys)+    = ZipList (symbolicMerge force test xs ys)++-- Maybe+instance Mergeable a => Mergeable (Maybe a) where+  symbolicMerge _ _ Nothing  Nothing  = Nothing+  symbolicMerge f t (Just a) (Just b) = Just $ symbolicMerge f t a b+  symbolicMerge _ _ a b = error $ "SBV.Mergeable.Maybe: No least-upper-bound for " ++ show (k a, k b)+      where k Nothing = "Nothing"+            k _       = "Just"++-- Either+instance (Mergeable a, Mergeable b) => Mergeable (Either a b) where+  symbolicMerge f t (Left a)  (Left b)  = Left  $ symbolicMerge f t a b+  symbolicMerge f t (Right a) (Right b) = Right $ symbolicMerge f t a b+  symbolicMerge _ _ a b = error $ "SBV.Mergeable.Either: No least-upper-bound for " ++ show (k a, k b)+     where k (Left _)  = "Left"+           k (Right _) = "Right"++-- Arrays+instance (Ix a, Mergeable b) => Mergeable (Array a b) where+  symbolicMerge f t a b+    | ba == bb = listArray ba (zipWith (symbolicMerge f t) (elems a) (elems b))+    | True     = error $ "SBV.Mergeable.Array: No least-upper-bound for rangeSizes" ++ show (k ba, k bb)+    where [ba, bb] = map bounds [a, b]+          k = rangeSize++-- Functions+instance Mergeable b => Mergeable (a -> b) where+  symbolicMerge f t g h x = symbolicMerge f t (g x) (h 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 f t (i0, i1) (j0, j1) = (i i0 j0, i i1 j1)+    where i a b = symbolicMerge f t a b+  select xs (err1, err2) ind = (select as err1 ind, select bs err2 ind)+    where (as, bs) = unzip xs++-- 3-Tuple+instance (Mergeable a, Mergeable b, Mergeable c) => Mergeable (a, b, c) where+  symbolicMerge f t (i0, i1, i2) (j0, j1, j2) = (i i0 j0, i i1 j1, i i2 j2)+    where i a b = symbolicMerge f t a b+  select xs (err1, err2, err3) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind)+    where (as, bs, cs) = unzip3 xs++-- 4-Tuple+instance (Mergeable a, Mergeable b, Mergeable c, Mergeable d) => Mergeable (a, b, c, d) where+  symbolicMerge f t (i0, i1, i2, i3) (j0, j1, j2, j3) = (i i0 j0, i i1 j1, i i2 j2, i i3 j3)+    where i a b = symbolicMerge f t a b+  select xs (err1, err2, err3, err4) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind, select ds err4 ind)+    where (as, bs, cs, ds) = unzip4 xs++-- 5-Tuple+instance (Mergeable a, Mergeable b, Mergeable c, Mergeable d, Mergeable e) => Mergeable (a, b, c, d, e) where+  symbolicMerge f t (i0, i1, i2, i3, i4) (j0, j1, j2, j3, j4) = (i i0 j0, i i1 j1, i i2 j2, i i3 j3, i i4 j4)+    where i a b = symbolicMerge f t a b+  select xs (err1, err2, err3, err4, err5) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind, select ds err4 ind, select es err5 ind)+    where (as, bs, cs, ds, es) = unzip5 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 f t (i0, i1, i2, i3, i4, i5) (j0, j1, j2, j3, j4, j5) = (i i0 j0, i i1 j1, i i2 j2, i i3 j3, i i4 j4, i i5 j5)+    where i a b = symbolicMerge f t a b+  select xs (err1, err2, err3, err4, err5, err6) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind, select ds err4 ind, select es err5 ind, select fs err6 ind)+    where (as, bs, cs, ds, es, fs) = unzip6 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 f t (i0, i1, i2, i3, i4, i5, i6) (j0, j1, j2, j3, j4, j5, j6) = (i i0 j0, i i1 j1, i i2 j2, i i3 j3, i i4 j4, i i5 j5, i i6 j6)+    where i a b = symbolicMerge f t a b+  select xs (err1, err2, err3, err4, err5, err6, err7) ind = (select as err1 ind, select bs err2 ind, select cs err3 ind, select ds err4 ind, select es err5 ind, select fs err6 ind, select gs err7 ind)+    where (as, bs, cs, ds, es, fs, gs) = unzip7 xs++-- 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 force t x y = G.to $ symbolicMerge' force t (G.from x) (G.from y)++-- | Not exported. Used only in 'symbolicMergeDefault'. Instances are provided for+-- the generic representations of product types where each element is Mergeable.+class GMergeable f where+  symbolicMerge' :: Bool -> SBool -> f a -> f a -> f a++instance GMergeable U1 where+  symbolicMerge' _ _ _ _ = U1++instance (Mergeable c) => GMergeable (K1 i c) where+  symbolicMerge' force t (K1 x) (K1 y) = K1 $ symbolicMerge force t x y++instance (GMergeable f) => GMergeable (M1 i c f) where+  symbolicMerge' force t (M1 x) (M1 y) = M1 $ symbolicMerge' force t x y++instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where+  symbolicMerge' force t (x1 :*: y1) (x2 :*: y2) = symbolicMerge' force t x1 x2 :*: symbolicMerge' force t y1 y2++-- Bounded instances+instance (SymVal a, Bounded a) => Bounded (SBV a) where+  minBound = literal minBound+  maxBound = literal maxBound++-- Arrays++-- SArrays are both "EqSymbolic" and "Mergeable"+instance EqSymbolic (SArray a b) where+  SArray a .== SArray b = SBV (a `eqSArr` b)++-- When merging arrays; we'll ignore the force argument. This is arguably+-- the right thing to do as we've too many things and likely we want to keep it efficient.+instance SymVal b => Mergeable (SArray a b) where+  symbolicMerge _ = mergeArrays++-- When merging arrays; we'll ignore the force argument. This is arguably+-- the right thing to do as we've too many things and likely we want to keep it efficient.+instance SymVal b => Mergeable (SFunArray a b) where+  symbolicMerge _ = mergeArrays++-- | Uninterpreted constants and functions. An uninterpreted constant is+-- a value that is indexed by its name. The only property the prover assumes+-- about these values are that they are equivalent to themselves; i.e., (for+-- functions) they return the same results when applied to same arguments.+-- We support uninterpreted-functions as a general means of black-box'ing+-- operations that are /irrelevant/ for the purposes of the proof; i.e., when+-- the proofs can be performed without any knowledge about the function itself.+--+-- Minimal complete definition: 'sbvUninterpret'. However, most instances in+-- practice are already provided by SBV, so end-users should not need to define their+-- own instances.+class Uninterpreted a where+  -- | Uninterpret a value, receiving an object that can be used instead. Use this version+  -- when you do not need to add an axiom about this value.+  uninterpret :: String -> a+  -- | Uninterpret a value, only for the purposes of code-generation. For execution+  -- and verification the value is used as is. For code-generation, the alternate+  -- definition is used. This is useful when we want to take advantage of native+  -- libraries on the target languages.+  cgUninterpret :: String -> [String] -> a -> a+  -- | Most generalized form of uninterpretation, this function should not be needed+  -- by end-user-code, but is rather useful for the library development.+  sbvUninterpret :: Maybe ([String], a) -> String -> a++  {-# MINIMAL sbvUninterpret #-}++  -- defaults:+  uninterpret             = sbvUninterpret Nothing+  cgUninterpret nm code v = sbvUninterpret (Just (code, v)) nm++-- Plain constants+instance HasKind a => Uninterpreted (SBV a) where+  sbvUninterpret mbCgData nm+     | Just (_, v) <- mbCgData = v+     | True                    = SBV $ SVal ka $ Right $ cache result+    where ka = kindOf (Proxy @a)+          result st = do isSMT <- inSMTMode st+                         case (isSMT, mbCgData) of+                           (True, Just (_, v)) -> sbvToSV st v+                           _                   -> do newUninterpreted st nm (SBVType [ka]) (fst `fmap` mbCgData)+                                                     newExpr st ka $ SBVApp (Uninterpreted nm) []++-- Functions of one argument+instance (SymVal b, HasKind a) => Uninterpreted (SBV b -> SBV a) where+  sbvUninterpret mbCgData nm = f+    where f arg0+           | Just (_, v) <- mbCgData, isConcrete arg0+           = v arg0+           | True+           = SBV $ SVal ka $ Right $ cache result+           where ka = kindOf (Proxy @a)+                 kb = kindOf (Proxy @b)+                 result st = do isSMT <- inSMTMode st+                                case (isSMT, mbCgData) of+                                  (True, Just (_, v)) -> sbvToSV st (v arg0)+                                  _                   -> do newUninterpreted st nm (SBVType [kb, ka]) (fst `fmap` mbCgData)+                                                            sw0 <- sbvToSV st arg0+                                                            mapM_ forceSVArg [sw0]+                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0]++-- Functions of two arguments+instance (SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV c -> SBV b -> SBV a) where+  sbvUninterpret mbCgData nm = f+    where f arg0 arg1+           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1+           = v arg0 arg1+           | True+           = SBV $ SVal ka $ Right $ cache result+           where ka = kindOf (Proxy @a)+                 kb = kindOf (Proxy @b)+                 kc = kindOf (Proxy @c)+                 result st = do isSMT <- inSMTMode st+                                case (isSMT, mbCgData) of+                                  (True, Just (_, v)) -> sbvToSV st (v arg0 arg1)+                                  _                   -> do newUninterpreted st nm (SBVType [kc, kb, ka]) (fst `fmap` mbCgData)+                                                            sw0 <- sbvToSV st arg0+                                                            sw1 <- sbvToSV st arg1+                                                            mapM_ forceSVArg [sw0, sw1]+                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1]++-- Functions of three arguments+instance (SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV d -> SBV c -> SBV b -> SBV a) where+  sbvUninterpret mbCgData nm = f+    where f arg0 arg1 arg2+           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2+           = v arg0 arg1 arg2+           | True+           = SBV $ SVal ka $ Right $ cache result+           where ka = kindOf (Proxy @a)+                 kb = kindOf (Proxy @b)+                 kc = kindOf (Proxy @c)+                 kd = kindOf (Proxy @d)+                 result st = do isSMT <- inSMTMode st+                                case (isSMT, mbCgData) of+                                  (True, Just (_, v)) -> sbvToSV st (v arg0 arg1 arg2)+                                  _                   -> do newUninterpreted st nm (SBVType [kd, kc, kb, ka]) (fst `fmap` mbCgData)+                                                            sw0 <- sbvToSV st arg0+                                                            sw1 <- sbvToSV st arg1+                                                            sw2 <- sbvToSV st arg2+                                                            mapM_ forceSVArg [sw0, sw1, sw2]+                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2]++-- Functions of four arguments+instance (SymVal e, SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where+  sbvUninterpret mbCgData nm = f+    where f arg0 arg1 arg2 arg3+           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3+           = v arg0 arg1 arg2 arg3+           | True+           = SBV $ SVal ka $ Right $ cache result+           where ka = kindOf (Proxy @a)+                 kb = kindOf (Proxy @b)+                 kc = kindOf (Proxy @c)+                 kd = kindOf (Proxy @d)+                 ke = kindOf (Proxy @e)+                 result st = do isSMT <- inSMTMode st+                                case (isSMT, mbCgData) of+                                  (True, Just (_, v)) -> sbvToSV st (v arg0 arg1 arg2 arg3)+                                  _                   -> do newUninterpreted st nm (SBVType [ke, kd, kc, kb, ka]) (fst `fmap` mbCgData)+                                                            sw0 <- sbvToSV st arg0+                                                            sw1 <- sbvToSV st arg1+                                                            sw2 <- sbvToSV st arg2+                                                            sw3 <- sbvToSV st arg3+                                                            mapM_ forceSVArg [sw0, sw1, sw2, sw3]+                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3]++-- Functions of five arguments+instance (SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where+  sbvUninterpret mbCgData nm = f+    where f arg0 arg1 arg2 arg3 arg4+           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3, isConcrete arg4+           = v arg0 arg1 arg2 arg3 arg4+           | True+           = SBV $ SVal ka $ Right $ cache result+           where ka = kindOf (Proxy @a)+                 kb = kindOf (Proxy @b)+                 kc = kindOf (Proxy @c)+                 kd = kindOf (Proxy @d)+                 ke = kindOf (Proxy @e)+                 kf = kindOf (Proxy @f)+                 result st = do isSMT <- inSMTMode st+                                case (isSMT, mbCgData) of+                                  (True, Just (_, v)) -> sbvToSV st (v arg0 arg1 arg2 arg3 arg4)+                                  _                   -> do newUninterpreted st nm (SBVType [kf, ke, kd, kc, kb, ka]) (fst `fmap` mbCgData)+                                                            sw0 <- sbvToSV st arg0+                                                            sw1 <- sbvToSV st arg1+                                                            sw2 <- sbvToSV st arg2+                                                            sw3 <- sbvToSV st arg3+                                                            sw4 <- sbvToSV st arg4+                                                            mapM_ forceSVArg [sw0, sw1, sw2, sw3, sw4]+                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3, sw4]++-- Functions of six arguments+instance (SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where+  sbvUninterpret mbCgData nm = f+    where f arg0 arg1 arg2 arg3 arg4 arg5+           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3, isConcrete arg4, isConcrete arg5+           = v arg0 arg1 arg2 arg3 arg4 arg5+           | True+           = SBV $ SVal ka $ Right $ cache result+           where ka = kindOf (Proxy @a)+                 kb = kindOf (Proxy @b)+                 kc = kindOf (Proxy @c)+                 kd = kindOf (Proxy @d)+                 ke = kindOf (Proxy @e)+                 kf = kindOf (Proxy @f)+                 kg = kindOf (Proxy @g)+                 result st = do isSMT <- inSMTMode st+                                case (isSMT, mbCgData) of+                                  (True, Just (_, v)) -> sbvToSV st (v arg0 arg1 arg2 arg3 arg4 arg5)+                                  _                   -> do newUninterpreted st nm (SBVType [kg, kf, ke, kd, kc, kb, ka]) (fst `fmap` mbCgData)+                                                            sw0 <- sbvToSV st arg0+                                                            sw1 <- sbvToSV st arg1+                                                            sw2 <- sbvToSV st arg2+                                                            sw3 <- sbvToSV st arg3+                                                            sw4 <- sbvToSV st arg4+                                                            sw5 <- sbvToSV st arg5+                                                            mapM_ forceSVArg [sw0, sw1, sw2, sw3, sw4, sw5]+                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3, sw4, sw5]++-- Functions of seven arguments+instance (SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)+            => Uninterpreted (SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where+  sbvUninterpret mbCgData nm = f+    where f arg0 arg1 arg2 arg3 arg4 arg5 arg6+           | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3, isConcrete arg4, isConcrete arg5, isConcrete arg6+           = v arg0 arg1 arg2 arg3 arg4 arg5 arg6+           | True+           = SBV $ SVal ka $ Right $ cache result+           where ka = kindOf (Proxy @a)+                 kb = kindOf (Proxy @b)+                 kc = kindOf (Proxy @c)+                 kd = kindOf (Proxy @d)+                 ke = kindOf (Proxy @e)+                 kf = kindOf (Proxy @f)+                 kg = kindOf (Proxy @g)+                 kh = kindOf (Proxy @h)+                 result st = do isSMT <- inSMTMode st+                                case (isSMT, mbCgData) of+                                  (True, Just (_, v)) -> sbvToSV st (v arg0 arg1 arg2 arg3 arg4 arg5 arg6)+                                  _                   -> do newUninterpreted st nm (SBVType [kh, kg, kf, ke, kd, kc, kb, ka]) (fst `fmap` mbCgData)+                                                            sw0 <- sbvToSV st arg0+                                                            sw1 <- sbvToSV st arg1+                                                            sw2 <- sbvToSV st arg2+                                                            sw3 <- sbvToSV st arg3+                                                            sw4 <- sbvToSV st arg4+                                                            sw5 <- sbvToSV st arg5+                                                            sw6 <- sbvToSV st arg6+                                                            mapM_ forceSVArg [sw0, sw1, sw2, sw3, sw4, sw5, sw6]+                                                            newExpr st ka $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3, sw4, sw5, sw6]++-- Uncurried functions of two arguments+instance (SymVal c, SymVal b, HasKind a) => Uninterpreted ((SBV c, SBV b) -> SBV a) where+  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc2 `fmap` mbCgData) nm in uncurry f+    where uc2 (cs, fn) = (cs, curry fn)++-- Uncurried functions of three arguments+instance (SymVal d, SymVal c, SymVal b, HasKind a) => Uninterpreted ((SBV d, SBV c, SBV b) -> SBV a) where+  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc3 `fmap` mbCgData) nm in \(arg0, arg1, arg2) -> f arg0 arg1 arg2+    where uc3 (cs, fn) = (cs, \a b c -> fn (a, b, c))++-- Uncurried functions of four arguments+instance (SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)+            => Uninterpreted ((SBV e, SBV d, SBV c, SBV b) -> SBV a) where+  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc4 `fmap` mbCgData) nm in \(arg0, arg1, arg2, arg3) -> f arg0 arg1 arg2 arg3+    where uc4 (cs, fn) = (cs, \a b c d -> fn (a, b, c, d))++-- Uncurried functions of five arguments+instance (SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)+            => Uninterpreted ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where+  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc5 `fmap` mbCgData) nm in \(arg0, arg1, arg2, arg3, arg4) -> f arg0 arg1 arg2 arg3 arg4+    where uc5 (cs, fn) = (cs, \a b c d e -> fn (a, b, c, d, e))++-- Uncurried functions of six arguments+instance (SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)+            => Uninterpreted ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where+  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc6 `fmap` mbCgData) nm in \(arg0, arg1, arg2, arg3, arg4, arg5) -> f arg0 arg1 arg2 arg3 arg4 arg5+    where uc6 (cs, fn) = (cs, \a b c d e f -> fn (a, b, c, d, e, f))++-- Uncurried functions of seven arguments+instance (SymVal h, SymVal g, SymVal f, SymVal e, SymVal d, SymVal c, SymVal b, HasKind a)+            => Uninterpreted ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where+  sbvUninterpret mbCgData nm = let f = sbvUninterpret (uc7 `fmap` mbCgData) nm in \(arg0, arg1, arg2, arg3, arg4, arg5, arg6) -> f arg0 arg1 arg2 arg3 arg4 arg5 arg6+    where uc7 (cs, fn) = (cs, \a b c d e f g -> fn (a, b, c, d, e, f, g))++-- | Symbolic computations provide a context for writing symbolic programs.+instance MonadIO m => SolverContext (SymbolicT m) where+   constrain                   (SBV c) = imposeConstraint False []               c+   softConstrain               (SBV c) = imposeConstraint True  []               c+   namedConstraint        nm   (SBV c) = imposeConstraint False [(":named", nm)] c+   constrainWithAttribute atts (SBV c) = imposeConstraint False atts             c++   setOption o = addNewSMTOption  o++-- | Generalization of 'Data.SBV.assertWithPenalty'+assertWithPenalty :: MonadSymbolic m => String -> SBool -> Penalty -> m ()+assertWithPenalty nm o p = addSValOptGoal $ unSBV `fmap` AssertWithPenalty nm o p++-- | Class of metrics we can optimize for. Currently,+-- bounded signed/unsigned bit-vectors, unbounded integers,+-- and algebraic reals can be optimized. (But not, say, SFloat, SDouble, or SBool.)+-- Minimal complete definition: minimize/maximize.+--+-- 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>.+class Metric a where+  -- | Generalization of 'Data.SBV.minimize'+  minimize :: MonadSymbolic m => String -> a -> m ()++  -- | Generalization of 'Data.SBV.maximize'+  maximize :: MonadSymbolic m => String -> a -> m ()++  {-# MINIMAL minimize, maximize #-}++instance Metric SWord8   where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)+instance Metric SWord16  where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)+instance Metric SWord32  where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)+instance Metric SWord64  where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)+instance Metric SInt8    where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)+instance Metric SInt16   where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)+instance Metric SInt32   where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)+instance Metric SInt64   where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)+instance Metric SInteger where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)+instance Metric SReal    where minimize nm o = addSValOptGoal (unSBV `fmap` Minimize nm o); maximize nm o = addSValOptGoal (unSBV `fmap` Maximize nm o)++-- Quickcheck interface on symbolic-booleans..+instance Testable SBool where+  property (SBV (SVal _ (Left b))) = property (cvToBool b)+  property _                       = error "Quick-check: Constant folding produced a symbolic value! Perhaps used a non-reducible expression? Please report!"++instance Testable (Symbolic SBool) where+   property prop = QC.monadicIO $ do (cond, r, modelVals) <- QC.run test+                                     QC.pre cond+                                     unless (r || null modelVals) $ QC.monitor (QC.counterexample (complain modelVals))+                                     QC.assert r+     where test = do (r, Result{resTraces=tvals, resObservables=ovals, resConsts=cs, resConstraints=cstrs, resUIConsts=unints}) <- runSymbolic Concrete prop++                     let cval = fromMaybe (error "Cannot quick-check in the presence of uninterpeted constants!") . (`lookup` cs)+                         cond = and [cvToBool (cval v) | (False, _, v) <- cstrs] -- Only pick-up "hard" constraints, as indicated by False in the fist component++                         getObservable (nm, f, v) = case v `lookup` cs of+                                                      Just cv -> if f cv then Just (nm, cv) else Nothing+                                                      Nothing -> error $ "Quick-check: Observable " ++ nm ++ " did not reduce to a constant!"++                     case map fst unints of+                       [] -> case unliteral r of+                               Nothing -> noQC [show r]+                               Just b  -> return (cond, b, tvals ++ mapMaybe getObservable ovals)+                       us -> noQC us++           complain qcInfo = showModel defaultSMTCfg (SMTModel [] qcInfo)++           noQC us         = error $ "Cannot quick-check in the presence of uninterpreted constants: " ++ intercalate ", " us++-- | 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 prop = QC.isSuccess `fmap` QC.quickCheckResult prop++-- Quickcheck interface on dynamically-typed values. A run-time check+-- ensures that the value has boolean type.+instance Testable (Symbolic SVal) where+  property m = property $ do s <- m+                             when (kindOf s /= KBool) $ error "Cannot quickcheck non-boolean value"+                             return (SBV s :: SBool)++-- | Explicit sharing combinator. The SBV library has internal caching/hash-consing mechanisms+-- built in, based on Andy Gill's type-safe obervable 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 x f = SBV $ SVal k $ Right $ cache r+    where k    = kindOf (Proxy @b)+          r st = do xsv <- sbvToSV st x+                    let xsbv = SBV $ SVal (kindOf x) (Right (cache (const (return xsv))))+                        res  = f xsbv+                    sbvToSV st res++-- | Equality as a proof method. Allows for+-- very concise construction of equivalence proofs, which is very typical in+-- bit-precise proofs.+infix 4 ===+class Equality a where+  (===) :: a -> a -> IO ThmResult++instance {-# OVERLAPPABLE #-} (SymVal a, EqSymbolic z) => Equality (SBV a -> z) where+  k === l = prove $ \a -> k a .== l a++instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, EqSymbolic z) => Equality (SBV a -> SBV b -> z) where+  k === l = prove $ \a b -> k a b .== l a b++instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, EqSymbolic z) => Equality ((SBV a, SBV b) -> z) where+  k === l = prove $ \a b -> k (a, b) .== l (a, b)++instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> z) where+  k === l = prove $ \a b c -> k a b c .== l a b c++instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c) -> z) where+  k === l = prove $ \a b c -> k (a, b, c) .== l (a, b, c)++instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, EqSymbolic z) => Equality (SBV a -> SBV b -> SBV c -> SBV d -> z) where+  k === l = prove $ \a b c d -> k a b c d .== l a b c d++instance {-# OVERLAPPABLE #-} (SymVal a, SymVal b, SymVal c, SymVal d, EqSymbolic z) => Equality ((SBV a, SBV b, SBV c, SBV d) -> z) where+  k === l = prove $ \a b c d -> k (a, b, c, d) .== l (a, b, c, 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+  k === l = prove $ \a b c d e -> k a b c d e .== l a b c d 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+  k === l = prove $ \a b c d e -> k (a, b, c, d, e) .== l (a, b, c, d, 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+  k === l = prove $ \a b c d e f -> k a b c d e f .== l a b c d e 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+  k === l = prove $ \a b c d e f -> k (a, b, c, d, e, f) .== l (a, b, c, d, e, 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+  k === l = prove $ \a b c d e f g -> k a b c d e f g .== l a b c d e f 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+  k === l = prove $ \a b c d e f g -> k (a, b, c, d, e, f, g) .== l (a, b, c, d, e, f, g)  {-# ANN module   ("HLint: ignore Reduce duplication" :: String) #-} {-# ANN module   ("HLint: ignore Eta reduce" :: String)         #-}
Data/SBV/Core/Operations.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Core.Operations--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Core.Operations+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Constructors and basic operations on symbolic values -----------------------------------------------------------------------------@@ -65,11 +65,11 @@  -- | Boolean True. svTrue :: SVal-svTrue = SVal KBool (Left trueCW)+svTrue = SVal KBool (Left trueCV)  -- | Boolean False. svFalse :: SVal-svFalse = SVal KBool (Left falseCW)+svFalse = SVal KBool (Left falseCV)  -- | Convert from a Boolean. svBool :: Bool -> SVal@@ -77,50 +77,50 @@  -- | Convert from an Integer. svInteger :: Kind -> Integer -> SVal-svInteger k n = SVal k (Left $! mkConstCW k n)+svInteger k n = SVal k (Left $! mkConstCV k n)  -- | Convert from a Float svFloat :: Float -> SVal-svFloat f = SVal KFloat (Left $! CW KFloat (CWFloat f))+svFloat f = SVal KFloat (Left $! CV KFloat (CFloat f))  -- | Convert from a Float svDouble :: Double -> SVal-svDouble d = SVal KDouble (Left $! CW KDouble (CWDouble d))+svDouble d = SVal KDouble (Left $! CV KDouble (CDouble d))  -- | Convert from a String svString :: String -> SVal-svString s = SVal KString (Left $! CW KString (CWString s))+svString s = SVal KString (Left $! CV KString (CString s))  -- | Convert from a Char svChar :: Char -> SVal-svChar c = SVal KChar (Left $! CW KChar (CWChar c))+svChar c = SVal KChar (Left $! CV KChar (CChar c))  -- | Convert from a Rational svReal :: Rational -> SVal-svReal d = SVal KReal (Left $! CW KReal (CWAlgReal (fromRational d)))+svReal d = SVal KReal (Left $! CV KReal (CAlgReal (fromRational d)))  -------------------------------------------------------------------------------- -- Basic destructors  -- | Extract a bool, by properly interpreting the integer stored. svAsBool :: SVal -> Maybe Bool-svAsBool (SVal _ (Left cw)) = Just (cwToBool cw)+svAsBool (SVal _ (Left cv)) = Just (cvToBool cv) svAsBool _                  = Nothing  -- | Extract an integer from a concrete value. svAsInteger :: SVal -> Maybe Integer-svAsInteger (SVal _ (Left (CW _ (CWInteger n)))) = Just n-svAsInteger _                                    = Nothing+svAsInteger (SVal _ (Left (CV _ (CInteger n)))) = Just n+svAsInteger _                                   = Nothing  -- | Grab the numerator of an SReal, if available svNumerator :: SVal -> Maybe Integer-svNumerator (SVal KReal (Left (CW KReal (CWAlgReal (AlgRational True r))))) = Just $ numerator r-svNumerator _                                                               = Nothing+svNumerator (SVal KReal (Left (CV KReal (CAlgReal (AlgRational True r))))) = Just $ numerator r+svNumerator _                                                              = Nothing  -- | Grab the denominator of an SReal, if available svDenominator :: SVal -> Maybe Integer-svDenominator (SVal KReal (Left (CW KReal (CWAlgReal (AlgRational True r))))) = Just $ denominator r-svDenominator _                                                               = Nothing+svDenominator (SVal KReal (Left (CV KReal (CAlgReal (AlgRational True r))))) = Just $ denominator r+svDenominator _                                                              = Nothing  ------------------------------------------------------------------------------------- -- | Constructing [x, y, .. z] and [x .. y]. Only works when all arguments are concrete and integral and the result is guaranteed finite@@ -269,50 +269,50 @@ svQuotRem x y = (x `svQuot` y, x `svRem` y)  -- | Optimize away x == true and x /= false to x; otherwise just do eqOpt-eqOptBool :: Op -> SW -> SW -> SW -> Maybe SW+eqOptBool :: Op -> SV -> SV -> SV -> Maybe SV eqOptBool op w x y-  | k == KBool && op == Equal    && x == trueSW  = Just y         -- true  .== y     --> y-  | k == KBool && op == Equal    && y == trueSW  = Just x         -- x     .== true  --> x-  | k == KBool && op == NotEqual && x == falseSW = Just y         -- false ./= y     --> y-  | k == KBool && op == NotEqual && y == falseSW = Just x         -- x     ./= false --> x+  | k == KBool && op == Equal    && x == trueSV  = Just y         -- true  .== y     --> y+  | k == KBool && op == Equal    && y == trueSV  = Just x         -- x     .== true  --> x+  | k == KBool && op == NotEqual && x == falseSV = Just y         -- false ./= y     --> y+  | k == KBool && op == NotEqual && y == falseSV = Just x         -- x     ./= false --> x   | True                                         = eqOpt w x y    -- fallback   where k = swKind x  -- | Equality. svEqual :: SVal -> SVal -> SVal-svEqual = liftSym2B (mkSymOpSC (eqOptBool Equal trueSW) Equal) rationalCheck (==) (==) (==) (==) (==) (==) (==) (==)+svEqual = liftSym2B (mkSymOpSC (eqOptBool Equal trueSV) Equal) rationalCheck (==) (==) (==) (==) (==) (==) (==) (==) (==)  -- | Inequality. svNotEqual :: SVal -> SVal -> SVal-svNotEqual = liftSym2B (mkSymOpSC (eqOptBool NotEqual falseSW) NotEqual) rationalCheck (/=) (/=) (/=) (/=) (/=) (/=) (/=) (/=)+svNotEqual = liftSym2B (mkSymOpSC (eqOptBool NotEqual falseSV) NotEqual) rationalCheck (/=) (/=) (/=) (/=) (/=) (/=) (/=) (/=) (/=)  -- | Less than. svLessThan :: SVal -> SVal -> SVal svLessThan x y   | isConcreteMax x = svFalse   | isConcreteMin y = svFalse-  | True            = liftSym2B (mkSymOpSC (eqOpt falseSW) LessThan) rationalCheck (<) (<) (<) (<) (<) (<) (<) (uiLift "<" (<)) x y+  | True            = liftSym2B (mkSymOpSC (eqOpt falseSV) LessThan) rationalCheck (<) (<) (<) (<) (<) (<) (<) (<) (uiLift "<" (<)) x y  -- | Greater than. svGreaterThan :: SVal -> SVal -> SVal svGreaterThan x y   | isConcreteMin x = svFalse   | isConcreteMax y = svFalse-  | True            = liftSym2B (mkSymOpSC (eqOpt falseSW) GreaterThan) rationalCheck (>) (>) (>) (>) (>) (>) (>) (uiLift ">"  (>)) x y+  | True            = liftSym2B (mkSymOpSC (eqOpt falseSV) GreaterThan) rationalCheck (>) (>) (>) (>) (>) (>) (>) (>) (uiLift ">"  (>)) x y  -- | Less than or equal to. svLessEq :: SVal -> SVal -> SVal svLessEq x y   | isConcreteMin x = svTrue   | isConcreteMax y = svTrue-  | True            = liftSym2B (mkSymOpSC (eqOpt trueSW) LessEq) rationalCheck (<=) (<=) (<=) (<=) (<=) (<=) (<=) (uiLift "<=" (<=)) x y+  | True            = liftSym2B (mkSymOpSC (eqOpt trueSV) LessEq) rationalCheck (<=) (<=) (<=) (<=) (<=) (<=) (<=) (<=) (uiLift "<=" (<=)) x y  -- | Greater than or equal to. svGreaterEq :: SVal -> SVal -> SVal svGreaterEq x y   | isConcreteMax x = svTrue   | isConcreteMin y = svTrue-  | True            = liftSym2B (mkSymOpSC (eqOpt trueSW) GreaterEq) rationalCheck (>=) (>=) (>=) (>=) (>=) (>=) (>=) (uiLift ">=" (>=)) x y+  | True            = liftSym2B (mkSymOpSC (eqOpt trueSV) GreaterEq) rationalCheck (>=) (>=) (>=) (>=) (>=) (>=) (>=) (>=) (uiLift ">=" (>=)) x y  -- | Bitwise and. svAnd :: SVal -> SVal -> SVal@@ -323,9 +323,9 @@   | isConcreteOnes y = x   | True             = liftSym2 (mkSymOpSC opt And) (const (const True)) (noReal ".&.") (.&.) (noFloat ".&.") (noDouble ".&.") x y   where opt a b-          | a == falseSW || b == falseSW = Just falseSW-          | a == trueSW                  = Just b-          | b == trueSW                  = Just a+          | a == falseSV || b == falseSV = Just falseSV+          | a == trueSV                  = Just b+          | b == trueSV                  = Just a           | True                         = Nothing  -- | Bitwise or.@@ -338,9 +338,9 @@   | True             = liftSym2 (mkSymOpSC opt Or) (const (const True))                        (noReal ".|.") (.|.) (noFloat ".|.") (noDouble ".|.") x y   where opt a b-          | a == trueSW || b == trueSW = Just trueSW-          | a == falseSW               = Just b-          | b == falseSW               = Just a+          | a == trueSV || b == trueSV = Just trueSV+          | a == falseSV               = Just b+          | b == falseSV               = Just a           | True                       = Nothing  -- | Bitwise xor.@@ -353,9 +353,9 @@   | True             = liftSym2 (mkSymOpSC opt XOr) (const (const True))                        (noReal "xor") xor (noFloat "xor") (noDouble "xor") x y   where opt a b-          | a == b && swKind a == KBool = Just falseSW-          | a == falseSW                = Just b-          | b == falseSW                = Just a+          | a == b && swKind a == KBool = Just falseSV+          | a == falseSV                = Just b+          | b == falseSV                = Just a           | True                        = Nothing  -- | Bitwise complement.@@ -364,8 +364,8 @@                  (noRealUnary "complement") complement                  (noFloatUnary "complement") (noDoubleUnary "complement")   where opt a-          | a == falseSW = Just trueSW-          | a == trueSW  = Just falseSW+          | a == falseSV = Just trueSV+          | a == trueSV  = Just falseSV           | True         = Nothing  -- | Shift left by a constant amount. Translates to the "bvshl"@@ -435,14 +435,14 @@ svExtract :: Int -> Int -> SVal -> SVal svExtract i j x@(SVal (KBounded s _) _)   | i < j-  = SVal k (Left $! CW k (CWInteger 0))-  | SVal _ (Left (CW _ (CWInteger v))) <- x-  = SVal k (Left $! normCW (CW k (CWInteger (v `shiftR` j))))+  = SVal k (Left $! CV k (CInteger 0))+  | SVal _ (Left (CV _ (CInteger v))) <- x+  = SVal k (Left $! normCV (CV k (CInteger (v `shiftR` j))))   | True   = SVal k (Right (cache y))   where k = KBounded s (i - j + 1)-        y st = do sw <- svToSW st x-                  newExpr st k (SBVApp (Extract i j) [sw])+        y st = do sv <- svToSV st x+                  newExpr st k (SBVApp (Extract i j) [sv]) svExtract _ _ _ = error "extract: non-bitvector type"  -- | Join two words, by concataneting@@ -450,14 +450,14 @@ svJoin x@(SVal (KBounded s i) a) y@(SVal (KBounded _ j) b)   | i == 0 = y   | j == 0 = x-  | Left (CW _ (CWInteger m)) <- a, Left (CW _ (CWInteger n)) <- b-  = SVal k (Left $! CW k (CWInteger (m `shiftL` j .|. n)))+  | Left (CV _ (CInteger m)) <- a, Left (CV _ (CInteger n)) <- b+  = SVal k (Left $! CV k (CInteger (m `shiftL` j .|. n)))   | True   = SVal k (Right (cache z))   where     k = KBounded s (i + j)-    z st = do xsw <- svToSW st x-              ysw <- svToSW st y+    z st = do xsw <- svToSV st x+              ysw <- svToSV st y               newExpr st k (SBVApp Join [xsw, ysw]) svJoin _ _ = error "svJoin: non-bitvector type" @@ -482,10 +482,10 @@   where sameResult (SVal _ (Left c1)) (SVal _ (Left c2)) = c1 == c2         sameResult _                  _                  = False -        c st = do swt <- svToSW st t+        c st = do swt <- svToSV st t                   case () of-                    () | swt == trueSW  -> svToSW st a       -- these two cases should never be needed as we expect symbolicMerge to be-                    () | swt == falseSW -> svToSW st b       -- called with symbolic tests, but just in case..+                    () | swt == trueSV  -> svToSV st a       -- these two cases should never be needed as we expect symbolicMerge to be+                    () | swt == falseSV -> svToSV st b       -- called with symbolic tests, but just in case..                     () -> do {- It is tempting to record the choice of the test expression here as we branch down to the 'then' and 'else' branches. That is,                                 when we evaluate 'a', we can make use of the fact that the test expression is True, and similarly we can use the fact that it                                 is False when b is evaluated. In certain cases this can cut down on symbolic simulation significantly, for instance if@@ -543,12 +543,20 @@                              -}                              let sta = st `extendSValPathCondition` svAnd t                              let stb = st `extendSValPathCondition` svAnd (svNot t)-                             swa <- svToSW sta a -- evaluate 'then' branch-                             swb <- svToSW stb b -- evaluate 'else' branch-                             case () of               -- merge:-                               () | swa == swb                      -> return swa-                               () | swa == trueSW && swb == falseSW -> return swt-                               () | swa == falseSW && swb == trueSW -> newExpr st k (SBVApp Not [swt])+                             swa <- svToSV sta a -- evaluate 'then' branch+                             swb <- svToSV stb b -- evaluate 'else' branch++                             -- merge, but simplify for certain boolean cases:+                             case () of+                               () | swa == swb                      -> return swa                                     -- if t then a      else a     ==> a+                               () | swa == trueSV && swb == falseSV -> return swt                                     -- if t then true   else false ==> t+                               () | swa == falseSV && swb == trueSV -> newExpr st k (SBVApp Not [swt])                -- if t then false  else true  ==> not t+                               () | swa == trueSV                   -> newExpr st k (SBVApp Or  [swt, swb])           -- if t then true   else b     ==> t OR b+                               () | swa == falseSV                  -> do swt' <- newExpr st KBool (SBVApp Not [swt])+                                                                          newExpr st k (SBVApp And [swt', swb])       -- if t then false  else b     ==> t' AND b+                               () | swb == trueSV                   -> do swt' <- newExpr st KBool (SBVApp Not [swt])+                                                                          newExpr st k (SBVApp Or [swt', swa])        -- if t then a      else true  ==> t' OR a+                               () | swb == falseSV                  -> newExpr st k (SBVApp And [swt, swa])           -- if t then a      else false ==> t AND a                                ()                                   -> newExpr st k (SBVApp Ite [swt, swa, swb])  -- | Total indexing operation. @svSelect xs default index@ is@@ -557,11 +565,11 @@ svSelect :: [SVal] -> SVal -> SVal -> SVal svSelect xs err ind   | SVal _ (Left c) <- ind =-    case cwVal c of-      CWInteger i -> if i < 0 || i >= genericLength xs-                     then err-                     else xs `genericIndex` i-      _           -> error $ "SBV.select: unsupported " ++ show (kindOf ind) ++ " valued select/index expression"+    case cvVal c of+      CInteger i -> if i < 0 || i >= genericLength xs+                    then err+                    else xs `genericIndex` i+      _          -> error $ "SBV.select: unsupported " ++ show (kindOf ind) ++ " valued select/index expression" svSelect xsOrig err ind = xs `seq` SVal kElt (Right (cache r))   where     kInd = kindOf ind@@ -574,12 +582,12 @@            KBounded True  i -> genericTake ((2::Integer) ^ (i-1)) xsOrig            KUnbounded       -> xsOrig            _                -> error $ "SBV.select: unsupported " ++ show kInd ++ " valued select/index expression"-    r st = do sws <- mapM (svToSW st) xs-              swe <- svToSW st err+    r st = do sws <- mapM (svToSV st) xs+              swe <- svToSV st err               if all (== swe) sws  -- off-chance that all elts are the same                  then return swe                  else do idx <- getTableIndex st kInd kElt sws-                         swi <- svToSW st ind+                         swi <- svToSV st ind                          let len = length xs                          -- NB. No need to worry here that the index                          -- might be < 0; as the SMTLib translation@@ -592,7 +600,7 @@   | True                    = SVal k (Right (cache y))   where     k = KBounded s (intSizeOf x)-    y st = do xsw <- svToSW st x+    y st = do xsw <- svToSV st x               newExpr st k (SBVApp (Extract (intSizeOf x - 1) 0) [xsw])  -- | Convert a symbolic bitvector from unsigned to signed.@@ -612,7 +620,7 @@   = result   where result = SVal kTo (Right (cache y))         kFrom  = kindOf x-        y st   = do xsw <- svToSW st x+        y st   = do xsw <- svToSV st x                     newExpr st kTo (SBVApp (KindCast kFrom kTo) [xsw])  --------------------------------------------------------------------------------@@ -682,7 +690,7 @@           = Just x            | Just xv <- getConst x, Just iv <- getConst i-          = Just $ SVal kx . Left $! normCW $ CW kx (CWInteger (xv `opC` shiftAmount iv))+          = Just $ SVal kx . Left $! normCV $ CV kx (CInteger (xv `opC` shiftAmount iv))            | isInteger x || isInteger i           = bailOut $ "Not yet implemented unbounded/non-constants shifts for " ++ show (kx, ki) ++ ", please file a request!"@@ -695,8 +703,8 @@            where bailOut m = error $ "SBV." ++ nm ++ ": " ++ m -                getConst (SVal _ (Left (CW _ (CWInteger val)))) = Just val-                getConst _                                      = Nothing+                getConst (SVal _ (Left (CV _ (CInteger val)))) = Just val+                getConst _                                     = Nothing                  opC | toLeft = shiftL                     | True   = shiftR@@ -738,8 +746,8 @@         -- Regular shift, we know that the shift value fits into the bit-width of x, since it's between 0 and sizeOf x. So, we can just         -- turn it into a properly sized argument and ship it to SMTLib         regularShiftValue = SVal kx $ Right $ cache result-           where result st = do sw1 <- svToSW st x-                                sw2 <- svToSW st i+           where result st = do sw1 <- svToSV st x+                                sw2 <- svToSV st i                                  let op | toLeft = Shl                                        | True   = Shr@@ -794,8 +802,8 @@ -- | Overflow detection. svMkOverflow :: OvOp -> SVal -> SVal -> SVal svMkOverflow o x y = SVal KBool (Right (cache r))-    where r st = do sx <- svToSW st x-                    sy <- svToSW st y+    where r st = do sx <- svToSV st x+                    sy <- svToSV st y                     newExpr st KBool $ SBVApp (OverflowOp o) [sx, sy]  ---------------------------------------------------------------------------------@@ -809,15 +817,15 @@ readSArr :: SArr -> SVal -> SVal readSArr (SArr (_, bk) f) a = SVal bk $ Right $ cache r   where r st = do arr <- uncacheAI f st-                  i   <- svToSW st a+                  i   <- svToSV st a                   newExpr st bk (SBVApp (ArrRead arr) [i])  -- | Update the element at @a@ to be @b@ writeSArr :: SArr -> SVal -> SVal -> SArr writeSArr (SArr ainfo f) a b = SArr ainfo $ cache g   where g st = do arr  <- uncacheAI f st-                  addr <- svToSW st a-                  val  <- svToSW st b+                  addr <- svToSV st a+                  val  <- svToSV st b                   amap <- R.readIORef (rArrayMap st)                    let j   = ArrayIndex $ IMap.size amap@@ -833,7 +841,7 @@ mergeSArr t (SArr ainfo a) (SArr _ b) = SArr ainfo $ cache h   where h st = do ai <- uncacheAI a st                   bi <- uncacheAI b st-                  ts <- svToSW st t+                  ts <- svToSV st t                   amap <- R.readIORef (rArrayMap st)                    let k   = ArrayIndex $ IMap.size amap@@ -849,7 +857,7 @@      mbSWDef <- case mbDef of                  Nothing -> return Nothing-                 Just sv -> Just <$> svToSW st sv+                 Just sv -> Just <$> svToSV st sv      let i   = ArrayIndex $ IMap.size amap         nm  = mkNm (unArrayIndex i)@@ -872,26 +880,26 @@  -- | Convert a node-id to an SVal nodeIdToSVal :: Kind -> Int -> SVal-nodeIdToSVal k i = swToSVal $ SW k (NodeId i)+nodeIdToSVal k i = swToSVal $ SV k (NodeId i) --- | Convert an SW to an SVal-swToSVal :: SW -> SVal-swToSVal sw@(SW k _) = SVal k $ Right $ cache $ const $ return sw+-- | Convert an 'SV' to an 'SVal'+swToSVal :: SV -> SVal+swToSVal sv@(SV k _) = SVal k $ Right $ cache $ const $ return sv  -- | A variant of SVal equality, but taking into account of constants -- NB. The rationalCheck is paranid perhaps, but is necessary in case -- we have some funky polynomial roots in there. We do allow for--- floating-points here though. Why? Because the Eq instance of CW+-- floating-points here though. Why? Because the Eq instance of 'CV' -- does the right thing by using object equality. (i.e., it does -- the right thing for NaN/+0/-0 etc.) A straightforward equality -- here would be wrong for floats!-svEqualWithConsts :: (SVal, Maybe CW) -> (SVal, Maybe CW) -> SVal-svEqualWithConsts sv1 sv2 = case (grabCW sv1, grabCW sv2) of-                               (Just cw, Just cw') | rationalCheck cw cw' -> if cw == cw' then svTrue else svFalse+svEqualWithConsts :: (SVal, Maybe CV) -> (SVal, Maybe CV) -> SVal+svEqualWithConsts sv1 sv2 = case (grabCV sv1, grabCV sv2) of+                               (Just cv, Just cv') | rationalCheck cv cv' -> if cv == cv' then svTrue else svFalse                                _                                          -> fst sv1 `svEqual` fst sv2-  where grabCW (_,                Just cw) = Just cw-        grabCW (SVal _ (Left cw), _      ) = Just cw-        grabCW _                           = Nothing+  where grabCV (_,                Just cv) = Just cv+        grabCV (SVal _ (Left cv), _      ) = Just cv+        grabCV _                           = Nothing  -- | Read the array element at @a@. For efficiency purposes, we create a memo-table -- as we go along, as otherwise we suffer significant performance penalties. See:@@ -907,13 +915,13 @@                   fArrMap     <- R.readIORef (rFArrayMap st)                    constMap <- R.readIORef (rconstMap st)-                  let consts = Map.fromList [(i, cw) | (cw, SW _ (NodeId i)) <- Map.toList constMap]+                  let consts = Map.fromList [(i, cv) | (cv, SV _ (NodeId i)) <- Map.toList constMap]                    case unFArrayIndex fArrayIndex `IMap.lookup` fArrMap of                     Nothing -> error $ "Data.SBV.readSFunArr: Impossible happened while trying to access SFunArray, can't find index: " ++ show fArrayIndex                     Just (uninitializedRead, rCache) -> do                         memoTable  <- R.readIORef rCache-                        SW _ (NodeId addressNodeId) <- svToSW st address+                        SV _ (NodeId addressNodeId) <- svToSV st address                          -- If we hit the cache, return the result right away. If we miss, we need to                         -- walk through each element to "merge" all possible reads as we do not know@@ -925,13 +933,13 @@                           Nothing -> -- cache miss; walk down the cache items to form the chain of reads:                                      do let aInfo = (address, addressNodeId `Map.lookup` consts) -                                            find :: [(Int, SW)] -> SVal+                                            find :: [(Int, SV)] -> SVal                                             find []             = uninitializedRead address                                             find ((i, v) : ivs) = svIte (svEqualWithConsts (nodeIdToSVal ak i, i `Map.lookup` consts) aInfo) (swToSVal v) (find ivs)                                              finalValue = find (IMap.toAscList memoTable) -                                        finalSW <- svToSW st finalValue+                                        finalSW <- svToSV st finalValue                                          -- Cache the result, so next time we can retrieve it faster if we look it up with the same address!                                         -- The following line is really the whole point of having caching in SFunArray!@@ -952,15 +960,15 @@                   fArrMap     <- R.readIORef (rFArrayMap st)                   constMap    <- R.readIORef (rconstMap st) -                  let consts = Map.fromList [(i, cw) | (cw, SW _ (NodeId i)) <- Map.toList constMap]+                  let consts = Map.fromList [(i, cv) | (cv, SV _ (NodeId i)) <- Map.toList constMap]                    case unFArrayIndex fArrayIndex `IMap.lookup` fArrMap of                     Nothing          -> error $ "Data.SBV.writeSFunArr: Impossible happened while trying to access SFunArray, can't find index: " ++ show fArrayIndex                      Just (aUi, rCache) -> do                        memoTable <- R.readIORef rCache-                       SW _ (NodeId addressNodeId) <- svToSW st address-                       val              <- svToSW st b+                       SV _ (NodeId addressNodeId) <- svToSV st address+                       val                         <- svToSV st b                         -- There are three cases:                        --@@ -982,14 +990,14 @@                                              -- NB. The order of modifications here is important as we                                             -- keep the keys in ascending order. (Since we'll call fromAscList later on.)-                                            walk :: [(Int, SW)] -> [(Int, SW)] -> IO [(Int, SW)]+                                            walk :: [(Int, SV)] -> [(Int, SV)] -> IO [(Int, SV)]                                             walk []           sofar = return $ reverse sofar                                             walk ((i, s):iss) sofar = modify i s >>= \s' -> walk iss ((i, s') : sofar)                                              -- At the cached address i, currently storing value s. Conditionally update it to `b` (new value)                                             -- if the addresses match. Otherwise keep it the same.-                                            modify :: Int -> SW -> IO SW-                                            modify i s = svToSW st $ svIte (svEqualWithConsts (nodeIdToSVal ak i, i `Map.lookup` consts) aInfo) b (swToSVal s)+                                            modify :: Int -> SV -> IO SV+                                            modify i s = svToSV st $ svIte (svEqualWithConsts (nodeIdToSVal ak i, i `Map.lookup` consts) aInfo) b (swToSVal s)                                          Right . IMap.fromAscList <$> walk (IMap.toAscList memoTable) [] @@ -1023,7 +1031,7 @@                   bi <- uncacheFAI b st                    constMap <- R.readIORef (rconstMap st)-                  let consts = Map.fromList [(i, cw) | (cw, SW _ (NodeId i)) <- Map.toList constMap]+                  let consts = Map.fromList [(i, cv) | (cv, SV _ (NodeId i)) <- Map.toList constMap]                    -- Catch the degenerate case of merging an array with itself. One                   -- can argue this is pointless, but actually it comes up when one@@ -1051,21 +1059,21 @@                                        bMemoT = IMap.toAscList bMemo                                         -- gen takes a uninitialized-read creator, a key, and the choices from the "other"-                                       -- cache that this key may map to. And creates a new SW that corresponds to the+                                       -- cache that this key may map to. And creates a new SV that corresponds to the                                        -- merged value:-                                       gen :: (SVal -> SVal) -> Int -> [(Int, SW)] -> IO SW-                                       gen mk k choices = svToSW st $ walk choices+                                       gen :: (SVal -> SVal) -> Int -> [(Int, SV)] -> IO SV+                                       gen mk k choices = svToSV st $ walk choices                                          where kInfo = (nodeIdToSVal sourceKind k, k `Map.lookup` consts) -                                               walk :: [(Int, SW)] -> SVal+                                               walk :: [(Int, SV)] -> SVal                                                walk []             = mk (fst kInfo)                                                walk ((i, v) : ivs) = svIte (svEqualWithConsts (nodeIdToSVal sourceKind i, i `Map.lookup` consts) kInfo)                                                                            (swToSVal v)                                                                            (walk ivs)                                         -- Insert into an existing map the new key value by merging according to the test-                                       fill :: Int -> SW -> SW -> IMap.IntMap SW -> IO (IMap.IntMap SW)-                                       fill k (SW _ (NodeId ni1)) (SW _ (NodeId ni2)) m = do v <- svToSW st (svIte t sval1 sval2)+                                       fill :: Int -> SV -> SV -> IMap.IntMap SV -> IO (IMap.IntMap SV)+                                       fill k (SV _ (NodeId ni1)) (SV _ (NodeId ni2)) m = do v <- svToSV st (svIte t sval1 sval2)                                                                                              return $ IMap.insert k v m                                          where sval1 = nodeIdToSVal targetKind ni1                                                sval2 = nodeIdToSVal targetKind ni2@@ -1136,11 +1144,11 @@ noStringLift2 :: String -> String -> a noStringLift2 x y = error $ "Unexpected binary operation called on strings: " ++ show (x, y) -liftSym1 :: (State -> Kind -> SW -> IO SW) -> (AlgReal -> AlgReal) -> (Integer -> Integer) -> (Float -> Float) -> (Double -> Double) -> SVal -> SVal-liftSym1 _   opCR opCI opCF opCD   (SVal k (Left a)) = SVal k . Left  $! mapCW opCR opCI opCF opCD noCharLift noStringLift noUnint a+liftSym1 :: (State -> Kind -> SV -> IO SV) -> (AlgReal -> AlgReal) -> (Integer -> Integer) -> (Float -> Float) -> (Double -> Double) -> SVal -> SVal+liftSym1 _   opCR opCI opCF opCD   (SVal k (Left a)) = SVal k . Left  $! mapCV opCR opCI opCF opCD noCharLift noStringLift noUnint a liftSym1 opS _    _    _    _    a@(SVal k _)        = SVal k $ Right $ cache c-   where c st = do swa <- svToSW st a-                   opS st k swa+   where c st = do sva <- svToSV st a+                   opS st k sva  {- A note on constant folding. @@ -1158,23 +1166,23 @@     (define-fun s3 () Bool (bvult s1 s2))  But clearly we have all the info for s3 to be computed! The issue here is that the reduction of @x .== x@ to @true@-happens after we start computing the if-then-else, hence we are already committed to an SW at that point. The call-to ite eventually recognizes this, but at that point it picks up the now constants from SW's, missing the constant+happens after we start computing the if-then-else, hence we are already committed to an SV at that point. The call+to ite eventually recognizes this, but at that point it picks up the now constants from SV's, missing the constant folding opportunity. -We can fix this, by looking up the constants table in liftSW2, like this:+We can fix this, by looking up the constants table in liftSV2, along the lines of:  -    liftSW2 :: (CW -> CW -> Bool) -> (CW -> CW -> CW) -> (State -> Kind -> SW -> SW -> IO SW) -> Kind -> SVal -> SVal -> Cached SW-    liftSW2 okCW opCW opS k a b = cache c-      where c st = do sw1 <- svToSW st a-                      sw2 <- svToSW st b+    liftSV2 :: (CV -> CV -> Bool) -> (CV -> CV -> CV) -> (State -> Kind -> SV -> SV -> IO SV) -> Kind -> SVal -> SVal -> Cached SV+    liftSV2 okCV opCV opS k a b = cache c+      where c st = do sw1 <- svToSV st a+                      sw2 <- svToSV st b                       cmap <- readIORef (rconstMap st)-                      let cw1  = [cw | ((_, cw), sw) <- M.toList cmap, sw == sw1]-                          cw2  = [cw | ((_, cw), sw) <- M.toList cmap, sw == sw2]-                      case (cw1, cw2) of-                        ([x], [y]) | okCW x y -> newConst st $ opCW x y-                        _                     -> opS st k sw1 sw2+                      let cv1  = [cv | ((_, cv), sv) <- M.toList cmap, sv == sv1]+                          cv2  = [cv | ((_, cv), sv) <- M.toList cmap, sv == sv2]+                      case (cv1, cv2) of+                        ([x], [y]) | okCV x y -> newConst st $ opCV x y+                        _                     -> opS st k sv1 sv2  (with obvious modifications to call sites to get the proper arguments.) @@ -1188,39 +1196,39 @@  See http://github.com/LeventErkok/sbv/issues/379 for some further discussion. -}-liftSW2 :: (State -> Kind -> SW -> SW -> IO SW) -> Kind -> SVal -> SVal -> Cached SW-liftSW2 opS k a b = cache c-  where c st = do sw1 <- svToSW st a-                  sw2 <- svToSW st b+liftSV2 :: (State -> Kind -> SV -> SV -> IO SV) -> Kind -> SVal -> SVal -> Cached SV+liftSV2 opS k a b = cache c+  where c st = do sw1 <- svToSV st a+                  sw2 <- svToSV st b                   opS st k sw1 sw2 -liftSym2 :: (State -> Kind -> SW -> SW -> IO SW) -> (CW -> CW -> Bool) -> (AlgReal -> AlgReal -> AlgReal) -> (Integer -> Integer -> Integer) -> (Float -> Float -> Float) -> (Double -> Double -> Double) -> SVal -> SVal -> SVal-liftSym2 _   okCW opCR opCI opCF opCD   (SVal k (Left a)) (SVal _ (Left b)) | okCW a b = SVal k . Left  $! mapCW2 opCR opCI opCF opCD noCharLift2 noStringLift2 noUnint2 a b-liftSym2 opS _    _    _    _    _    a@(SVal k _)        b                            = SVal k $ Right $  liftSW2 opS k a b+liftSym2 :: (State -> Kind -> SV -> SV -> IO SV) -> (CV -> CV -> Bool) -> (AlgReal -> AlgReal -> AlgReal) -> (Integer -> Integer -> Integer) -> (Float -> Float -> Float) -> (Double -> Double -> Double) -> SVal -> SVal -> SVal+liftSym2 _   okCV opCR opCI opCF opCD   (SVal k (Left a)) (SVal _ (Left b)) | okCV a b = SVal k . Left  $! mapCV2 opCR opCI opCF opCD noCharLift2 noStringLift2 noUnint2 a b+liftSym2 opS _    _    _    _    _    a@(SVal k _)        b                            = SVal k $ Right $  liftSV2 opS k a b -liftSym2B :: (State -> Kind -> SW -> SW -> IO SW) -> (CW -> CW -> Bool) -> (AlgReal -> AlgReal -> Bool) -> (Integer -> Integer -> Bool) -> (Float -> Float -> Bool) -> (Double -> Double -> Bool) -> (Char -> Char -> Bool) -> (String -> String -> Bool) -> ([CWVal] -> [CWVal] -> Bool) -> ((Maybe Int, String) -> (Maybe Int, String) -> Bool) -> SVal -> SVal -> SVal-liftSym2B _   okCW opCR opCI opCF opCD opCC opCS opCSeq opUI (SVal _ (Left a)) (SVal _ (Left b)) | okCW a b = svBool (liftCW2 opCR opCI opCF opCD opCC opCS opCSeq opUI a b)-liftSym2B opS _    _    _    _    _    _    _    _      _    a                 b                            = SVal KBool $ Right $ liftSW2 opS KBool a b+liftSym2B :: (State -> Kind -> SV -> SV -> IO SV) -> (CV -> CV -> Bool) -> (AlgReal -> AlgReal -> Bool) -> (Integer -> Integer -> Bool) -> (Float -> Float -> Bool) -> (Double -> Double -> Bool) -> (Char -> Char -> Bool) -> (String -> String -> Bool) -> ([CVal] -> [CVal] -> Bool) -> ([CVal] -> [CVal] -> Bool) -> ((Maybe Int, String) -> (Maybe Int, String) -> Bool) -> SVal -> SVal -> SVal+liftSym2B _   okCV opCR opCI opCF opCD opCC opCS opCSeq opCTup opUI (SVal _ (Left a)) (SVal _ (Left b)) | okCV a b = svBool (liftCV2 opCR opCI opCF opCD opCC opCS opCSeq opCTup opUI a b)+liftSym2B opS _    _    _    _    _    _    _    _      _      _    a                 b                            = SVal KBool $ Right $ liftSV2 opS KBool a b  -- | Create a symbolic two argument operation; with shortcut optimizations-mkSymOpSC :: (SW -> SW -> Maybe SW) -> Op -> State -> Kind -> SW -> SW -> IO SW+mkSymOpSC :: (SV -> SV -> Maybe SV) -> Op -> State -> Kind -> SV -> SV -> IO SV mkSymOpSC shortCut op st k a b = maybe (newExpr st k (SBVApp op [a, b])) return (shortCut a b)  -- | Create a symbolic two argument operation; no shortcut optimizations-mkSymOp :: Op -> State -> Kind -> SW -> SW -> IO SW+mkSymOp :: Op -> State -> Kind -> SV -> SV -> IO SV mkSymOp = mkSymOpSC (const (const Nothing)) -mkSymOp1SC :: (SW -> Maybe SW) -> Op -> State -> Kind -> SW -> IO SW+mkSymOp1SC :: (SV -> Maybe SV) -> Op -> State -> Kind -> SV -> IO SV mkSymOp1SC shortCut op st k a = maybe (newExpr st k (SBVApp op [a])) return (shortCut a) -mkSymOp1 :: Op -> State -> Kind -> SW -> IO SW+mkSymOp1 :: Op -> State -> Kind -> SV -> IO SV mkSymOp1 = mkSymOp1SC (const Nothing) --- | eqOpt says the references are to the same SW, thus we can optimize. Note that+-- | eqOpt says the references are to the same SV, thus we can optimize. Note that -- we explicitly disallow KFloat/KDouble here. Why? Because it's *NOT* true that -- NaN == NaN, NaN >= NaN, and so-forth. So, we have to make sure we don't optimize -- floats and doubles, in case the argument turns out to be NaN.-eqOpt :: SW -> SW -> SW -> Maybe SW+eqOpt :: SV -> SV -> SV -> Maybe SV eqOpt w x y = case swKind x of                 KFloat  -> Nothing                 KDouble -> Nothing@@ -1237,52 +1245,52 @@ -- 0 * x = 0 fails if x happens to be NaN or +/- Infinity. So, -- we merely return False when given a floating-point value here. isConcreteZero :: SVal -> Bool-isConcreteZero (SVal _     (Left (CW _     (CWInteger n)))) = n == 0-isConcreteZero (SVal KReal (Left (CW KReal (CWAlgReal v)))) = isExactRational v && v == 0-isConcreteZero _                                            = False+isConcreteZero (SVal _     (Left (CV _     (CInteger n)))) = n == 0+isConcreteZero (SVal KReal (Left (CV KReal (CAlgReal v)))) = isExactRational v && v == 0+isConcreteZero _                                           = False  -- | Predicate for optimizing word operations like (+) and (*). -- NB. See comment on 'isConcreteZero' for why we don't match -- for Float/Double values here. isConcreteOne :: SVal -> Bool-isConcreteOne (SVal _     (Left (CW _     (CWInteger 1)))) = True-isConcreteOne (SVal KReal (Left (CW KReal (CWAlgReal v)))) = isExactRational v && v == 1-isConcreteOne _                                            = False+isConcreteOne (SVal _     (Left (CV _     (CInteger 1)))) = True+isConcreteOne (SVal KReal (Left (CV KReal (CAlgReal v)))) = isExactRational v && v == 1+isConcreteOne _                                           = False  -- | Predicate for optimizing bitwise operations. The unbounded integer case of checking -- against -1 might look dubious, but that's how Haskell treats 'Integer' as a member -- of the Bits class, try @(-1 :: Integer) `testBit` i@ for any @i@ and you'll get 'True'. isConcreteOnes :: SVal -> Bool-isConcreteOnes (SVal _ (Left (CW (KBounded b w) (CWInteger n)))) = n == if b then -1 else bit w - 1-isConcreteOnes (SVal _ (Left (CW KUnbounded     (CWInteger n)))) = n == -1  -- see comment above-isConcreteOnes (SVal _ (Left (CW KBool          (CWInteger n)))) = n == 1-isConcreteOnes _                                                 = False+isConcreteOnes (SVal _ (Left (CV (KBounded b w) (CInteger n)))) = n == if b then -1 else bit w - 1+isConcreteOnes (SVal _ (Left (CV KUnbounded     (CInteger n)))) = n == -1  -- see comment above+isConcreteOnes (SVal _ (Left (CV KBool          (CInteger n)))) = n == 1+isConcreteOnes _                                                = False  -- | Predicate for optimizing comparisons. isConcreteMax :: SVal -> Bool-isConcreteMax (SVal _ (Left (CW (KBounded False w) (CWInteger n)))) = n == bit w - 1-isConcreteMax (SVal _ (Left (CW (KBounded True  w) (CWInteger n)))) = n == bit (w - 1) - 1-isConcreteMax (SVal _ (Left (CW KBool              (CWInteger n)))) = n == 1-isConcreteMax _                                                     = False+isConcreteMax (SVal _ (Left (CV (KBounded False w) (CInteger n)))) = n == bit w - 1+isConcreteMax (SVal _ (Left (CV (KBounded True  w) (CInteger n)))) = n == bit (w - 1) - 1+isConcreteMax (SVal _ (Left (CV KBool              (CInteger n)))) = n == 1+isConcreteMax _                                                    = False  -- | Predicate for optimizing comparisons. isConcreteMin :: SVal -> Bool-isConcreteMin (SVal _ (Left (CW (KBounded False _) (CWInteger n)))) = n == 0-isConcreteMin (SVal _ (Left (CW (KBounded True  w) (CWInteger n)))) = n == - bit (w - 1)-isConcreteMin (SVal _ (Left (CW KBool              (CWInteger n)))) = n == 0-isConcreteMin _                                                     = False+isConcreteMin (SVal _ (Left (CV (KBounded False _) (CInteger n)))) = n == 0+isConcreteMin (SVal _ (Left (CV (KBounded True  w) (CInteger n)))) = n == - bit (w - 1)+isConcreteMin (SVal _ (Left (CV KBool              (CInteger n)))) = n == 0+isConcreteMin _                                                    = False  -- | Most operations on concrete rationals require a compatibility check to avoid faulting -- on algebraic reals.-rationalCheck :: CW -> CW -> Bool-rationalCheck a b = case (cwVal a, cwVal b) of-                     (CWAlgReal x, CWAlgReal y) -> isExactRational x && isExactRational y-                     _                          -> True+rationalCheck :: CV -> CV -> Bool+rationalCheck a b = case (cvVal a, cvVal b) of+                     (CAlgReal x, CAlgReal y) -> isExactRational x && isExactRational y+                     _                        -> True  -- | Quot/Rem operations require a nonzero check on the divisor. ---nonzeroCheck :: CW -> CW -> Bool-nonzeroCheck _ b = cwVal b /= CWInteger 0+nonzeroCheck :: CV -> CV -> Bool+nonzeroCheck _ b = cvVal b /= CInteger 0  -- | Same as rationalCheck, except for SBV's rationalSBVCheck :: SVal -> SVal -> Bool
Data/SBV/Core/Splittable.hs view
@@ -1,18 +1,18 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Core.Splittable--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Core.Splittable+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Implementation of bit-vector concatanetation and splits ----------------------------------------------------------------------------- -{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE FlexibleInstances      #-} {-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-} {-# LANGUAGE TypeSynonymInstances   #-}-{-# LANGUAGE FlexibleInstances      #-}  module Data.SBV.Core.Splittable (Splittable(..)) where @@ -28,12 +28,12 @@ -- Intuitively, @a@ is a larger bit-size word than @b@, typically double. -- The 'extend' operation captures embedding of a @b@ value into an @a@ -- without changing its semantic value.------ Minimal complete definition: All, no defaults. class Splittable a b | b -> a where   split  :: a -> (b, b)   (#)    :: b -> b -> a   extend :: b -> a++  {-# MINIMAL split, (#), extend #-}  genSplit :: (Integral a, Num b) => Int -> a -> (b, b) genSplit ss x = (fromIntegral ((ix `shiftR` ss) .&. mask), fromIntegral (ix .&. mask))
Data/SBV/Core/Symbolic.hs view
@@ -1,32 +1,37 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Core.Symbolic--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Core.Symbolic+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Symbolic values ----------------------------------------------------------------------------- -{-# LANGUAGE    CPP                        #-}-{-# LANGUAGE    DeriveDataTypeable         #-}-{-# LANGUAGE    DeriveFunctor              #-}-{-# LANGUAGE    FlexibleInstances          #-}-{-# LANGUAGE    GeneralizedNewtypeDeriving #-}-{-# LANGUAGE    MultiParamTypeClasses      #-}-{-# LANGUAGE    NamedFieldPuns             #-}-{-# LANGUAGE    PatternGuards              #-}-{-# LANGUAGE    Rank2Types                 #-}-{-# LANGUAGE    ScopedTypeVariables        #-}-{-# LANGUAGE    TupleSections              #-}-{-# LANGUAGE    TypeOperators              #-}-{-# LANGUAGE    TypeSynonymInstances       #-}-{-# OPTIONS_GHC -fno-warn-orphans          #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DefaultSignatures          #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FunctionalDependencies     #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses      #-}+{-# LANGUAGE NamedFieldPuns             #-}+{-# LANGUAGE PatternGuards              #-}+{-# LANGUAGE Rank2Types                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE TupleSections              #-}+{-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE TypeSynonymInstances       #-}+{-# LANGUAGE UndecidableInstances       #-} -- for undetermined s in MonadState +{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Data.SBV.Core.Symbolic   ( NodeId(..)-  , SW(..), swKind, trueSW, falseSW+  , SV(..), swKind, trueSV, falseSV   , Op(..), PBOp(..), OvOp(..), FPOp(..), StrOp(..), SeqOp(..), RegExp(..)   , Quantifier(..), needsExistentials   , RoundingMode(..)@@ -34,14 +39,14 @@   , SVal(..)   , svMkSymVar, sWordN, sWordN_, sIntN, sIntN_   , ArrayContext(..), ArrayInfo-  , svToSW, svToSymSW, forceSWArg+  , svToSV, svToSymSV, forceSVArg   , SBVExpr(..), newExpr, isCodeGenMode, isSafetyCheckingIStage, isRunIStage, isSetupIStage   , Cached, cache, uncache, modifyState, modifyIncState   , ArrayIndex(..), FArrayIndex(..), uncacheAI, uncacheFAI   , NamedSymVar   , getSValPathCondition, extendSValPathCondition   , getTableIndex-  , SBVPgm(..), Symbolic, runSymbolic, State(..), withNewIncState, IncState(..), incrementInternalCounter+  , SBVPgm(..), MonadSymbolic(..), SymbolicT, Symbolic, runSymbolic, State(..), withNewIncState, IncState(..), incrementInternalCounter   , inSMTMode, SBVRunMode(..), IStage(..), Result(..)   , registerKind, registerLabel, recordObservable   , addAssertion, addNewSMTOption, imposeConstraint, internalConstraint, internalVariable@@ -49,34 +54,42 @@   , SolverCapabilities(..)   , extractSymbolicSimulationState   , OptimizeStyle(..), Objective(..), Penalty(..), objectiveName, addSValOptGoal-  , Query(..), QueryState(..), QueryContext(..)+  , MonadQuery(..), QueryT(..), Query, Queriable(..), QueryState(..), QueryContext(..)   , SMTScript(..), Solver(..), SMTSolver(..), SMTResult(..), SMTModel(..), SMTConfig(..), SMTEngine   , outputSVal   ) where -import Control.Arrow            (first, second, (***))-import Control.DeepSeq          (NFData(..))-import Control.Monad            (when, unless)-import Control.Monad.Reader     (MonadReader, ReaderT, ask, runReaderT)-import Control.Monad.State.Lazy (MonadState, StateT(..))-import Control.Monad.Trans      (MonadIO, liftIO)-import Data.Char                (isAlpha, isAlphaNum, toLower)-import Data.IORef               (IORef, newIORef, readIORef)-import Data.List                (intercalate, sortBy)-import Data.Maybe               (isJust, fromJust, fromMaybe, listToMaybe)-import Data.String              (IsString(fromString))+import Control.Arrow               (first, second, (***))+import Control.DeepSeq             (NFData(..))+import Control.Monad               (when, unless)+import Control.Monad.Except        (MonadError, ExceptT)+import Control.Monad.Reader        (MonadReader(..), ReaderT, runReaderT,+                                    mapReaderT)+import Control.Monad.State.Lazy    (MonadState)+import Control.Monad.Trans         (MonadIO(liftIO), MonadTrans(lift))+import Control.Monad.Trans.Maybe   (MaybeT)+import Control.Monad.Writer.Strict (MonadWriter)+import Data.Char                   (isAlpha, isAlphaNum, toLower)+import Data.IORef                  (IORef, newIORef, readIORef)+import Data.List                   (intercalate, sortBy)+import Data.Maybe                  (isJust, fromJust, fromMaybe, listToMaybe)+import Data.String                 (IsString(fromString))  import Data.Time (getCurrentTime, UTCTime)  import GHC.Stack -import qualified Data.IORef         as R    (modifyIORef')-import qualified Data.Generics      as G    (Data(..))-import qualified Data.IntMap.Strict as IMap (IntMap, empty, toAscList, lookup, insertWith)-import qualified Data.Map.Strict    as Map  (Map, empty, toList, lookup, insert, size)-import qualified Data.Set           as Set  (Set, empty, toList, insert, member)-import qualified Data.Foldable      as F    (toList)-import qualified Data.Sequence      as S    (Seq, empty, (|>))+import qualified Control.Monad.State.Lazy    as LS+import qualified Control.Monad.State.Strict  as SS+import qualified Control.Monad.Writer.Lazy   as LW+import qualified Control.Monad.Writer.Strict as SW+import qualified Data.IORef                  as R    (modifyIORef')+import qualified Data.Generics               as G    (Data(..))+import qualified Data.IntMap.Strict          as IMap (IntMap, empty, toAscList, lookup, insertWith)+import qualified Data.Map.Strict             as Map  (Map, empty, toList, lookup, insert, size)+import qualified Data.Set                    as Set  (Set, empty, toList, insert, member)+import qualified Data.Foldable               as F    (toList)+import qualified Data.Sequence               as S    (Seq, empty, (|>))  import System.Mem.StableName @@ -96,33 +109,34 @@ newtype NodeId = NodeId Int deriving (Eq, Ord)  -- | A symbolic word, tracking it's signedness and size.-data SW = SW !Kind !NodeId deriving (Eq, Ord)+data SV = SV !Kind !NodeId deriving (Eq, Ord) -instance HasKind SW where-  kindOf (SW k _) = k+instance HasKind SV where+  kindOf (SV k _) = k -instance Show SW where-  show (SW _ (NodeId n))-    | n < 0 = "s_" ++ show (abs n)-    | True  = 's' : show n+instance Show SV where+  show (SV _ (NodeId n)) = case n of+                             -2 -> "false"+                             -1 -> "true"+                             _  -> 's' : show n  -- | Kind of a symbolic word.-swKind :: SW -> Kind-swKind (SW k _) = k+swKind :: SV -> Kind+swKind (SV k _) = k  -- | Forcing an argument; this is a necessary evil to make sure all the arguments -- to an uninterpreted function are evaluated before called; the semantics of uinterpreted -- functions is necessarily strict; deviating from Haskell's-forceSWArg :: SW -> IO ()-forceSWArg (SW k n) = k `seq` n `seq` return ()+forceSVArg :: SV -> IO ()+forceSVArg (SV k n) = k `seq` n `seq` return () --- | Constant False as an SW. Note that this value always occupies slot -2.-falseSW :: SW-falseSW = SW KBool $ NodeId (-2)+-- | Constant False as an 'SV'. Note that this value always occupies slot -2.+falseSV :: SV+falseSV = SV KBool $ NodeId (-2) --- | Constant True as an SW. Note that this value always occupies slot -1.-trueSW :: SW-trueSW  = SW KBool $ NodeId (-1)+-- | Constant True as an 'SV'. Note that this value always occupies slot -1.+trueSV :: SV+trueSV  = SV KBool $ NodeId (-1)  -- | Symbolic operations data Op = Plus@@ -149,7 +163,7 @@         | Ror Int         | Extract Int Int                       -- Extract i j: extract bits i to j. Least significant bit is 0 (big-endian)         | Join                                  -- Concat two words to form a bigger one, in the order given-        | LkUp (Int, Kind, Kind, Int) !SW !SW   -- (table-index, arg-type, res-type, length of the table) index out-of-bounds-value+        | LkUp (Int, Kind, Kind, Int) !SV !SV   -- (table-index, arg-type, res-type, length of the table) index out-of-bounds-value         | ArrEq   ArrayIndex ArrayIndex         -- Array equality         | ArrRead ArrayIndex         | KindCast Kind Kind@@ -160,10 +174,12 @@         | OverflowOp    OvOp                    -- Overflow-ops, categorized separately         | StrOp StrOp                           -- String ops, categorized separately         | SeqOp SeqOp                           -- Sequence ops, categorized separately+        | TupleConstructor Int                  -- Construct an n-tuple+        | TupleAccess Int Int                   -- Access element i of an n-tuple; second argument is n         deriving (Eq, Ord)  -- | Floating point operations-data FPOp = FP_Cast        Kind Kind SW   -- From-Kind, To-Kind, RoundingMode. This is "value" conversion+data FPOp = FP_Cast        Kind Kind SV   -- From-Kind, To-Kind, RoundingMode. This is "value" conversion           | FP_Reinterpret Kind Kind      -- From-Kind, To-Kind. This is bit-reinterpretation using IEEE-754 interchange format           | FP_Abs           | FP_Neg@@ -367,22 +383,37 @@ instance Show Op where   show Shl    = "<<"   show Shr    = ">>"+   show (Rol i) = "<<<" ++ show i   show (Ror i) = ">>>" ++ show i+   show (Extract i j) = "choose [" ++ show i ++ ":" ++ show j ++ "]"+   show (LkUp (ti, at, rt, l) i e)         = "lookup(" ++ tinfo ++ ", " ++ show i ++ ", " ++ show e ++ ")"         where tinfo = "table" ++ show ti ++ "(" ++ show at ++ " -> " ++ show rt ++ ", " ++ show l ++ ")"-  show (ArrEq i j)       = "array_" ++ show i ++ " == array_" ++ show j-  show (ArrRead i)       = "select array_" ++ show i-  show (KindCast fr to)  = "cast_" ++ show fr ++ "_" ++ show to-  show (Uninterpreted i) = "[uninterpreted] " ++ i-  show (Label s)         = "[label] " ++ s-  show (IEEEFP w)        = show w-  show (PseudoBoolean p) = show p-  show (OverflowOp o)    = show o-  show (StrOp s)         = show s-  show (SeqOp s)         = show s++  show (ArrEq i j)          = "array_" ++ show i ++ " == array_" ++ show j+  show (ArrRead i)          = "select array_" ++ show i++  show (KindCast fr to)     = "cast_" ++ show fr ++ "_" ++ show to+  show (Uninterpreted i)    = "[uninterpreted] " ++ i++  show (Label s)            = "[label] " ++ s++  show (IEEEFP w)           = show w++  show (PseudoBoolean p)    = show p++  show (OverflowOp o)       = show o++  show (StrOp s)            = show s+  show (SeqOp s)            = show s++  show (TupleConstructor   0) = "SBVTuple0"+  show (TupleConstructor   n) = "mkSBVTuple" ++ show n+  show (TupleAccess      i n) = "proj_" ++ show i ++ "_SBVTuple" ++ show n+   show op     | Just s <- op `lookup` syms = s     | True                       = error "impossible happened; can't find op!"@@ -415,7 +446,7 @@   show (SBVType xs) = intercalate " -> " $ map show xs  -- | A symbolic expression-data SBVExpr = SBVApp !Op ![SW]+data SBVExpr = SBVApp !Op ![SV]              deriving (Eq, Ord)  -- | To improve hash-consing, take advantage of commutative operators by@@ -440,10 +471,10 @@   show (SBVApp op                 args)   = unwords (show op : map show args)  -- | A program is a sequence of assignments-newtype SBVPgm = SBVPgm {pgmAssignments :: S.Seq (SW, SBVExpr)}+newtype SBVPgm = SBVPgm {pgmAssignments :: S.Seq (SV, SBVExpr)} --- | 'NamedSymVar' pairs symbolic words and user given/automatically generated names-type NamedSymVar = (SW, String)+-- | 'NamedSymVar' pairs symbolic values and user given/automatically generated names+type NamedSymVar = (SV, String)  -- | Style of optimization. Note that in the pareto case the user is allowed -- to specify a max number of fronts to query the solver for, since there might@@ -486,10 +517,50 @@                              , queryTblArrPreserveIndex :: Maybe (Int, Int)                              } --- | A query is a user-guided mechanism to directly communicate and extract results from the solver.-newtype Query a = Query (StateT State IO a)-             deriving (Applicative, Functor, Monad, MonadIO, MonadState State)+-- | Computations which support query operations.+class Monad m => MonadQuery m where+  queryState :: m State +  default queryState :: (MonadTrans t, MonadQuery m', m ~ t m') => m State+  queryState = lift queryState++instance MonadQuery m             => MonadQuery (ExceptT e m)+instance MonadQuery m             => MonadQuery (MaybeT m)+instance MonadQuery m             => MonadQuery (ReaderT r m)+instance MonadQuery m             => MonadQuery (SS.StateT s m)+instance MonadQuery m             => MonadQuery (LS.StateT s m)+instance (MonadQuery m, Monoid w) => MonadQuery (SW.WriterT w m)+instance (MonadQuery m, Monoid w) => MonadQuery (LW.WriterT w m)++-- | A query is a user-guided mechanism to directly communicate and extract+-- results from the solver. A generalization of 'Data.SBV.Query'.+newtype QueryT m a = QueryT { runQueryT :: ReaderT State m a }+    deriving (Applicative, Functor, Monad, MonadIO, MonadTrans,+              MonadError e, MonadState s, MonadWriter w)++instance Monad m => MonadQuery (QueryT m) where+  queryState = QueryT ask++mapQueryT :: (ReaderT State m a -> ReaderT State n b) -> QueryT m a -> QueryT n b+mapQueryT f = QueryT . f . runQueryT+{-# INLINE mapQueryT #-}++-- | An queriable value.+class Queriable m a b | a -> b where+  -- | ^ Create a new symbolic value of type @a@+  fresh   :: QueryT m a+  -- | ^ Extract the current value in a SAT context+  extract :: a -> QueryT m b++-- Have to define this one by hand, because we use ReaderT in the implementation+instance MonadReader r m => MonadReader r (QueryT m) where+  ask = lift ask+  local f = mapQueryT $ mapReaderT $ local f++-- | A query is a user-guided mechanism to directly communicate and extract+-- results from the solver.+type Query = QueryT IO+ instance NFData OptimizeStyle where    rnf x = x `seq` () @@ -503,20 +574,20 @@    rnf (AssertWithPenalty s a p) = rnf s `seq` rnf a `seq` rnf p `seq` ()  -- | Result of running a symbolic computation-data Result = Result { reskinds       :: Set.Set Kind                                     -- ^ kinds used in the program-                     , resTraces      :: [(String, CW)]                                   -- ^ quick-check counter-example information (if any)-                     , resObservables :: [(String, SW)]                                   -- ^ observable expressions (part of the model)-                     , resUISegs      :: [(String, [String])]                             -- ^ uninterpeted code segments-                     , resInputs      :: ([(Quantifier, NamedSymVar)], [NamedSymVar])     -- ^ inputs (possibly existential) + tracker vars-                     , resConsts      :: [(SW, CW)]                                       -- ^ constants-                     , resTables      :: [((Int, Kind, Kind), [SW])]                      -- ^ tables (automatically constructed) (tableno, index-type, result-type) elts-                     , resArrays      :: [(Int, ArrayInfo)]                               -- ^ arrays (user specified)-                     , resUIConsts    :: [(String, SBVType)]                              -- ^ uninterpreted constants-                     , resAxioms      :: [(String, [String])]                             -- ^ axioms-                     , resAsgns       :: SBVPgm                                           -- ^ assignments-                     , resConstraints :: [(Bool, [(String, String)], SW)]                       -- ^ additional constraints (boolean)-                     , resAssertions  :: [(String, Maybe CallStack, SW)]                  -- ^ assertions-                     , resOutputs     :: [SW]                                             -- ^ outputs+data Result = Result { reskinds       :: Set.Set Kind                                 -- ^ kinds used in the program+                     , resTraces      :: [(String, CV)]                               -- ^ quick-check counter-example information (if any)+                     , resObservables :: [(String, CV -> Bool, SV)]                   -- ^ observable expressions (part of the model)+                     , resUISegs      :: [(String, [String])]                         -- ^ uninterpeted code segments+                     , resInputs      :: ([(Quantifier, NamedSymVar)], [NamedSymVar]) -- ^ inputs (possibly existential) + tracker vars+                     , resConsts      :: [(SV, CV)]                                   -- ^ constants+                     , resTables      :: [((Int, Kind, Kind), [SV])]                  -- ^ tables (automatically constructed) (tableno, index-type, result-type) elts+                     , resArrays      :: [(Int, ArrayInfo)]                           -- ^ arrays (user specified)+                     , resUIConsts    :: [(String, SBVType)]                          -- ^ uninterpreted constants+                     , resAxioms      :: [(String, [String])]                         -- ^ axioms+                     , resAsgns       :: SBVPgm                                       -- ^ assignments+                     , resConstraints :: [(Bool, [(String, String)], SV)]                   -- ^ additional constraints (boolean)+                     , resAssertions  :: [(String, Maybe CallStack, SV)]              -- ^ assertions+                     , resOutputs     :: [SV]                                         -- ^ outputs                      }  -- Show instance for 'Result'. Only for debugging purposes.@@ -533,7 +604,7 @@                 ++ map shn (fst is)                 ++ (if null (snd is) then [] else "TRACKER VARS" : map (shn . (EX,)) (snd is))                 ++ ["CONSTANTS"]-                ++ map shc cs+                ++ concatMap shc cs                 ++ ["TABLES"]                 ++ map sht ts                 ++ ["ARRAYS"]@@ -555,20 +626,24 @@     where sh2 :: Show a => [a] -> [String]           sh2 = map (("  "++) . show) -          usorts = [sh s t | KUserSort s t <- Set.toList kinds]+          usorts = [sh s t | KUninterpreted s t <- Set.toList kinds]                    where sh s (Left   _) = s                          sh s (Right es) = s ++ " (" ++ intercalate ", " es ++ ")" -          shs sw = show sw ++ " :: " ++ show (swKind sw)+          shs sv = show sv ++ " :: " ++ show (swKind sv)            sht ((i, at, rt), es)  = "  Table " ++ show i ++ " : " ++ show at ++ "->" ++ show rt ++ " = " ++ show es -          shc (sw, cw) = "  " ++ show sw ++ " = " ++ show cw+          shc (sv, cv)+            | sv == falseSV || sv == trueSV+            = []+            | True+            = ["  " ++ show sv ++ " = " ++ show cv]            shcg (s, ss) = ("Variable: " ++ s) : map ("  " ++) ss -          shn (q, (sw, nm)) = "  " ++ ni ++ " :: " ++ show (swKind sw) ++ ex ++ alias-            where ni = show sw+          shn (q, (sv, nm)) = "  " ++ ni ++ " :: " ++ show (swKind sv) ++ ex ++ alias+            where ni = show sv                   ex | q == ALL = ""                      | True     = ", existential"                   alias | ni == nm = ""@@ -600,27 +675,27 @@                 stk ++ ": " ++ show p  -- | The context of a symbolic array as created-data ArrayContext = ArrayFree (Maybe SW)                   -- ^ A new array, the contents are initialized with the given value, if any-                  | ArrayMutate ArrayIndex SW SW           -- ^ An array created by mutating another array at a given cell-                  | ArrayMerge  SW ArrayIndex ArrayIndex   -- ^ An array created by symbolically merging two other arrays+data ArrayContext = ArrayFree (Maybe SV)                   -- ^ A new array, the contents are initialized with the given value, if any+                  | ArrayMutate ArrayIndex SV SV           -- ^ An array created by mutating another array at a given cell+                  | ArrayMerge  SV ArrayIndex ArrayIndex   -- ^ An array created by symbolically merging two other arrays  instance Show ArrayContext where   show (ArrayFree Nothing)   = " initialized with random elements"-  show (ArrayFree (Just sw)) = " initialized with " ++ show sw+  show (ArrayFree (Just sv)) = " initialized with " ++ show sv   show (ArrayMutate i a b)   = " cloned from array_" ++ show i ++ " with " ++ show a ++ " :: " ++ show (swKind a) ++ " |-> " ++ show b ++ " :: " ++ show (swKind b)   show (ArrayMerge  s i j)   = " merged arrays " ++ show i ++ " and " ++ show j ++ " on condition " ++ show s  -- | Expression map, used for hash-consing-type ExprMap = Map.Map SBVExpr SW+type ExprMap = Map.Map SBVExpr SV  -- | Constants are stored in a map, for hash-consing.-type CnstMap = Map.Map CW SW+type CnstMap = Map.Map CV SV  -- | Kinds used in the program; used for determining the final SMT-Lib logic to pick type KindSet = Set.Set Kind  -- | Tables generated during a symbolic run-type TableMap = Map.Map (Kind, Kind, [SW]) Int+type TableMap = Map.Map (Kind, Kind, [SV]) Int  -- | Representation for symbolic arrays type ArrayInfo = (String, (Kind, Kind), ArrayContext)@@ -629,7 +704,7 @@ type ArrayMap  = IMap.IntMap ArrayInfo  -- | Functional Arrays generated during a symbolic run-type FArrayMap  = IMap.IntMap (SVal -> SVal, IORef (IMap.IntMap SW))+type FArrayMap  = IMap.IntMap (SVal -> SVal, IORef (IMap.IntMap SV))  -- | Uninterpreted-constants generated during a symbolic run type UIMap     = Map.Map String SBVType@@ -733,14 +808,14 @@                     , startTime    :: UTCTime                     , runMode      :: IORef SBVRunMode                     , rIncState    :: IORef IncState-                    , rCInfo       :: IORef [(String, CW)]-                    , rObservables :: IORef [(String, SW)]+                    , rCInfo       :: IORef [(String, CV)]+                    , rObservables :: IORef [(String, CV -> Bool, SV)]                     , rctr         :: IORef Int                     , rUsedKinds   :: IORef KindSet                     , rUsedLbls    :: IORef (Set.Set String)                     , rinps        :: IORef ([(Quantifier, NamedSymVar)], [NamedSymVar]) -- User defined, and internal existential-                    , rConstraints :: IORef [(Bool, [(String, String)], SW)]-                    , routs        :: IORef [SW]+                    , rConstraints :: IORef [(Bool, [(String, String)], SV)]+                    , routs        :: IORef [SV]                     , rtblMap      :: IORef TableMap                     , spgm         :: IORef SBVPgm                     , rconstMap    :: IORef CnstMap@@ -751,12 +826,12 @@                     , rCgMap       :: IORef CgMap                     , raxioms      :: IORef [(String, [String])]                     , rSMTOptions  :: IORef [SMTOption]-                    , rOptGoals    :: IORef [Objective (SW, SW)]-                    , rAsserts     :: IORef [(String, Maybe CallStack, SW)]-                    , rSWCache     :: IORef (Cache SW)+                    , rOptGoals    :: IORef [Objective (SV, SV)]+                    , rAsserts     :: IORef [(String, Maybe CallStack, SV)]+                    , rSVCache     :: IORef (Cache SV)                     , rAICache     :: IORef (Cache ArrayIndex)                     , rFAICache    :: IORef (Cache FArrayIndex)-                    , queryState   :: IORef (Maybe QueryState)+                    , rQueryState  :: IORef (Maybe QueryState)                     }  -- NFData is a bit of a lie, but it's sufficient, most of the content is iorefs that we don't want to touch@@ -782,7 +857,7 @@ -- | The "Symbolic" value. Either a constant (@Left@) or a symbolic -- value (@Right Cached@). Note that caching is essential for making -- sure sharing is preserved.-data SVal = SVal !Kind !(Either CW (Cached SW))+data SVal = SVal !Kind !(Either CV (Cached SV))  instance HasKind SVal where   kindOf (SVal k _) = k@@ -792,8 +867,8 @@ -- implicit "fromBoolean" applied to Booleans in Haskell; and thus a statement -- of the form "True :: SBool" is just meaningless. (There should be a fromBoolean!) instance Show SVal where-  show (SVal KBool (Left c))  = showCW False c-  show (SVal k     (Left c))  = showCW False c ++ " :: " ++ show k+  show (SVal KBool (Left c))  = showCV False c+  show (SVal k     (Left c))  = showCV False c ++ " :: " ++ show k   show (SVal k     (Right _)) =         "<symbolic> :: " ++ show k  -- We really don't want an 'Eq' instance for 'SBV' or 'SVal'. As it really makes no sense.@@ -831,8 +906,8 @@         R.modifyIORef' (field incState) update  -- | Add an observable-recordObservable :: State -> String -> SW -> IO ()-recordObservable st nm sw = modifyState st rObservables ((nm, sw):) (return ())+recordObservable :: State -> String -> (CV -> Bool) -> SV -> IO ()+recordObservable st nm chk sv = modifyState st rObservables ((nm, chk, sv):) (return ())  -- | Increment the variable counter incrementInternalCounter :: State -> IO Int@@ -851,8 +926,8 @@ svUninterpreted k nm code args = SVal k $ Right $ cache result   where result st = do let ty = SBVType (map kindOf args ++ [k])                        newUninterpreted st nm ty code-                       sws <- mapM (svToSW st) args-                       mapM_ forceSWArg sws+                       sws <- mapM (svToSV st) args+                       mapM_ forceSVArg sws                        newExpr st k $ SBVApp (Uninterpreted nm) sws  -- | Create a new uninterpreted symbol, possibly with user given code@@ -870,18 +945,18 @@                                -- No need to record the code in interactive mode: CodeGen doesn't use interactive                               when (isJust mbCode) $ modifyState st rCgMap (Map.insert nm (fromJust mbCode)) (return ())-  where checkType t' cont+  where checkType :: SBVType -> r -> r+        checkType t' cont           | t /= t' = error $  "Uninterpreted constant " ++ show nm ++ " used at incompatible types\n"                             ++ "      Current type      : " ++ show t ++ "\n"                             ++ "      Previously used at: " ++ show t'           | True    = cont -         validChar x = isAlphaNum x || x `elem` "_"         enclosed    = head nm == '|' && last nm == '|' && length nm > 2 && not (any (`elem` "|\\") (tail (init nm)))  -- | Add a new sAssert based constraint-addAssertion :: State -> Maybe CallStack -> String -> SW -> IO ()+addAssertion :: State -> Maybe CallStack -> String -> SV -> IO () addAssertion st cs msg cond = modifyState st rAsserts ((msg, cs, cond):)                                         $ noInteractive [ "Named assertions (sAssert):"                                                         , "  Tag: " ++ msg@@ -891,28 +966,28 @@ -- | Create an internal variable, which acts as an input but isn't visible to the user. -- Such variables are existentially quantified in a SAT context, and universally quantified -- in a proof context.-internalVariable :: State -> Kind -> IO SW-internalVariable st k = do (sw, nm) <- newSW st k+internalVariable :: State -> Kind -> IO SV+internalVariable st k = do (sv, nm) <- newSV st k                            rm <- readIORef (runMode st)                            let q = case rm of                                      SMTMode    _ True  _ -> EX                                      SMTMode    _ False _ -> ALL                                      CodeGen              -> ALL                                      Concrete{}           -> ALL-                           modifyState st rinps (first ((:) (q, (sw, "__internal_sbv_" ++ nm))))+                           modifyState st rinps (first ((:) (q, (sv, "__internal_sbv_" ++ nm))))                                      $ noInteractive [ "Internal variable creation:"                                                      , "  Named: " ++ nm                                                      ]-                           return sw+                           return sv {-# INLINE internalVariable #-} --- | Create a new SW-newSW :: State -> Kind -> IO (SW, String)-newSW st k = do ctr <- incrementInternalCounter st-                let sw = SW k (NodeId ctr)+-- | Create a new SV+newSV :: State -> Kind -> IO (SV, String)+newSV st k = do ctr <- incrementInternalCounter st+                let sv = SV k (NodeId ctr)                 registerKind st k-                return (sw, 's' : show ctr)-{-# INLINE newSW #-}+                return (sv, 's' : show ctr)+{-# INLINE newSV #-}  -- | Register a new kind with the system, used for uninterpreted sorts. -- NB: Is it safe to have new kinds in query mode? It could be that@@ -925,13 +1000,38 @@ -- allow for this. registerKind :: State -> Kind -> IO () registerKind st k-  | KUserSort sortName _ <- k, map toLower sortName `elem` smtLibReservedNames+  | KUninterpreted sortName _ <- k, map toLower sortName `elem` smtLibReservedNames   = error $ "SBV: " ++ show sortName ++ " is a reserved sort; please use a different name."   | True-  = do ks <- readIORef (rUsedKinds st)-       unless (k `Set.member` ks) $ modifyState st rUsedKinds (Set.insert k)-                                              $ modifyIncState st rNewKinds (Set.insert k)+  = do -- Adding a kind to the incState is tricky; we only need to add it+       --     *    If it's an uninterpreted sort that's not already in the general state+       --     * OR If it's a tuple-sort whose cardinality isn't already in the general state +       existingKinds <- readIORef (rUsedKinds st)++       modifyState st rUsedKinds (Set.insert k) $ do++                          let needsAdding = case k of+                                              KUninterpreted{} -> k `notElem` existingKinds+                                              KTuple nks       -> length nks `notElem` [length oks | KTuple oks <- Set.toList existingKinds]+                                              _                -> False++                          when needsAdding $ modifyIncState st rNewKinds (Set.insert k)++       -- Don't forget to register subkinds!+       case k of+         KBool          {}  -> return ()+         KBounded       {}  -> return ()+         KUnbounded     {}  -> return ()+         KReal          {}  -> return ()+         KUninterpreted {}  -> return ()+         KFloat         {}  -> return ()+         KDouble        {}  -> return ()+         KChar          {}  -> return ()+         KString        {}  -> return ()+         KList          ek  -> registerKind st ek+         KTuple         eks -> mapM_ (registerKind st) eks+ -- | Register a new label with the system, making sure they are unique and have no '|'s in them registerLabel :: String -> State -> String -> IO () registerLabel whence st nm@@ -950,20 +1050,20 @@   where err w = error $ "SBV (" ++ whence ++ "): " ++ show nm ++ " " ++ w  -- | Create a new constant; hash-cons as necessary-newConst :: State -> CW -> IO SW+newConst :: State -> CV -> IO SV newConst st c = do   constMap <- readIORef (rconstMap st)   case c `Map.lookup` constMap of-    Just sw -> return sw+    Just sv -> return sv     Nothing -> do let k = kindOf c-                  (sw, _) <- newSW st k-                  let ins = Map.insert c sw+                  (sv, _) <- newSV st k+                  let ins = Map.insert c sv                   modifyState st rconstMap ins $ modifyIncState st rNewConsts ins-                  return sw+                  return sv {-# INLINE newConst #-}  -- | Create a new table; hash-cons as necessary-getTableIndex :: State -> Kind -> Kind -> [SW] -> IO Int+getTableIndex :: State -> Kind -> Kind -> [SV] -> IO Int getTableIndex st at rt elts = do   let key = (at, rt, elts)   tblMap <- readIORef (rtblMap st)@@ -975,28 +1075,28 @@                  return i  -- | Create a new expression; hash-cons as necessary-newExpr :: State -> Kind -> SBVExpr -> IO SW+newExpr :: State -> Kind -> SBVExpr -> IO SV newExpr st k app = do    let e = reorder app    exprMap <- readIORef (rexprMap st)    case e `Map.lookup` exprMap of-     Just sw -> return sw-     Nothing -> do (sw, _) <- newSW st k-                   let append (SBVPgm xs) = SBVPgm (xs S.|> (sw, e))+     Just sv -> return sv+     Nothing -> do (sv, _) <- newSV st k+                   let append (SBVPgm xs) = SBVPgm (xs S.|> (sv, e))                    modifyState st spgm append $ modifyIncState st rNewAsgns append-                   modifyState st rexprMap (Map.insert e sw) (return ())-                   return sw+                   modifyState st rexprMap (Map.insert e sv) (return ())+                   return sv {-# INLINE newExpr #-} --- | Convert a symbolic value to a symbolic-word-svToSW :: State -> SVal -> IO SW-svToSW st (SVal _ (Left c))  = newConst st c-svToSW st (SVal _ (Right f)) = uncache f st+-- | Convert a symbolic value to an internal SV+svToSV :: State -> SVal -> IO SV+svToSV st (SVal _ (Left c))  = newConst st c+svToSV st (SVal _ (Right f)) = uncache f st --- | Convert a symbolic value to an SW, inside the Symbolic monad-svToSymSW :: SVal -> Symbolic SW-svToSymSW sbv = do st <- ask-                   liftIO $ svToSW st sbv+-- | Generalization of 'Data.SBV.svToSymSV'+svToSymSV :: MonadSymbolic m => SVal -> m SV+svToSymSV sbv = do st <- symbolicEnv+                   liftIO $ svToSV st sbv  ------------------------------------------------------------------------- -- * Symbolic Computations@@ -1004,17 +1104,53 @@ -- | A Symbolic computation. Represented by a reader monad carrying the -- state of the computation, layered on top of IO for creating unique -- references to hold onto intermediate results.-newtype Symbolic a = Symbolic (ReaderT State IO a)-                   deriving ( Applicative, Functor, Monad, MonadIO, MonadReader State++-- | Computations which support symbolic operations+class MonadIO m => MonadSymbolic m where+  symbolicEnv :: m State++  default symbolicEnv :: (MonadTrans t, MonadSymbolic m', m ~ t m') => m State+  symbolicEnv = lift symbolicEnv++instance MonadSymbolic m             => MonadSymbolic (ExceptT e m)+instance MonadSymbolic m             => MonadSymbolic (MaybeT m)+instance MonadSymbolic m             => MonadSymbolic (ReaderT r m)+instance MonadSymbolic m             => MonadSymbolic (SS.StateT s m)+instance MonadSymbolic m             => MonadSymbolic (LS.StateT s m)+instance (MonadSymbolic m, Monoid w) => MonadSymbolic (SW.WriterT w m)+instance (MonadSymbolic m, Monoid w) => MonadSymbolic (LW.WriterT w m)++-- | A generalization of 'Data.SBV.Symbolic'.+newtype SymbolicT m a = SymbolicT { runSymbolicT :: ReaderT State m a }+                   deriving ( Applicative, Functor, Monad, MonadIO, MonadTrans+                            , MonadError e, MonadState s, MonadWriter w #if MIN_VERSION_base(4,11,0)                             , Fail.MonadFail #endif                             ) +-- | `MonadSymbolic` instance for `SymbolicT m`+instance MonadIO m => MonadSymbolic (SymbolicT m) where+  symbolicEnv = SymbolicT ask++-- | Map a computation over the symbolic transformer.+mapSymbolicT :: (ReaderT State m a -> ReaderT State n b) -> SymbolicT m a -> SymbolicT n b+mapSymbolicT f = SymbolicT . f . runSymbolicT+{-# INLINE mapSymbolicT #-}++-- Have to define this one by hand, because we use ReaderT in the implementation+instance MonadReader r m => MonadReader r (SymbolicT m) where+  ask = lift ask+  local f = mapSymbolicT $ mapReaderT $ local f++-- | `Symbolic` is specialization of `SymbolicT` to the `IO` monad. Unless you are using+-- transformers explicitly, this is the type you should prefer.+type Symbolic = SymbolicT IO+ -- | Create a symbolic value, based on the quantifier we have. If an -- explicit quantifier is given, we just use that. If not, then we -- pick the quantifier appropriately based on the run-mode.--- @randomCW@ is used for generating random values for this variable+-- @randomCV@ is used for generating random values for this variable -- when used for @quickCheck@ or 'Data.SBV.Tools.GenTest.genTest' purposes. svMkSymVar :: Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal svMkSymVar = svMkSymVarGen False@@ -1023,26 +1159,26 @@ svMkTrackerVar :: Kind -> String -> State -> IO SVal svMkTrackerVar k nm = svMkSymVarGen True (Just EX) k (Just nm) --- | Create an N-bit symbolic unsigned named variable-sWordN :: Int -> String -> Symbolic SVal-sWordN w nm = ask >>= liftIO . svMkSymVar Nothing (KBounded False w) (Just nm)+-- | Generalization of 'Data.SBV.sWordN'+sWordN :: MonadSymbolic m => Int -> String -> m SVal+sWordN w nm = symbolicEnv >>= liftIO . svMkSymVar Nothing (KBounded False w) (Just nm) --- | Create an N-bit symbolic unsigned unnamed variable-sWordN_ :: Int -> Symbolic SVal-sWordN_ w = ask >>= liftIO . svMkSymVar Nothing (KBounded False w) Nothing+-- | Generalization of 'Data.SBV.sWordN_'+sWordN_ :: MonadSymbolic m => Int -> m SVal+sWordN_ w = symbolicEnv >>= liftIO . svMkSymVar Nothing (KBounded False w) Nothing --- | Create an N-bit symbolic signed named variable-sIntN :: Int -> String -> Symbolic SVal-sIntN w nm = ask >>= liftIO . svMkSymVar Nothing (KBounded True w) (Just nm)+-- | Generalization of 'Data.SBV.sIntN'+sIntN :: MonadSymbolic m => Int -> String -> m SVal+sIntN w nm = symbolicEnv >>= liftIO . svMkSymVar Nothing (KBounded True w) (Just nm) --- | Create an N-bit symbolic signed unnamed variable-sIntN_ :: Int -> Symbolic SVal-sIntN_ w = ask >>= liftIO . svMkSymVar Nothing (KBounded True w) Nothing+-- | Generalization of 'Data.SBV.sIntN_'+sIntN_ :: MonadSymbolic m => Int -> m SVal+sIntN_ w = symbolicEnv >>= liftIO . svMkSymVar Nothing (KBounded True w) Nothing  -- | Create a symbolic value, based on the quantifier we have. If an -- explicit quantifier is given, we just use that. If not, then we -- pick the quantifier appropriately based on the run-mode.--- @randomCW@ is used for generating random values for this variable+-- @randomCV@ is used for generating random values for this variable -- when used for @quickCheck@ or 'Data.SBV.Tools.GenTest.genTest' purposes. svMkSymVarGen :: Bool -> Maybe Quantifier -> Kind -> Maybe String -> State -> IO SVal svMkSymVarGen isTracker mbQ k mbNm st = do@@ -1058,14 +1194,14 @@               | isUninterpreted k  = disallow "Uninterpreted sorts"               | True               = cont -            mkS q = do (sw, internalName) <- newSW st k+            mkS q = do (sv, internalName) <- newSV st k                        let nm = fromMaybe internalName mbNm-                       introduceUserName st isTracker nm k q sw+                       introduceUserName st isTracker nm k q sv -            mkC   = do cw <- randomCW k+            mkC   = do cv <- randomCV k                        do registerKind st k-                          modifyState st rCInfo ((fromMaybe "_" mbNm, cw):) (return ())-                       return $ SVal k (Left cw)+                          modifyState st rCInfo ((fromMaybe "_" mbNm, cv):) (return ())+                       return $ SVal k (Left cv)          case (mbQ, rm) of           (Just q,  SMTMode{}        ) -> mkS q@@ -1078,76 +1214,73 @@           (_      ,  Concrete{})       -> noUI mkC  -- | Introduce a new user name. We die if repeated.-introduceUserName :: State -> Bool -> String -> Kind -> Quantifier -> SW -> IO SVal-introduceUserName st isTracker nm k q sw = do+introduceUserName :: State -> Bool -> String -> Kind -> Quantifier -> SV -> IO SVal+introduceUserName st isTracker nm k q sv = do         (is, ints) <- readIORef (rinps st)         if nm `elem` [n | (_, (_, n)) <- is] ++ [n | (_, n) <- ints]            then error $ "SBV: Repeated user given name: " ++ show nm ++ ". Please use unique names."            else if isTracker && q == ALL                 then error $ "SBV: Impossible happened! A universally quantified tracker variable is being introduced: " ++ show nm                 else do let newInp olds = case q of-                                           EX  -> (sw, nm) : olds+                                           EX  -> (sv, nm) : olds                                            ALL -> noInteractive [ "Adding a new universally quantified variable: "                                                                 , "  Name      : " ++ show nm                                                                 , "  Kind      : " ++ show k                                                                 , "  Quantifier: Universal"-                                                                , "  Node      : " ++ show sw+                                                                , "  Node      : " ++ show sv                                                                 , "Only existential variables are supported in query mode."                                                                 ]                         if isTracker-                           then modifyState st rinps (second ((:) (sw, nm)))+                           then modifyState st rinps (second ((:) (sv, nm)))                                           $ noInteractive ["Adding a new tracker variable in interactive mode: " ++ show nm]-                           else modifyState st rinps (first ((:) (q, (sw, nm))))+                           else modifyState st rinps (first ((:) (q, (sv, nm))))                                           $ modifyIncState st rNewInps newInp-                        return $ SVal k $ Right $ cache (const (return sw))+                        return $ SVal k $ Right $ cache (const (return sv)) --- | Add a user specified axiom to the generated SMT-Lib file. The first argument is a mere--- string, use for commenting purposes. The second argument is intended to hold the multiple-lines--- of the axiom text as expressed in SMT-Lib notation. Note that we perform no checks on the axiom--- itself, to see whether it's actually well-formed or is sensical by any means.--- A separate formalization of SMT-Lib would be very useful here.-addAxiom :: String -> [String] -> Symbolic ()+-- | Generalization of 'Data.SBV.addAxiom'+addAxiom :: MonadSymbolic m => String -> [String] -> m () addAxiom nm ax = do-        st <- ask+        st <- symbolicEnv         liftIO $ modifyState st raxioms ((nm, ax) :)                            $ noInteractive [ "Adding a new axiom:"                                            , "  Named: " ++ show nm                                            , "  Axiom: " ++ unlines ax                                            ] --- | Run a symbolic computation, and return a extra value paired up with the 'Result'-runSymbolic :: SBVRunMode -> Symbolic a -> IO (a, Result)-runSymbolic currentRunMode (Symbolic c) = do-   currTime  <- getCurrentTime-   rm        <- newIORef currentRunMode-   ctr       <- newIORef (-2) -- start from -2; False and True will always occupy the first two elements-   cInfo     <- newIORef []-   observes  <- newIORef []-   pgm       <- newIORef (SBVPgm S.empty)-   emap      <- newIORef Map.empty-   cmap      <- newIORef Map.empty-   inps      <- newIORef ([], [])-   outs      <- newIORef []-   tables    <- newIORef Map.empty-   arrays    <- newIORef IMap.empty-   fArrays   <- newIORef IMap.empty-   uis       <- newIORef Map.empty-   cgs       <- newIORef Map.empty-   axioms    <- newIORef []-   swCache   <- newIORef IMap.empty-   aiCache   <- newIORef IMap.empty-   faiCache  <- newIORef IMap.empty-   usedKinds <- newIORef Set.empty-   usedLbls  <- newIORef Set.empty-   cstrs     <- newIORef []-   smtOpts   <- newIORef []-   optGoals  <- newIORef []-   asserts   <- newIORef []-   istate    <- newIORef =<< newIncState-   qstate    <- newIORef Nothing-   let st = State { runMode      = rm+-- | Generalization of 'Data.SBV.runSymbolic'+runSymbolic :: MonadIO m => SBVRunMode -> SymbolicT m a -> m (a, Result)+runSymbolic currentRunMode (SymbolicT c) = do+   st <- liftIO $ do+     currTime  <- getCurrentTime+     rm        <- newIORef currentRunMode+     ctr       <- newIORef (-2) -- start from -2; False and True will always occupy the first two elements+     cInfo     <- newIORef []+     observes  <- newIORef []+     pgm       <- newIORef (SBVPgm S.empty)+     emap      <- newIORef Map.empty+     cmap      <- newIORef Map.empty+     inps      <- newIORef ([], [])+     outs      <- newIORef []+     tables    <- newIORef Map.empty+     arrays    <- newIORef IMap.empty+     fArrays   <- newIORef IMap.empty+     uis       <- newIORef Map.empty+     cgs       <- newIORef Map.empty+     axioms    <- newIORef []+     swCache   <- newIORef IMap.empty+     aiCache   <- newIORef IMap.empty+     faiCache  <- newIORef IMap.empty+     usedKinds <- newIORef Set.empty+     usedLbls  <- newIORef Set.empty+     cstrs     <- newIORef []+     smtOpts   <- newIORef []+     optGoals  <- newIORef []+     asserts   <- newIORef []+     istate    <- newIORef =<< newIncState+     qstate    <- newIORef Nothing+     pure $ State { runMode      = rm                   , startTime    = currTime-                  , pathCond     = SVal KBool (Left trueCW)+                  , pathCond     = SVal KBool (Left trueCV)                   , rIncState    = istate                   , rCInfo       = cInfo                   , rObservables = observes@@ -1165,25 +1298,25 @@                   , rUIMap       = uis                   , rCgMap       = cgs                   , raxioms      = axioms-                  , rSWCache     = swCache+                  , rSVCache     = swCache                   , rAICache     = aiCache                   , rFAICache    = faiCache                   , rConstraints = cstrs                   , rSMTOptions  = smtOpts                   , rOptGoals    = optGoals                   , rAsserts     = asserts-                  , queryState   = qstate+                  , rQueryState   = qstate                   }-   _ <- newConst st falseCW -- s(-2) == falseSW-   _ <- newConst st trueCW  -- s(-1) == trueSW+   _ <- liftIO $ newConst st falseCV -- s(-2) == falseSV+   _ <- liftIO $ newConst st trueCV  -- s(-1) == trueSV    r <- runReaderT c st-   res <- extractSymbolicSimulationState st+   res <- liftIO $ extractSymbolicSimulationState st     -- Clean-up after ourselves-   qs <- readIORef qstate+   qs <- liftIO $ readIORef $ rQueryState st    case qs of      Nothing                         -> return ()-     Just QueryState{queryTerminate} -> queryTerminate+     Just QueryState{queryTerminate} -> liftIO queryTerminate     return (r, res) @@ -1216,14 +1349,14 @@     return $ Result knds traceVals observables cgMap inpsO cnsts tbls arrs unint axs (SBVPgm rpgm) extraCstrs assertions outsO --- | Add a new option-addNewSMTOption :: SMTOption -> Symbolic ()-addNewSMTOption o =  do st <- ask+-- | Generalization of 'Data.SBV.addNewSMTOption'+addNewSMTOption :: MonadSymbolic m => SMTOption -> m ()+addNewSMTOption o =  do st <- symbolicEnv                         liftIO $ modifyState st rSMTOptions (o:) (return ()) --- | Handling constraints-imposeConstraint :: Bool -> [(String, String)] -> SVal -> Symbolic ()-imposeConstraint isSoft attrs c = do st <- ask+-- | Generalization of 'Data.SBV.imposeConstraint'+imposeConstraint :: MonadSymbolic m => Bool -> [(String, String)] -> SVal -> m ()+imposeConstraint isSoft attrs c = do st <- symbolicEnv                                      rm <- liftIO $ readIORef (runMode st)                                      case rm of                                        CodeGen -> error "SBV: constraints are not allowed in code-generation"@@ -1232,23 +1365,24 @@  -- | Require a boolean condition to be true in the state. Only used for internal purposes. internalConstraint :: State -> Bool -> [(String, String)] -> SVal -> IO ()-internalConstraint st isSoft attrs b = do v <- svToSW st b-                                          modifyState st rConstraints ((isSoft, attrs, v):)-                                                    $ noInteractive [ "Adding an internal " ++ soft ++ "constraint:"-                                                                    , "  Named: " ++ fromMaybe "<unnamed>" (listToMaybe [nm | (":named", nm) <- attrs])-                                                                    ]+internalConstraint st isSoft attrs b = do v <- svToSV st b+                                          unless (null attrs && v == trueSV) $+                                                 modifyState st rConstraints ((isSoft, attrs, v):)+                                                              $ noInteractive [ "Adding an internal " ++ soft ++ "constraint:"+                                                                              , "  Named: " ++ fromMaybe "<unnamed>" (listToMaybe [nm | (":named", nm) <- attrs])+                                                                              ]     where soft | isSoft = "soft-"                | True   = "" --- | Add an optimization goal-addSValOptGoal :: Objective SVal -> Symbolic ()-addSValOptGoal obj = do st <- ask+-- | Generalization of 'Data.SBV.addSValOptGoal'+addSValOptGoal :: MonadSymbolic m => Objective SVal -> m ()+addSValOptGoal obj = do st <- symbolicEnv                          -- create the tracking variable here for the metric-                        let mkGoal nm orig = liftIO $ do origSW  <- svToSW st orig+                        let mkGoal nm orig = liftIO $ do origSV  <- svToSV st orig                                                          track   <- svMkTrackerVar (kindOf orig) nm st-                                                         trackSW <- svToSW st track-                                                         return (origSW, trackSW)+                                                         trackSV <- svToSV st track+                                                         return (origSV, trackSV)                          let walk (Minimize          nm v)     = Minimize nm                     <$> mkGoal nm v                             walk (Maximize          nm v)     = Maximize nm                     <$> mkGoal nm v@@ -1260,17 +1394,16 @@                                                            , "  Objective: " ++ show obj                                                            ] --- | Mark an interim result as an output. Useful when constructing Symbolic programs--- that return multiple values, or when the result is programmatically computed.-outputSVal :: SVal -> Symbolic ()+-- | Generalization of 'Data.SBV.outputSVal'+outputSVal :: MonadSymbolic m => SVal -> m () outputSVal (SVal _ (Left c)) = do-  st <- ask-  sw <- liftIO $ newConst st c-  liftIO $ modifyState st routs (sw:) (return ())+  st <- symbolicEnv+  sv <- liftIO $ newConst st c+  liftIO $ modifyState st routs (sv:) (return ()) outputSVal (SVal _ (Right f)) = do-  st <- ask-  sw <- liftIO $ uncache f st-  liftIO $ modifyState st routs (sw:) (return ())+  st <- symbolicEnv+  sv <- liftIO $ uncache f st+  liftIO $ modifyState st routs (sv:) (return ())  --------------------------------------------------------------------------------- -- * Cached values@@ -1295,8 +1428,8 @@ cache = Cached  -- | Uncache a previously cached computation-uncache :: Cached SW -> State -> IO SW-uncache = uncacheGen rSWCache+uncache :: Cached SV -> State -> IO SV+uncache = uncacheGen rSVCache  -- | An SMT array index is simply an int value newtype ArrayIndex = ArrayIndex { unArrayIndex :: Int } deriving (Eq, Ord)@@ -1353,12 +1486,12 @@   show (SMTLibPgm _ pre) = intercalate "\n" pre  -- Other Technicalities..-instance NFData CW where-  rnf (CW x y) = x `seq` y `seq` ()+instance NFData CV where+  rnf (CV x y) = x `seq` y `seq` () -instance NFData GeneralizedCW where-  rnf (ExtendedCW e) = e `seq` ()-  rnf (RegularCW  c) = c `seq` ()+instance NFData GeneralizedCV where+  rnf (ExtendedCV e) = e `seq` ()+  rnf (RegularCV  c) = c `seq` ()  #if MIN_VERSION_base(4,9,0) #else@@ -1376,7 +1509,7 @@                        `seq` rnf outs instance NFData Kind         where rnf a          = seq a () instance NFData ArrayContext where rnf a          = seq a ()-instance NFData SW           where rnf a          = seq a ()+instance NFData SV           where rnf a          = seq a () instance NFData SBVExpr      where rnf a          = seq a () instance NFData Quantifier   where rnf a          = seq a () instance NFData SBVType      where rnf a          = seq a ()@@ -1431,7 +1564,7 @@ instance HasKind RoundingMode  -- | Solver configuration. See also 'Data.SBV.z3', 'Data.SBV.yices', 'Data.SBV.cvc4', 'Data.SBV.boolector', 'Data.SBV.mathSAT', etc.--- which are instantiations of this type for those solvers, with reasonable defaults. In particular, custom configuration can be +-- which are instantiations of this type for those solvers, with reasonable defaults. In particular, custom configuration can be -- created by varying those values. (Such as @z3{verbose=True}@.) -- -- Most fields are self explanatory. The notion of precision for printing algebraic reals stems from the fact that such values does@@ -1470,8 +1603,8 @@  -- | A model, as returned by a solver data SMTModel = SMTModel {-        modelObjectives :: [(String, GeneralizedCW)]  -- ^ Mapping of symbolic values to objective values.-     ,  modelAssocs     :: [(String, CW)]             -- ^ Mapping of symbolic values to constants.+        modelObjectives :: [(String, GeneralizedCV)]  -- ^ Mapping of symbolic values to objective values.+     ,  modelAssocs     :: [(String, CV)]             -- ^ Mapping of symbolic values to constants.      }      deriving Show @@ -1513,6 +1646,7 @@ data SMTSolver = SMTSolver {          name           :: Solver                -- ^ The solver in use        , executable     :: String                -- ^ The path to its executable+       , preprocess     :: String -> String      -- ^ Each line sent to the solver will be passed through this function (typically id)        , options        :: SMTConfig -> [String] -- ^ Options to provide to the solver        , engine         :: SMTEngine             -- ^ The solver engine, responsible for interpreting solver output        , capabilities   :: SolverCapabilities    -- ^ Various capabilities of the solver
Data/SBV/Dynamic.hs view
@@ -1,16 +1,16 @@----------------------------------------------------------------------------------+----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Dynamic--- Copyright   :  (c) Brian Huffman--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Dynamic+-- Author    : Brian Huffman+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Dynamically typed low-level API to the SBV library, for users who -- want to generate symbolic values at run-time. Note that with this -- API it is possible to create terms that are not type correct; use -- at your own risk!----------------------------------------------------------------------------------+-----------------------------------------------------------------------------  module Data.SBV.Dynamic   (@@ -18,7 +18,7 @@   -- ** Symbolic types   -- *** Abstract symbolic value type     SVal-  , HasKind(..), Kind(..), CW(..), CWVal(..), cwToBool+  , HasKind(..), Kind(..), CV(..), CVal(..), cvToBool   -- *** SMT Arrays of symbolic values   , SArr, readSArr, writeSArr, mergeSArr, newSArr, eqSArr   -- *** Functional arrays of symbolic values@@ -205,10 +205,10 @@  -- | Extract a model, the result is a tuple where the first argument (if True) -- indicates whether the model was "probable". (i.e., if the solver returned unknown.)-getModelAssignment :: SMTResult -> Either String (Bool, [CW])+getModelAssignment :: SMTResult -> Either String (Bool, [CV]) getModelAssignment = SBV.getModelAssignment  -- | Extract a model dictionary. Extract a dictionary mapping the variables to -- their respective values as returned by the SMT solver. Also see `Data.SBV.SMT.getModelDictionaries`.-getModelDictionary :: SMTResult -> Map String CW+getModelDictionary :: SMTResult -> Map String CV getModelDictionary = SBV.getModelDictionary
Data/SBV/Internals.hs view
@@ -1,15 +1,15 @@----------------------------------------------------------------------------------+----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Internals--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Internals+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Low level functions to access the SBV infrastructure, for developers who -- want to build further tools on top of SBV. End-users of the library -- should not need to use this module.----------------------------------------------------------------------------------+-----------------------------------------------------------------------------  module Data.SBV.Internals (   -- * Running symbolic programs /manually/@@ -22,7 +22,7 @@   , module Data.SBV.Core.Data    -- * Operations useful for instantiating SBV type classes-  , genLiteral, genFromCW, CW(..), genMkSymVar, genParse, showModel, SMTModel(..), liftQRem, liftDMod, registerKind+  , genLiteral, genFromCV, CV(..), genMkSymVar, genParse, showModel, SMTModel(..), liftQRem, liftDMod, registerKind    -- * Compilation to C, extras   , compileToC', compileToCLib'@@ -48,9 +48,11 @@    ) where +import Control.Monad.IO.Class (MonadIO)+ import Data.SBV.Core.Data-import Data.SBV.Core.Model      (genLiteral, genFromCW, genMkSymVar, liftQRem, liftDMod)-import Data.SBV.Core.Symbolic   (IStage(..), addSValOptGoal, registerKind)+import Data.SBV.Core.Model      (genLiteral, genFromCV, genMkSymVar, liftQRem, liftDMod)+import Data.SBV.Core.Symbolic   (IStage(..), MonadQuery, addSValOptGoal, registerKind)  import Data.SBV.Compilers.C       (compileToC', compileToCLib') import Data.SBV.Compilers.CodeGen@@ -67,7 +69,7 @@ -- | Send an arbitrary string to the solver in a query. -- Note that this is inherently dangerous as it can put the solver in an arbitrary -- state and confuse SBV. If you use this feature, you are on your own!-sendStringToSolver :: String -> Query ()+sendStringToSolver :: (MonadIO m, MonadQuery m) => String -> m () sendStringToSolver = Query.send False  -- | Retrieve multiple responses from the solver, until it responds with a user given@@ -75,13 +77,13 @@ -- If the time-out is exceeded, then we will raise an error. Note that this is inherently -- dangerous as it can put the solver in an arbitrary state and confuse SBV. If you use this -- feature, you are on your own!-retrieveResponseFromSolver :: String -> Maybe Int -> Query [String]+retrieveResponseFromSolver :: (MonadIO m, MonadQuery m) => String -> Maybe Int -> m [String] retrieveResponseFromSolver = Query.retrieveResponse  -- | Send an arbitrary string to the solver in a query, and return a response. -- Note that this is inherently dangerous as it can put the solver in an arbitrary -- state and confuse SBV.-sendRequestToSolver :: String -> Query String+sendRequestToSolver :: (MonadIO m, MonadQuery m) => String -> m String sendRequestToSolver = Query.ask  {- $coordinateSolverInfo
Data/SBV/List.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.List--- Copyright   :  (c) Joel Burget, Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.List+-- Author    : Joel Burget, Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A collection of list utilities, useful when working with symbolic lists. -- To the extent possible, the functions in this module follow those of "Data.List"@@ -13,15 +13,16 @@ -- be used as symbolic-lists. ----------------------------------------------------------------------------- -{-# LANGUAGE Rank2Types          #-} {-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE Rank2Types          #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}  module Data.SBV.List (         -- * Length, emptiness           length, null         -- * Deconstructing/Reconstructing-        , head, tail, uncons, init, singleton, listToListAt, elemAt, (.!!), implode, concat, (.:), (.++)+        , head, tail, uncons, init, singleton, listToListAt, elemAt, (.!!), implode, concat, (.:), nil, (.++)         -- * Containment         , isInfixOf, isSuffixOf, isPrefixOf         -- * Sublists@@ -33,16 +34,16 @@  import Data.SBV.Core.Data hiding (StrOp(..)) import Data.SBV.Core.Model-import Data.SBV.Utils.Boolean ((==>))  import Data.List (genericLength, genericIndex, genericDrop, genericTake) import qualified Data.List as L (tails, isSuffixOf, isPrefixOf, isInfixOf) +import Data.Proxy+ -- For doctest use only -- -- $setup -- >>> import Data.SBV.Provers.Prover (prove, sat)--- >>> import Data.SBV.Utils.Boolean  ((&&&), bnot, (<=>)) -- >>> import Data.Int -- >>> import Data.Word -- >>> :set -XOverloadedLists@@ -52,21 +53,21 @@ -- -- >>> sat $ \(l :: SList Word16) -> length l .== 2 -- Satisfiable. Model:---   s0 = [0,0] :: [SWord16]+--   s0 = [0,0] :: [Word16] -- >>> sat $ \(l :: SList Word16) -> length l .< 0 -- Unsatisfiable -- >>> prove $ \(l1 :: SList Word16) (l2 :: SList Word16) -> length l1 + length l2 .== length (l1 .++ l2) -- Q.E.D.-length :: SymWord a => SList a -> SInteger+length :: SymVal a => SList a -> SInteger length = lift1 SeqLen (Just (fromIntegral . P.length))  -- | @`null` s@ is True iff the list is empty ----- >>> prove $ \(l :: SList Word16) -> null l <=> length l .== 0+-- >>> prove $ \(l :: SList Word16) -> null l .<=> length l .== 0 -- Q.E.D.--- >>> prove $ \(l :: SList Word16) -> null l <=> l .== []+-- >>> prove $ \(l :: SList Word16) -> null l .<=> l .== [] -- Q.E.D.-null :: SymWord a => SList a -> SBool+null :: SymVal a => SList a -> SBool null l   | Just cs <- unliteral l   = literal (P.null cs)@@ -77,18 +78,18 @@ -- -- >>> prove $ \c -> head (singleton c) .== (c :: SInteger) -- Q.E.D.-head :: SymWord a => SList a -> SBV a+head :: SymVal a => SList a -> SBV a head = (`elemAt` 0)  -- | @`tail`@ returns the tail of a list. Unspecified if the list is empty. -- -- >>> prove $ \(h :: SInteger) t -> tail (singleton h .++ t) .== t -- Q.E.D.--- >>> prove $ \(l :: SList Integer) -> length l .> 0 ==> length (tail l) .== length l - 1+-- >>> prove $ \(l :: SList Integer) -> length l .> 0 .=> length (tail l) .== length l - 1 -- Q.E.D.--- >>> prove $ \(l :: SList Integer) -> bnot (null l) ==> singleton (head l) .++ tail l .== l+-- >>> prove $ \(l :: SList Integer) -> sNot (null l) .=> singleton (head l) .++ tail l .== l -- Q.E.D.-tail :: SymWord a => SList a -> SList a+tail :: SymVal a => SList a -> SList a tail l  | Just (_:cs) <- unliteral l  = literal cs@@ -96,14 +97,14 @@  = subList l 1 (length l - 1)  -- | @`uncons` returns the pair of the head and tail. Unspecified if the list is empty.-uncons :: SymWord a => SList a -> (SBV a, SList a)+uncons :: SymVal a => SList a -> (SBV a, SList a) uncons l = (head l, tail l)  -- | @`init`@ returns all but the last element of the list. Unspecified if the list is empty. -- -- >>> prove $ \(h :: SInteger) t -> init (t .++ singleton h) .== t -- Q.E.D.-init :: SymWord a => SList a -> SList a+init :: SymVal a => SList a -> SList a init l  | Just cs@(_:_) <- unliteral l  = literal $ P.init cs@@ -116,7 +117,7 @@ -- Q.E.D. -- >>> prove $ \(x :: SInteger) -> length (singleton x) .== 1 -- Q.E.D.-singleton :: SymWord a => SBV a -> SList a+singleton :: SymVal a => SBV a -> SList a singleton = lift1 SeqUnit (Just (: []))  -- | @`listToListAt` l offset@. List of length 1 at @offset@ in @l@. Unspecified if@@ -124,26 +125,26 @@ -- -- >>> prove $ \(l1 :: SList Integer) l2 -> listToListAt (l1 .++ l2) (length l1) .== listToListAt l2 0 -- Q.E.D.--- >>> sat $ \(l :: SList Word16) -> length l .>= 2 &&& listToListAt l 0 ./= listToListAt l (length l - 1)+-- >>> sat $ \(l :: SList Word16) -> length l .>= 2 .&& listToListAt l 0 ./= listToListAt l (length l - 1) -- Satisfiable. Model:---   s0 = [0,0,32] :: [SWord16]-listToListAt :: SymWord a => SList a -> SInteger -> SList a+--   s0 = [0,0,32] :: [Word16]+listToListAt :: SymVal a => SList a -> SInteger -> SList a listToListAt s offset = subList s offset 1  -- | @`elemAt` l i@ is the value stored at location @i@. Unspecified if -- index is out of bounds. ----- >>> prove $ \i -> i .>= 0 &&& i .<= 4 ==> [1,1,1,1,1] `elemAt` i .== (1::SInteger)+-- >>> prove $ \i -> i .>= 0 .&& i .<= 4 .=> [1,1,1,1,1] `elemAt` i .== (1::SInteger) -- Q.E.D.--- >>> prove $ \(l :: SList Integer) i e -> l `elemAt` i .== e ==> indexOf l (singleton e) .<= i+-- >>> prove $ \(l :: SList Integer) i e -> l `elemAt` i .== e .=> indexOf l (singleton e) .<= i -- Q.E.D.-elemAt :: forall a. SymWord a => SList a -> SInteger -> SBV a+elemAt :: forall a. SymVal a => SList a -> SInteger -> SBV a elemAt l i   | Just xs <- unliteral l, Just ci <- unliteral i, ci >= 0, ci < genericLength xs, let x = xs `genericIndex` ci   = literal x   | True   = SBV (SVal kElem (Right (cache (y (l `listToListAt` i)))))-  where kElem = kindOf (undefined :: a)+  where kElem = kindOf (Proxy @a)         kSeq  = KList kElem         -- This is trickier than it needs to be, but necessary since there's         -- no SMTLib function to extract the element from a list. Instead,@@ -152,11 +153,11 @@         y si st = do e <- internalVariable st kElem                      es <- newExpr st kSeq (SBVApp (SeqOp SeqUnit) [e])                      let esSBV = SBV (SVal kSeq (Right (cache (\_ -> return es))))-                     internalConstraint st False [] $ unSBV $ length l .> i ==> esSBV .== si+                     internalConstraint st False [] $ unSBV $ length l .> i .=> esSBV .== si                      return e  -- | Short cut for 'elemAt'-(.!!) :: SymWord a => SList a -> SInteger -> SBV a+(.!!) :: SymVal a => SList a -> SInteger -> SBV a (.!!) = elemAt  -- | @`implode` es@ is the list of length @|es|@ containing precisely those@@ -167,38 +168,45 @@ -- Q.E.D. -- >>> prove $ \(e1 :: SInteger) e2 e3 -> map (elemAt (implode [e1, e2, e3])) (map literal [0 .. 2]) .== [e1, e2, e3] -- Q.E.D.-implode :: SymWord a => [SBV a] -> SList a+implode :: SymVal a => [SBV a] -> SList a implode = foldr ((.++) . singleton) (literal [])  -- | Concatenate two lists. See also `.++`.-concat :: SymWord a => SList a -> SList a -> SList a+concat :: SymVal a => SList a -> SList a -> SList a concat x y | isConcretelyEmpty x = y            | isConcretelyEmpty y = x            | True                = lift2 SeqConcat (Just (++)) x y  -- | Prepend an element, the traditional @cons@. infixr 5 .:-(.:) :: SymWord a => SBV a -> SList a -> SList a+(.:) :: SymVal a => SBV a -> SList a -> SList a a .: as = singleton a .++ as +-- | Empty list. This value has the property that it's the only list with length 0:+--+-- >>> prove $ \(l :: SList Integer) -> length l .== 0 .<=> l .== nil+-- Q.E.D.+nil :: SymVal a => SList a+nil = []+ -- | Short cut for `concat`. ----- >>> sat $ \x y z -> length x .== 5 &&& length y .== 1 &&& x .++ y .++ z .== [1 .. 12]+-- >>> sat $ \x y z -> length x .== 5 .&& length y .== 1 .&& x .++ y .++ z .== [1 .. 12] -- Satisfiable. Model:---   s0 =      [1,2,3,4,5] :: [SInteger]---   s1 =              [6] :: [SInteger]---   s2 = [7,8,9,10,11,12] :: [SInteger]+--   s0 =      [1,2,3,4,5] :: [Integer]+--   s1 =              [6] :: [Integer]+--   s2 = [7,8,9,10,11,12] :: [Integer] infixr 5 .++-(.++) :: SymWord a => SList a -> SList a -> SList a+(.++) :: SymVal a => SList a -> SList a -> SList a (.++) = concat  -- | @`isInfixOf` sub l@. Does @l@ contain the subsequence @sub@? -- -- >>> prove $ \(l1 :: SList Integer) l2 l3 -> l2 `isInfixOf` (l1 .++ l2 .++ l3) -- Q.E.D.--- >>> prove $ \(l1 :: SList Integer) l2 -> l1 `isInfixOf` l2 &&& l2 `isInfixOf` l1 <=> l1 .== l2+-- >>> prove $ \(l1 :: SList Integer) l2 -> l1 `isInfixOf` l2 .&& l2 `isInfixOf` l1 .<=> l1 .== l2 -- Q.E.D.-isInfixOf :: SymWord a => SList a -> SList a -> SBool+isInfixOf :: SymVal a => SList a -> SList a -> SBool sub `isInfixOf` l   | isConcretelyEmpty sub   = literal True@@ -209,9 +217,9 @@ -- -- >>> prove $ \(l1 :: SList Integer) l2 -> l1 `isPrefixOf` (l1 .++ l2) -- Q.E.D.--- >>> prove $ \(l1 :: SList Integer) l2 -> l1 `isPrefixOf` l2 ==> subList l2 0 (length l1) .== l1+-- >>> prove $ \(l1 :: SList Integer) l2 -> l1 `isPrefixOf` l2 .=> subList l2 0 (length l1) .== l1 -- Q.E.D.-isPrefixOf :: SymWord a => SList a -> SList a -> SBool+isPrefixOf :: SymVal a => SList a -> SList a -> SBool pre `isPrefixOf` l   | isConcretelyEmpty pre   = literal True@@ -222,9 +230,9 @@ -- -- >>> prove $ \(l1 :: SList Word16) l2 -> l2 `isSuffixOf` (l1 .++ l2) -- Q.E.D.--- >>> prove $ \(l1 :: SList Word16) l2 -> l1 `isSuffixOf` l2 ==> subList l2 (length l2 - length l1) (length l1) .== l1+-- >>> prove $ \(l1 :: SList Word16) l2 -> l1 `isSuffixOf` l2 .=> subList l2 (length l2 - length l1) (length l1) .== l1 -- Q.E.D.-isSuffixOf :: SymWord a => SList a -> SList a -> SBool+isSuffixOf :: SymVal a => SList a -> SList a -> SBool suf `isSuffixOf` l   | isConcretelyEmpty suf   = literal True@@ -233,9 +241,9 @@  -- | @`take` len l@. Corresponds to Haskell's `take` on symbolic lists. ----- >>> prove $ \(l :: SList Integer) i -> i .>= 0 ==> length (take i l) .<= i+-- >>> prove $ \(l :: SList Integer) i -> i .>= 0 .=> length (take i l) .<= i -- Q.E.D.-take :: SymWord a => SInteger -> SList a -> SList a+take :: SymVal a => SInteger -> SList a -> SList a take i l = ite (i .<= 0)        (literal [])          $ ite (i .>= length l) l          $ subList l 0 i@@ -246,7 +254,7 @@ -- Q.E.D. -- >>> prove $ \(l :: SList Word16) i -> take i l .++ drop i l .== l -- Q.E.D.-drop :: SymWord a => SInteger -> SList a -> SList a+drop :: SymVal a => SInteger -> SList a -> SList a drop i s = ite (i .>= ls) (literal [])          $ ite (i .<= 0)  s          $ subList s i (ls - i)@@ -256,7 +264,7 @@ -- This function is under-specified when the offset is outside the range of positions in @s@ or @len@ -- is negative or @offset+len@ exceeds the length of @s@. ----- >>> prove $ \(l :: SList Integer) i -> i .>= 0 &&& i .< length l ==> subList l 0 i .++ subList l i (length l - i) .== l+-- >>> prove $ \(l :: SList Integer) i -> i .>= 0 .&& i .< length l .=> subList l 0 i .++ subList l i (length l - i) .== l -- Q.E.D. -- >>> sat  $ \i j -> subList [1..5] i j .== ([2..4] :: SList Integer) -- Satisfiable. Model:@@ -264,7 +272,7 @@ --   s1 = 3 :: Integer -- >>> sat  $ \i j -> subList [1..5] i j .== ([6..7] :: SList Integer) -- Unsatisfiable-subList :: SymWord a => SList a -> SInteger -> SInteger -> SList a+subList :: SymVal a => SList a -> SInteger -> SInteger -> SList a subList l offset len   | Just c  <- unliteral l                   -- a constant list   , Just o  <- unliteral offset              -- a constant offset@@ -280,11 +288,11 @@  -- | @`replace` l src dst@. Replace the first occurrence of @src@ by @dst@ in @s@ ----- >>> prove $ \l -> replace [1..5] l [6..10] .== [6..10] ==> l .== ([1..5] :: SList Word8)+-- >>> prove $ \l -> replace [1..5] l [6..10] .== [6..10] .=> l .== ([1..5] :: SList Word8) -- Q.E.D.--- >>> prove $ \(l1 :: SList Integer) l2 l3 -> length l2 .> length l1 ==> replace l1 l2 l3 .== l1+-- >>> prove $ \(l1 :: SList Integer) l2 l3 -> length l2 .> length l1 .=> replace l1 l2 l3 .== l1 -- Q.E.D.-replace :: SymWord a => SList a -> SList a -> SList a -> SList a+replace :: SymVal a => SList a -> SList a -> SList a -> SList a replace l src dst   | Just b <- unliteral src, P.null b   -- If src is null, simply prepend   = dst .++ l@@ -303,15 +311,15 @@ -- | @`indexOf` l sub@. Retrieves first position of @sub@ in @l@, @-1@ if there are no occurrences. -- Equivalent to @`offsetIndexOf` l sub 0@. ----- >>> prove $ \(l :: SList Int8) i -> i .> 0 &&& i .< length l ==> indexOf l (subList l i 1) .<= i+-- >>> prove $ \(l :: SList Int8) i -> i .> 0 .&& i .< length l .=> indexOf l (subList l i 1) .<= i -- Q.E.D.--- >>> prove $ \(l :: SList Word16) i -> i .> 0 &&& i .< length l ==> indexOf l (subList l i 1) .== i+-- >>> prove $ \(l :: SList Word16) i -> i .> 0 .&& i .< length l .=> indexOf l (subList l i 1) .== i -- Falsifiable. Counter-example:---   s0 = [32,0,0] :: [SWord16]+--   s0 = [32,0,0] :: [Word16] --   s1 =        2 :: Integer--- >>> prove $ \(l1 :: SList Word16) l2 -> length l2 .> length l1 ==> indexOf l1 l2 .== -1+-- >>> prove $ \(l1 :: SList Word16) l2 -> length l2 .> length l1 .=> indexOf l1 l2 .== -1 -- Q.E.D.-indexOf :: SymWord a => SList a -> SList a -> SInteger+indexOf :: SymVal a => SList a -> SList a -> SInteger indexOf s sub = offsetIndexOf s sub 0  -- | @`offsetIndexOf` l sub offset@. Retrieves first position of @sub@ at or@@ -319,11 +327,11 @@ -- -- >>> prove $ \(l :: SList Int8) sub -> offsetIndexOf l sub 0 .== indexOf l sub -- Q.E.D.--- >>> prove $ \(l :: SList Int8) sub i -> i .>= length l &&& length sub .> 0 ==> offsetIndexOf l sub i .== -1+-- >>> prove $ \(l :: SList Int8) sub i -> i .>= length l .&& length sub .> 0 .=> offsetIndexOf l sub i .== -1 -- Q.E.D.--- >>> prove $ \(l :: SList Int8) sub i -> i .> length l ==> offsetIndexOf l sub i .== -1+-- >>> prove $ \(l :: SList Int8) sub i -> i .> length l .=> offsetIndexOf l sub i .== -1 -- Q.E.D.-offsetIndexOf :: SymWord a => SList a -> SList a -> SInteger -> SInteger+offsetIndexOf :: SymVal a => SList a -> SList a -> SInteger -> SInteger offsetIndexOf s sub offset   | Just c <- unliteral s        -- a constant list   , Just n <- unliteral sub      -- a constant search pattern@@ -336,54 +344,54 @@   = lift3 SeqIndexOf Nothing s sub offset  -- | Lift a unary operator over lists.-lift1 :: forall a b. (SymWord a, SymWord b) => SeqOp -> Maybe (a -> b) -> SBV a -> SBV b+lift1 :: forall a b. (SymVal a, SymVal b) => SeqOp -> Maybe (a -> b) -> SBV a -> SBV b lift1 w mbOp a   | Just cv <- concEval1 mbOp a   = cv   | True   = SBV $ SVal k $ Right $ cache r-  where k = kindOf (undefined :: b)-        r st = do swa <- sbvToSW st a-                  newExpr st k (SBVApp (SeqOp w) [swa])+  where k = kindOf (Proxy @b)+        r st = do sva <- sbvToSV st a+                  newExpr st k (SBVApp (SeqOp w) [sva])  -- | Lift a binary operator over lists.-lift2 :: forall a b c. (SymWord a, SymWord b, SymWord c) => SeqOp -> Maybe (a -> b -> c) -> SBV a -> SBV b -> SBV c+lift2 :: forall a b c. (SymVal a, SymVal b, SymVal c) => SeqOp -> Maybe (a -> b -> c) -> SBV a -> SBV b -> SBV c lift2 w mbOp a b   | Just cv <- concEval2 mbOp a b   = cv   | True   = SBV $ SVal k $ Right $ cache r-  where k = kindOf (undefined :: c)-        r st = do swa <- sbvToSW st a-                  swb <- sbvToSW st b-                  newExpr st k (SBVApp (SeqOp w) [swa, swb])+  where k = kindOf (Proxy @c)+        r st = do sva <- sbvToSV st a+                  svb <- sbvToSV st b+                  newExpr st k (SBVApp (SeqOp w) [sva, svb])  -- | Lift a ternary operator over lists.-lift3 :: forall a b c d. (SymWord a, SymWord b, SymWord c, SymWord d) => SeqOp -> Maybe (a -> b -> c -> d) -> SBV a -> SBV b -> SBV c -> SBV d+lift3 :: forall a b c d. (SymVal a, SymVal b, SymVal c, SymVal d) => SeqOp -> Maybe (a -> b -> c -> d) -> SBV a -> SBV b -> SBV c -> SBV d lift3 w mbOp a b c   | Just cv <- concEval3 mbOp a b c   = cv   | True   = SBV $ SVal k $ Right $ cache r-  where k = kindOf (undefined :: d)-        r st = do swa <- sbvToSW st a-                  swb <- sbvToSW st b-                  swc <- sbvToSW st c-                  newExpr st k (SBVApp (SeqOp w) [swa, swb, swc])+  where k = kindOf (Proxy @d)+        r st = do sva <- sbvToSV st a+                  svb <- sbvToSV st b+                  svc <- sbvToSV st c+                  newExpr st k (SBVApp (SeqOp w) [sva, svb, svc])  -- | Concrete evaluation for unary ops-concEval1 :: (SymWord a, SymWord b) => Maybe (a -> b) -> SBV a -> Maybe (SBV b)+concEval1 :: (SymVal a, SymVal b) => Maybe (a -> b) -> SBV a -> Maybe (SBV b) concEval1 mbOp a = literal <$> (mbOp <*> unliteral a)  -- | Concrete evaluation for binary ops-concEval2 :: (SymWord a, SymWord b, SymWord c) => Maybe (a -> b -> c) -> SBV a -> SBV b -> Maybe (SBV c)+concEval2 :: (SymVal a, SymVal b, SymVal c) => Maybe (a -> b -> c) -> SBV a -> SBV b -> Maybe (SBV c) concEval2 mbOp a b = literal <$> (mbOp <*> unliteral a <*> unliteral b)  -- | Concrete evaluation for ternary ops-concEval3 :: (SymWord a, SymWord b, SymWord c, SymWord d) => Maybe (a -> b -> c -> d) -> SBV a -> SBV b -> SBV c -> Maybe (SBV d)+concEval3 :: (SymVal a, SymVal b, SymVal c, SymVal d) => Maybe (a -> b -> c -> d) -> SBV a -> SBV b -> SBV c -> Maybe (SBV d) concEval3 mbOp a b c = literal <$> (mbOp <*> unliteral a <*> unliteral b <*> unliteral c)  -- | Is the list concretely known empty?-isConcretelyEmpty :: SymWord a => SList a -> Bool+isConcretelyEmpty :: SymVal a => SList a -> Bool isConcretelyEmpty sl | Just l <- unliteral sl = P.null l                      | True                   = False
− Data/SBV/List/Bounded.hs 
@@ -1,145 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.List.Bounded--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental------ A collection of bounded list utilities, useful when working with symbolic lists.--- These functions all take a concrete bound, and operate on the prefix of a symbolic--- list that is at most that long. Due to limitations on writing recursive functions--- over lists (the classic symbolic termination problem), we cannot write arbitrary--- recursive programs on symbolic lists. But most of the time all we need is a--- bounded prefix of this list, at which point these functions come in handy.----------------------------------------------------------------------------------{-# LANGUAGE OverloadedLists     #-}-{-# LANGUAGE Rank2Types          #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Data.SBV.List.Bounded (-     -- * General folds-     bfoldr, bfoldrM, bfoldl, bfoldlM-     -- * Map, filter, zipWith, elem-   , bmap, bmapM, bfilter, bzipWith, belem-     -- * Aggregates-   , bsum, bprod, band, bor, bany, ball, bmaximum, bminimum-     -- * Miscellaneous: Reverse and sort-   , breverse, bsort-   )-   where--import Data.SBV-import Data.SBV.List ((.:), (.++))-import qualified Data.SBV.List as L---- | Case analysis on a symbolic list. (Not exported.)-lcase :: (SymWord a, Mergeable b) => SList a -> b -> (SBV a -> SList a -> b) -> b-lcase s e c = ite (L.null s) e (c (L.head s) (L.tail s))---- | Bounded fold from the right.-bfoldr :: (SymWord a, SymWord b) => Int -> (SBV a -> SBV b -> SBV b) -> SBV b -> SList a -> SBV b-bfoldr cnt f b = go (cnt `max` 0)-  where go 0 _ = b-        go i s = lcase s b (\h t -> h `f` go (i-1) t)---- | Bounded monadic fold from the right.-bfoldrM :: forall a b m. (SymWord a, SymWord b, Monad m, Mergeable (m (SBV b)))-        => Int -> (SBV a -> SBV b -> m (SBV b)) -> SBV b -> SList a -> m (SBV b)-bfoldrM cnt f b = go (cnt `max` 0)-  where go :: Int -> SList a -> m (SBV b)-        go 0 _ = return b-        go i s = lcase s (return b) (\h t -> f h =<< go (i-1) t)---- | Bounded fold from the left.-bfoldl :: (SymWord a, SymWord b) => Int -> (SBV b -> SBV a -> SBV b) -> SBV b -> SList a -> SBV b-bfoldl cnt f = go (cnt `max` 0)-  where go 0 b _ = b-        go i b s = lcase s b (\h t -> go (i-1) (b `f` h) t)---- | Bounded monadic fold from the left.-bfoldlM :: forall a b m. (SymWord a, SymWord b, Monad m, Mergeable (m (SBV b)))-        => Int -> (SBV b -> SBV a -> m (SBV b)) -> SBV b -> SList a -> m (SBV b)-bfoldlM cnt f = go (cnt `max` 0)-  where go :: Int -> SBV b -> SList a -> m (SBV b)-        go 0 b _ = return b-        go i b s = lcase s (return b) (\h t -> do { fbh <- f b h; go (i-1) fbh t })---- | Bounded sum.-bsum :: (SymWord a, Num a) => Int -> SList a -> SBV a-bsum i = bfoldl i (+) 0---- | Bounded product.-bprod :: (SymWord a, Num a) => Int -> SList a -> SBV a-bprod i = bfoldl i (*) 1---- | Bounded map.-bmap :: (SymWord a, SymWord b) => Int -> (SBV a -> SBV b) -> SList a -> SList b-bmap i f = bfoldr i (\x -> (f x .:)) []---- | Bounded monadic map.-bmapM :: (SymWord a, SymWord b, Monad m, Mergeable (m (SBV [b])))-      => Int -> (SBV a -> m (SBV b)) -> SList a -> m (SList b)-bmapM i f = bfoldrM i (\a bs -> (.:) <$> f a <*> pure bs) []---- | Bounded filter.-bfilter :: SymWord a => Int -> (SBV a -> SBool) -> SList a -> SList a-bfilter i f = bfoldr i (\x y -> ite (f x) (x .: y) y) []---- | Bounded logical and-band :: Int -> SList Bool -> SBool-band i = bfoldr i (&&&) (true  :: SBool)---- | Bounded logical or-bor :: Int -> SList Bool -> SBool-bor i = bfoldr i (|||) (false :: SBool)---- | Bounded any-bany :: SymWord a => Int -> (SBV a -> SBool) -> SList a -> SBool-bany i f = bor i . bmap i f---- | Bounded all-ball :: SymWord a => Int -> (SBV a -> SBool) -> SList a -> SBool-ball i f = band i . bmap i f---- | Bounded maximum. Undefined if list is empty.-bmaximum :: SymWord a => Int -> SList a -> SBV a-bmaximum i l = bfoldl (i-1) smax (L.head l) (L.tail l)---- | Bounded minimum. Undefined if list is empty.-bminimum :: SymWord a => Int -> SList a -> SBV a-bminimum i l = bfoldl (i-1) smin (L.head l) (L.tail l)---- | Bounded zipWith-bzipWith :: (SymWord a, SymWord b, SymWord c) => Int -> (SBV a -> SBV b -> SBV c) -> SList a -> SList b -> SList c-bzipWith cnt f = go (cnt `max` 0)-   where go 0 _  _  = []-         go i xs ys = ite (L.null xs ||| L.null ys)-                          []-                          (f (L.head xs) (L.head ys) .: go (i-1) (L.tail xs) (L.tail ys))---- | Bounded element check-belem :: SymWord a => Int -> SBV a -> SList a -> SBool-belem i e = bany i (e .==)---- | Bounded reverse-breverse :: SymWord a => Int -> SList a -> SList a-breverse cnt = bfoldr cnt (\a b -> b .++ L.singleton a) []---- | Bounded paramorphism (not exported).-bpara :: (SymWord a, SymWord b) => Int -> (SBV a -> SBV [a] -> SBV b -> SBV b) -> SBV b -> SList a -> SBV b-bpara cnt f b = go (cnt `max` 0)-  where go 0 _ = b-        go i s = lcase s b (\h t -> f h t (go (i-1) t))---- | Insert an element into a sorted list (not exported).-binsert :: SymWord a => Int -> SBV a -> SList a -> SList a-binsert cnt a = bpara cnt f (L.singleton a)-  where f sortedHd sortedTl sortedTl' = ite (a .< sortedHd)-                                            (a .: sortedHd .: sortedTl)-                                            (sortedHd .: sortedTl')---- | Bounded insertion sort-bsort :: SymWord a => Int -> SList a -> SList a-bsort cnt = bfoldr cnt (binsert cnt) []
Data/SBV/Provers/ABC.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Provers.ABC--- Copyright   :  (c) Adam Foltzer--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Provers.ABC+-- Author    : Adam Foltzer+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The connection to the ABC verification and synthesis tool -----------------------------------------------------------------------------@@ -23,6 +23,7 @@ abc = SMTSolver {            name         = ABC          , executable   = "abc"+         , preprocess   = id          , options      = const ["-S", "%blast; &sweep -C 5000; &syn4; &cec -s -m -C 2000"]          , engine       = standardEngine "SBV_ABC" "SBV_ABC_OPTIONS"          , capabilities = SolverCapabilities {
Data/SBV/Provers/Boolector.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Provers.Boolector--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Provers.Boolector+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The connection to the Boolector SMT solver -----------------------------------------------------------------------------@@ -21,6 +21,7 @@ boolector = SMTSolver {            name         = Boolector          , executable   = "boolector"+         , preprocess   = id          , options      = const ["--smt2", "--smt2-model", "--no-exit-codes", "--incremental"]          , engine       = standardEngine "SBV_BOOLECTOR" "SBV_BOOLECTOR_OPTIONS"          , capabilities = SolverCapabilities {
Data/SBV/Provers/CVC4.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Provers.CVC4--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Provers.CVC4+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The connection to the CVC4 SMT solver -----------------------------------------------------------------------------@@ -13,6 +13,8 @@  module Data.SBV.Provers.CVC4(cvc4) where +import Data.Char (isSpace)+ import Data.SBV.Core.Data import Data.SBV.SMT.SMT @@ -23,6 +25,7 @@ cvc4 = SMTSolver {            name         = CVC4          , executable   = "cvc4"+         , preprocess   = clean          , options      = const ["--lang", "smt", "--incremental", "--interactive", "--no-interactive-prompt"]          , engine       = standardEngine "SBV_CVC4" "SBV_CVC4_OPTIONS"          , capabilities = SolverCapabilities {@@ -39,3 +42,13 @@                               , supportsFlattenedSequences = Nothing                               }          }+  where -- CVC4 wants all input on one line+        clean = map simpleSpace . noComment++        noComment ""       = ""+        noComment (';':cs) = noComment $ dropWhile (/= '\n') cs+        noComment (c:cs)   = c : noComment cs++        simpleSpace c+          | isSpace c = ' '+          | True      = c
Data/SBV/Provers/MathSAT.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Provers.MathSAT--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Provers.MathSAT+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The connection to the MathSAT SMT solver -----------------------------------------------------------------------------@@ -25,6 +25,7 @@ mathSAT = SMTSolver {            name         = MathSAT          , executable   = "mathsat"+         , preprocess   = id          , options      = modConfig ["-input=smt2", "-theory.fp.minmax_zero_mode=4"]          , engine       = standardEngine "SBV_MATHSAT" "SBV_MATHSAT_OPTIONS"          , capabilities = SolverCapabilities {
Data/SBV/Provers/Prover.hs view
@@ -1,22 +1,28 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Provers.Prover--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Provers.Prover+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Provable abstraction and the connection to SMT solvers ----------------------------------------------------------------------------- -{-# LANGUAGE CPP                  #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE NamedFieldPuns       #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeSynonymInstances  #-}  module Data.SBV.Provers.Prover (-         SMTSolver(..), SMTConfig(..), Predicate, Provable(..), Goal+         SMTSolver(..), SMTConfig(..), Predicate+       , MProvable(..), Provable, proveWithAll, proveWithAny , satWithAll, satWithAny+       , generateSMTBenchmark+       , Goal        , ThmResult(..), SatResult(..), AllSatResult(..), SafeResult(..), OptimizeResult(..), SMTResult(..)        , SExecutable(..), isSafe        , runSMT, runSMTWith@@ -26,8 +32,9 @@        ) where  -import Control.Monad   (when, unless)-import Control.DeepSeq (rnf, NFData(..))+import Control.Monad          (when, unless)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.DeepSeq        (rnf, NFData(..))  import Control.Concurrent.Async (async, waitAny, asyncThreadId, Async) import Control.Exception (finally, throwTo, AsyncException(ThreadKilled))@@ -47,10 +54,11 @@ import Data.SBV.Core.Data import Data.SBV.Core.Symbolic import Data.SBV.SMT.SMT+import Data.SBV.Utils.ExtractIO import Data.SBV.Utils.TDiff import Data.SBV.Utils.PrettyNum -import qualified Data.SBV.Control       as Control+import qualified Data.SBV.Trans.Control as Control import qualified Data.SBV.Control.Query as Control import qualified Data.SBV.Control.Utils as Control @@ -131,75 +139,49 @@ -- each element is either a symbolic type or up-to a 7-tuple of symbolic-types. So -- predicates can be constructed from almost arbitrary Haskell functions that have arbitrary -- shapes. (See the instance declarations below.)-class Provable a where-  -- | Turns a value into a universally quantified predicate, internally naming the inputs.-  -- In this case the sbv library will use names of the form @s1, s2@, etc. to name these variables-  -- Example:-  ---  -- >  forAll_ $ \(x::SWord8) y -> x `shiftL` 2 .== y-  ---  -- is a predicate with two arguments, captured using an ordinary Haskell function. Internally,-  -- @x@ will be named @s0@ and @y@ will be named @s1@.-  forAll_ :: a -> Predicate+class ExtractIO m => MProvable m a where+  -- | Generalization of 'Data.SBV.forAll_'+  forAll_ :: a -> SymbolicT m SBool -  -- | Turns a value into a predicate, allowing users to provide names for the inputs.-  -- If the user does not provide enough number of names for the variables, the remaining ones-  -- will be internally generated. Note that the names are only used for printing models and has no-  -- other significance; in particular, we do not check that they are unique. Example:-  ---  -- >  forAll ["x", "y"] $ \(x::SWord8) y -> x `shiftL` 2 .== y-  ---  -- This is the same as above, except the variables will be named @x@ and @y@ respectively,-  -- simplifying the counter-examples when they are printed.-  forAll  :: [String] -> a -> Predicate+  -- | Generalization of 'Data.SBV.forAll'+  forAll  :: [String] -> a -> SymbolicT m SBool -  -- | Turns a value into an existentially quantified predicate. (Indeed, 'exists' would have been-  -- a better choice here for the name, but alas it's already taken.)-  forSome_ :: a -> Predicate+  -- | Generalization of 'Data.SBV.forSome_'+  forSome_ :: a -> SymbolicT m SBool -  -- | Version of 'forSome' that allows user defined names.-  forSome :: [String] -> a -> Predicate+  -- | Generalization of 'Data.SBV.forSome'+  forSome :: [String] -> a -> SymbolicT m SBool -  -- | Prove a predicate, using the default solver.-  prove :: a -> IO ThmResult+  -- | Generalization of 'Data.SBV.prove'+  prove :: a -> m ThmResult   prove = proveWith defaultSMTCfg -  -- | Prove the predicate using the given SMT-solver.-  proveWith :: SMTConfig -> a -> IO ThmResult+  -- | Generalization of 'Data.SBV.proveWith'+  proveWith :: SMTConfig -> a -> m ThmResult   proveWith = runWithQuery False $ checkNoOptimizations >> ThmResult <$> Control.getSMTResult -  -- | Find a satisfying assignment for a predicate, using the default solver.-  sat :: a -> IO SatResult+  -- | Generalization of 'Data.SBV.sat'+  sat :: a -> m SatResult   sat = satWith defaultSMTCfg -  -- | Find a satisfying assignment using the given SMT-solver.-  satWith :: SMTConfig -> a -> IO SatResult+  -- | Generalization of 'Data.SBV.satWith'+  satWith :: SMTConfig -> a -> m SatResult   satWith = runWithQuery True $ checkNoOptimizations >> SatResult <$> Control.getSMTResult -  -- | Find all satisfying assignments, using the default solver. See 'allSatWith' for details.-  allSat :: a -> IO AllSatResult+  -- | Generalization of 'Data.SBV.allSat'+  allSat :: a -> m AllSatResult   allSat = allSatWith defaultSMTCfg -  -- | Return all satisfying assignments for a predicate, equivalent to @'allSatWith' 'defaultSMTCfg'@.-  -- Note that this call will block until all satisfying assignments are found. If you have a problem-  -- with infinitely many satisfying models (consider 'SInteger') or a very large number of them, you-  -- might have to wait for a long time. To avoid such cases, use the 'allSatMaxModelCount' parameter-  -- in the configuration.-  ---  -- NB. Uninterpreted constant/function values and counter-examples for array values are ignored for-  -- the purposes of 'allSat'. That is, only the satisfying assignments modulo uninterpreted functions and-  -- array inputs will be returned. This is due to the limitation of not having a robust means of getting a-  -- function counter-example back from the SMT solver.-  --  Find all satisfying assignments using the given SMT-solver-  allSatWith :: SMTConfig -> a -> IO AllSatResult+  -- | Generalization of 'Data.SBV.allSatWith'+  allSatWith :: SMTConfig -> a -> m AllSatResult   allSatWith = runWithQuery True $ checkNoOptimizations >> AllSatResult <$> Control.getAllSatResult -  -- | Optimize a given collection of `Objective`s-  optimize :: OptimizeStyle -> a -> IO OptimizeResult+  -- | Generalization of 'Data.SBV.optimize'+  optimize :: OptimizeStyle -> a -> m OptimizeResult   optimize = optimizeWith defaultSMTCfg -  -- | Optimizes the objectives using the given SMT-solver.-  optimizeWith :: SMTConfig -> OptimizeStyle -> a -> IO OptimizeResult+  -- | Generalization of 'Data.SBV.optimizeWith'+  optimizeWith :: SMTConfig -> OptimizeStyle -> a -> m OptimizeResult   optimizeWith config style = runWithQuery True opt config     where opt = do objectives <- Control.getObjectives                    qinps      <- Control.getQuantifiedInputs@@ -223,9 +205,9 @@                          | null universals = error "Data.SBV: Impossible happened! Universal optimization with no universals!"                          | True            = minimum (map (nodeId . fst) universals) -                       nodeId (SW _ n) = n+                       nodeId (SV _ n) = n -                       mappings :: M.Map SW SBVExpr+                       mappings :: M.Map SV SBVExpr                        mappings = M.fromList (S.toList (pgmAssignments spgm))                         chaseUniversal entry = map snd $ go entry []@@ -283,7 +265,7 @@                                -- if the goal is a signed-BV, then we need to add 2^{n-1} to the maximal value                                -- is properly placed in the correct range. See http://github.com/Z3Prover/z3/issues/1339 for                                -- details on why we have to do this:-                               signAdjust :: SW -> String -> String+                               signAdjust :: SV -> String -> String                                signAdjust v o = case kindOf v of                                                   -- NB. The order we spit out the addition here (i.e., "bvadd v constant")                                                   -- is important as we parse it back in precisely that form when we@@ -291,8 +273,8 @@                                                   KBounded True sz -> "(bvadd " ++ o ++ " " ++ adjust sz ++ ")"                                                   _                -> o                                   where adjust :: Int -> String-                                        adjust sz = cwToSMTLib RoundNearestTiesToEven -- rounding mode doesn't matter here, just pick one-                                                              (mkConstCW (KBounded False sz)+                                        adjust sz = cvToSMTLib RoundNearestTiesToEven -- rounding mode doesn't matter here, just pick one+                                                              (mkConstCV (KBounded False sz)                                                                          ((2::Integer)^(fromIntegral sz - (1::Integer))))                     mapM_ (Control.send True) optimizerDirectives@@ -302,26 +284,28 @@                       Independent   -> IndependentResult   <$> Control.getIndependentOptResults (map objectiveName objectives)                       Pareto mbN    -> ParetoResult        <$> Control.getParetoOptResults mbN -  -- | Check if the constraints given are consistent, using the default solver.-  isVacuous :: a -> IO Bool+  -- | Generalization of 'Data.SBV.isVacuous'+  isVacuous :: a -> m Bool   isVacuous = isVacuousWith defaultSMTCfg -  -- | Determine if the constraints are vacuous using the given SMT-solver.-  isVacuousWith :: SMTConfig -> a -> IO Bool+  -- | Generalization of 'Data.SBV.isVacuousWith'+  isVacuousWith :: SMTConfig -> a -> m Bool   isVacuousWith cfg a = -- NB. Can't call runWithQuery since last constraint would become the implication!-                        fst <$> runSymbolic (SMTMode ISetup True cfg) (forSome_ a >> Control.query check)-     where check = do cs <- Control.checkSat-                      case cs of-                        Control.Unsat -> return True-                        Control.Sat   -> return False-                        Control.Unk   -> error "SBV: isVacuous: Solver returned unknown!"+       fst <$> runSymbolic (SMTMode ISetup True cfg) (forSome_ a >> Control.query check)+     where+       check :: QueryT m Bool+       check = do cs <- Control.checkSat+                  case cs of+                    Control.Unsat -> return True+                    Control.Sat   -> return False+                    Control.Unk   -> error "SBV: isVacuous: Solver returned unknown!" -  -- | Checks theoremhood using the default solver.-  isTheorem :: a -> IO Bool+  -- | Generalization of 'Data.SBV.isTheorem'+  isTheorem :: a -> m Bool   isTheorem = isTheoremWith defaultSMTCfg -  -- | Check whether a given property is a theorem.-  isTheoremWith :: SMTConfig -> a -> IO Bool+  -- | Generalization of 'Data.SBV.isTheoremWith'+  isTheoremWith :: SMTConfig -> a -> m Bool   isTheoremWith cfg p = do r <- proveWith cfg p                            case r of                              ThmResult Unsatisfiable{} -> return True@@ -329,61 +313,65 @@                              _                         -> error $ "SBV.isTheorem: Received:\n" ++ show r  -  -- | Checks satisfiability using the default solver.-  isSatisfiable :: a -> IO Bool+  -- | Generalization of 'Data.SBV.isSatisfiable'+  isSatisfiable :: a -> m Bool   isSatisfiable = isSatisfiableWith defaultSMTCfg -  -- | Check whether a given property is satisfiable.-  isSatisfiableWith :: SMTConfig -> a -> IO Bool+  -- | Generalization of 'Data.SBV.isSatisfiableWith'+  isSatisfiableWith :: SMTConfig -> a -> m Bool   isSatisfiableWith cfg p = do r <- satWith cfg p                                case r of                                  SatResult Satisfiable{}   -> return True                                  SatResult Unsatisfiable{} -> return False                                  _                         -> error $ "SBV.isSatisfiable: Received: " ++ show r -  -- | Prove a property with multiple solvers, running them in separate threads. The-  -- results will be returned in the order produced.-  proveWithAll :: [SMTConfig] -> a -> IO [(Solver, NominalDiffTime, ThmResult)]-  proveWithAll  = (`sbvWithAll` proveWith)+-- | `Provable` is specialization of `MProvable` to the `IO` monad. Unless you are using+-- transformers explicitly, this is the type you should prefer.+type Provable = MProvable IO -  -- | Prove a property with multiple solvers, running them in separate threads. Only-  -- the result of the first one to finish will be returned, remaining threads will be killed.-  -- Note that we send a @ThreadKilled@ to the losing processes, but we do *not* actually wait for them-  -- to finish. In rare cases this can lead to zombie processes. In previous experiments, we found-  -- that some processes take their time to terminate. So, this solution favors quick turnaround.-  proveWithAny :: [SMTConfig] -> a -> IO (Solver, NominalDiffTime, ThmResult)-  proveWithAny  = (`sbvWithAny` proveWith)+-- | Prove a property with multiple solvers, running them in separate threads. The+-- results will be returned in the order produced.+proveWithAll :: Provable a => [SMTConfig] -> a -> IO [(Solver, NominalDiffTime, ThmResult)]+proveWithAll  = (`sbvWithAll` proveWith) -  -- | Find a satisfying assignment to a property with multiple solvers, running them in separate threads. The-  -- results will be returned in the order produced.-  satWithAll :: [SMTConfig] -> a -> IO [(Solver, NominalDiffTime, SatResult)]-  satWithAll = (`sbvWithAll` satWith)+-- | Prove a property with multiple solvers, running them in separate threads. Only+-- the result of the first one to finish will be returned, remaining threads will be killed.+-- Note that we send a @ThreadKilled@ to the losing processes, but we do *not* actually wait for them+-- to finish. In rare cases this can lead to zombie processes. In previous experiments, we found+-- that some processes take their time to terminate. So, this solution favors quick turnaround.+proveWithAny :: Provable a => [SMTConfig] -> a -> IO (Solver, NominalDiffTime, ThmResult)+proveWithAny  = (`sbvWithAny` proveWith) -  -- | Find a satisfying assignment to a property with multiple solvers, running them in separate threads. Only-  -- the result of the first one to finish will be returned, remaining threads will be killed.-  -- Note that we send a @ThreadKilled@ to the losing processes, but we do *not* actually wait for them-  -- to finish. In rare cases this can lead to zombie processes. In previous experiments, we found-  -- that some processes take their time to terminate. So, this solution favors quick turnaround.-  satWithAny :: [SMTConfig] -> a -> IO (Solver, NominalDiffTime, SatResult)-  satWithAny    = (`sbvWithAny` satWith)+-- | Find a satisfying assignment to a property with multiple solvers, running them in separate threads. The+-- results will be returned in the order produced.+satWithAll :: Provable a => [SMTConfig] -> a -> IO [(Solver, NominalDiffTime, SatResult)]+satWithAll = (`sbvWithAll` satWith) -  -- | Create an SMT-Lib2 benchmark. The 'Bool' argument controls whether this is a SAT instance, i.e.,-  -- translate the query directly, or a PROVE instance, i.e., translate the negated query.-  generateSMTBenchmark :: Bool -> a -> IO String-  generateSMTBenchmark isSat a = do-        t <- getZonedTime+-- | Find a satisfying assignment to a property with multiple solvers, running them in separate threads. Only+-- the result of the first one to finish will be returned, remaining threads will be killed.+-- Note that we send a @ThreadKilled@ to the losing processes, but we do *not* actually wait for them+-- to finish. In rare cases this can lead to zombie processes. In previous experiments, we found+-- that some processes take their time to terminate. So, this solution favors quick turnaround.+satWithAny :: Provable a => [SMTConfig] -> a -> IO (Solver, NominalDiffTime, SatResult)+satWithAny    = (`sbvWithAny` satWith) -        let comments = ["Automatically created by SBV on " ++ show t]-            cfg      = defaultSMTCfg { smtLibVersion = SMTLib2 }+-- | Create an SMT-Lib2 benchmark. The 'Bool' argument controls whether this is a SAT instance, i.e.,+-- translate the query directly, or a PROVE instance, i.e., translate the negated query.+generateSMTBenchmark :: (MonadIO m, MProvable m a) => Bool -> a -> m String+generateSMTBenchmark isSat a = do+      t <- liftIO getZonedTime -        (_, res) <- runSymbolic (SMTMode ISetup isSat cfg) $ (if isSat then forSome_ else forAll_) a >>= output+      let comments = ["Automatically created by SBV on " ++ show t]+          cfg      = defaultSMTCfg { smtLibVersion = SMTLib2 } -        let SMTProblem{smtLibPgm} = Control.runProofOn (SMTMode IRun isSat cfg) comments res-            out                   = show (smtLibPgm cfg)+      (_, res) <- runSymbolic (SMTMode ISetup isSat cfg) $ (if isSat then forSome_ else forAll_) a >>= output -        return $ out ++ "\n(check-sat)\n"+      let SMTProblem{smtLibPgm} = Control.runProofOn (SMTMode IRun isSat cfg) QueryInternal comments res+          out                   = show (smtLibPgm cfg) -checkNoOptimizations :: Query ()+      return $ out ++ "\n(check-sat)\n"++checkNoOptimizations :: MonadIO m => QueryT m () checkNoOptimizations = do objectives <- Control.getObjectives                            unless (null objectives) $@@ -392,7 +380,15 @@                                                 , "*** Use \"optimize\"/\"optimizeWith\" to calculate optimal satisfaction!"                                                 ] -instance Provable Predicate where+-- If we get a program producing nothing (i.e., Symbolic ()), pretend it simply returns True.+-- This is useful since min/max calls and constraints will provide the context+instance ExtractIO m => MProvable m (SymbolicT m ()) where+  forAll_    a = forAll_    ((a >> return sTrue) :: SymbolicT m SBool)+  forAll ns  a = forAll ns  ((a >> return sTrue) :: SymbolicT m SBool)+  forSome_   a = forSome_   ((a >> return sTrue) :: SymbolicT m SBool)+  forSome ns a = forSome ns ((a >> return sTrue) :: SymbolicT m SBool)++instance ExtractIO m => MProvable m (SymbolicT m SBool) where   forAll_    = id   forAll []  = id   forAll xs  = error $ "SBV.forAll: Extra unmapped name(s) in predicate construction: " ++ intercalate ", " xs@@ -400,7 +396,7 @@   forSome [] = id   forSome xs = error $ "SBV.forSome: Extra unmapped name(s) in predicate construction: " ++ intercalate ", " xs -instance Provable SBool where+instance ExtractIO m => MProvable m SBool where   forAll_   = return   forAll _  = return   forSome_  = return@@ -419,7 +415,7 @@ -}  -- Functions-instance (SymWord a, Provable p) => Provable (SBV a -> p) where+instance (SymVal a, MProvable m p) => MProvable m (SBV a -> p) where   forAll_        k = forall_   >>= \a -> forAll_   $ k a   forAll (s:ss)  k = forall s  >>= \a -> forAll ss $ k a   forAll []      k = forAll_ k@@ -428,7 +424,7 @@   forSome []     k = forSome_ k  -- SFunArrays (memory, functional representation), only supported universally for the time being-instance (HasKind a, HasKind b, Provable p) => Provable (SArray a b -> p) where+instance (HasKind a, HasKind b, MProvable m p) => MProvable m (SArray a b -> p) where   forAll_       k = newArray_  Nothing >>= \a -> forAll_   $ k a   forAll (s:ss) k = newArray s Nothing >>= \a -> forAll ss $ k a   forAll []     k = forAll_ k@@ -436,7 +432,7 @@   forSome _     _ = error "SBV.forSome.SFunArray: Existential arrays are not currently supported."  -- SArrays (memory, SMT-Lib notion of arrays), only supported universally for the time being-instance (HasKind a, HasKind b, Provable p) => Provable (SFunArray a b -> p) where+instance (HasKind a, HasKind b, MProvable m p) => MProvable m (SFunArray a b -> p) where   forAll_       k = newArray_  Nothing >>= \a -> forAll_   $ k a   forAll (s:ss) k = newArray s Nothing >>= \a -> forAll ss $ k a   forAll []     k = forAll_ k@@ -444,7 +440,7 @@   forSome _     _ = error "SBV.forSome.SArray: Existential arrays are not currently supported."  -- 2 Tuple-instance (SymWord a, SymWord b, Provable p) => Provable ((SBV a, SBV b) -> p) where+instance (SymVal a, SymVal b, MProvable m p) => MProvable m ((SBV a, SBV b) -> p) where   forAll_        k = forall_  >>= \a -> forAll_   $ \b -> k (a, b)   forAll (s:ss)  k = forall s >>= \a -> forAll ss $ \b -> k (a, b)   forAll []      k = forAll_ k@@ -453,7 +449,7 @@   forSome []     k = forSome_ k  -- 3 Tuple-instance (SymWord a, SymWord b, SymWord c, Provable p) => Provable ((SBV a, SBV b, SBV c) -> p) where+instance (SymVal a, SymVal b, SymVal c, MProvable m p) => MProvable m ((SBV a, SBV b, SBV c) -> p) where   forAll_       k  = forall_  >>= \a -> forAll_   $ \b c -> k (a, b, c)   forAll (s:ss) k  = forall s >>= \a -> forAll ss $ \b c -> k (a, b, c)   forAll []     k  = forAll_ k@@ -462,7 +458,7 @@   forSome []     k = forSome_ k  -- 4 Tuple-instance (SymWord a, SymWord b, SymWord c, SymWord d, Provable p) => Provable ((SBV a, SBV b, SBV c, SBV d) -> p) where+instance (SymVal a, SymVal b, SymVal c, SymVal d, MProvable m p) => MProvable m ((SBV a, SBV b, SBV c, SBV d) -> p) where   forAll_        k = forall_  >>= \a -> forAll_   $ \b c d -> k (a, b, c, d)   forAll (s:ss)  k = forall s >>= \a -> forAll ss $ \b c d -> k (a, b, c, d)   forAll []      k = forAll_ k@@ -471,7 +467,7 @@   forSome []     k = forSome_ k  -- 5 Tuple-instance (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, Provable p) => Provable ((SBV a, SBV b, SBV c, SBV d, SBV e) -> p) where+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, MProvable m p) => MProvable m ((SBV a, SBV b, SBV c, SBV d, SBV e) -> p) where   forAll_        k = forall_  >>= \a -> forAll_   $ \b c d e -> k (a, b, c, d, e)   forAll (s:ss)  k = forall s >>= \a -> forAll ss $ \b c d e -> k (a, b, c, d, e)   forAll []      k = forAll_ k@@ -480,7 +476,7 @@   forSome []     k = forSome_ k  -- 6 Tuple-instance (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, SymWord f, Provable p) => Provable ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> p) where+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, MProvable m p) => MProvable m ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> p) where   forAll_        k = forall_  >>= \a -> forAll_   $ \b c d e f -> k (a, b, c, d, e, f)   forAll (s:ss)  k = forall s >>= \a -> forAll ss $ \b c d e f -> k (a, b, c, d, e, f)   forAll []      k = forAll_ k@@ -489,7 +485,7 @@   forSome []     k = forSome_ k  -- 7 Tuple-instance (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, SymWord f, SymWord g, Provable p) => Provable ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> p) where+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g, MProvable m p) => MProvable m ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> p) where   forAll_        k = forall_  >>= \a -> forAll_   $ \b c d e f g -> k (a, b, c, d, e, f, g)   forAll (s:ss)  k = forall s >>= \a -> forAll ss $ \b c d e f g -> k (a, b, c, d, e, f, g)   forAll []      k = forAll_ k@@ -497,16 +493,16 @@   forSome (s:ss) k = exists s >>= \a -> forSome ss $ \b c d e f g -> k (a, b, c, d, e, f, g)   forSome []     k = forSome_ k --- | Run an arbitrary symbolic computation, equivalent to @'runSMTWith' 'defaultSMTCfg'@-runSMT :: Symbolic a -> IO a+-- | Generalization of 'Data.SBV.runSMT'+runSMT :: MonadIO m => SymbolicT m a -> m a runSMT = runSMTWith defaultSMTCfg --- | Runs an arbitrary symbolic computation, exposed to the user in SAT mode-runSMTWith :: SMTConfig -> Symbolic a -> IO a+-- | Generalization of 'Data.SBV.runSMTWith'+runSMTWith :: MonadIO m => SMTConfig -> SymbolicT m a -> m a runSMTWith cfg a = fst <$> runSymbolic (SMTMode ISetup True cfg) a  -- | Runs with a query.-runWithQuery :: Provable a => Bool -> Query b -> SMTConfig -> a -> IO b+runWithQuery :: MProvable m a => Bool -> QueryT m b -> SMTConfig -> a -> m b runWithQuery isSAT q cfg a = fst <$> runSymbolic (SMTMode ISetup isSAT cfg) comp   where comp =  do _ <- (if isSAT then forSome_ else forAll_) a >>= output                    Control.executeQuery QueryInternal q@@ -554,26 +550,29 @@  -- | Symbolically executable program fragments. This class is mainly used for 'safe' calls, and is sufficently populated internally to cover most use -- cases. Users can extend it as they wish to allow 'safe' checks for SBV programs that return/take types that are user-defined.-class SExecutable a where-   sName_ :: a -> Symbolic ()-   sName  :: [String] -> a -> Symbolic ()+class ExtractIO m => SExecutable m a where+   -- | Generalization of 'Data.SBV.sName_'+   sName_ :: a -> SymbolicT m ()+   -- | Generalization of 'Data.SBV.sName'+   sName  :: [String] -> a -> SymbolicT m () -   -- | Check safety using the default solver.-   safe :: a -> IO [SafeResult]+   -- | Generalization of 'Data.SBV.safe'+   safe :: a -> m [SafeResult]    safe = safeWith defaultSMTCfg -   -- | Check if any of the 'Data.SBV.sAssert' calls can be violated.-   safeWith :: SMTConfig -> a -> IO [SafeResult]-   safeWith cfg a = do cwd <- (++ "/") <$> getCurrentDirectory+   -- | Generalization of 'Data.SBV.safeWith'+   safeWith :: SMTConfig -> a -> m [SafeResult]+   safeWith cfg a = do cwd <- (++ "/") <$> liftIO getCurrentDirectory                        let mkRelative path                               | cwd `isPrefixOf` path = drop (length cwd) path                               | True                  = path                        fst <$> runSymbolic (SMTMode ISafe True cfg) (sName_ a >> check mkRelative)-     where check mkRelative = Control.query $ Control.getSBVAssertions >>= mapM (verify mkRelative)+     where check :: (FilePath -> FilePath) -> SymbolicT m [SafeResult]+           check mkRelative = Control.query $ Control.getSBVAssertions >>= mapM (verify mkRelative)             -- check that the cond is unsatisfiable. If satisfiable, that would            -- indicate the assignment under which the 'Data.SBV.sAssert' would fail-           verify :: (FilePath -> FilePath) -> (String, Maybe CallStack, SW) -> Query SafeResult+           verify :: (FilePath -> FilePath) -> (String, Maybe CallStack, SV) -> QueryT m SafeResult            verify mkRelative (msg, cs, cond) = do                    let locInfo ps = let loc (f, sl) = concat [mkRelative (srcLocFile sl), ":", show (srcLocStartLine sl), ":", show (srcLocStartCol sl), ":", f]                                     in intercalate ",\n " (map loc ps)@@ -587,93 +586,93 @@                     return $ SafeResult (location, msg, result) -instance NFData a => SExecutable (Symbolic a) where+instance (ExtractIO m, NFData a) => SExecutable m (SymbolicT m a) where    sName_   a = a >>= \r -> rnf r `seq` return ()    sName []   = sName_    sName xs   = error $ "SBV.SExecutable.sName: Extra unmapped name(s): " ++ intercalate ", " xs -instance SExecutable (SBV a) where-   sName_   v = sName_ (output v)-   sName xs v = sName xs (output v)+instance ExtractIO m => SExecutable m (SBV a) where+   sName_   v = sName_   (output v :: SymbolicT m (SBV a))+   sName xs v = sName xs (output v :: SymbolicT m (SBV a))  -- Unit output-instance SExecutable () where-   sName_   () = sName_   (output ())-   sName xs () = sName xs (output ())+instance ExtractIO m => SExecutable m () where+   sName_   () = sName_   (output () :: SymbolicT m ())+   sName xs () = sName xs (output () :: SymbolicT m ())  -- List output-instance SExecutable [SBV a] where-   sName_   vs = sName_   (output vs)-   sName xs vs = sName xs (output vs)+instance ExtractIO m => SExecutable m [SBV a] where+   sName_   vs = sName_   (output vs :: SymbolicT m [SBV a])+   sName xs vs = sName xs (output vs :: SymbolicT m [SBV a])  -- 2 Tuple output-instance (NFData a, SymWord a, NFData b, SymWord b) => SExecutable (SBV a, SBV b) where-  sName_ (a, b) = sName_ (output a >> output b)+instance (ExtractIO m, NFData a, SymVal a, NFData b, SymVal b) => SExecutable m (SBV a, SBV b) where+  sName_ (a, b) = sName_ (output a >> output b :: SymbolicT m (SBV b))   sName _       = sName_  -- 3 Tuple output-instance (NFData a, SymWord a, NFData b, SymWord b, NFData c, SymWord c) => SExecutable (SBV a, SBV b, SBV c) where-  sName_ (a, b, c) = sName_ (output a >> output b >> output c)+instance (ExtractIO m, NFData a, SymVal a, NFData b, SymVal b, NFData c, SymVal c) => SExecutable m (SBV a, SBV b, SBV c) where+  sName_ (a, b, c) = sName_ (output a >> output b >> output c :: SymbolicT m (SBV c))   sName _          = sName_  -- 4 Tuple output-instance (NFData a, SymWord a, NFData b, SymWord b, NFData c, SymWord c, NFData d, SymWord d) => SExecutable (SBV a, SBV b, SBV c, SBV d) where-  sName_ (a, b, c, d) = sName_ (output a >> output b >> output c >> output c >> output d)+instance (ExtractIO m, NFData a, SymVal a, NFData b, SymVal b, NFData c, SymVal c, NFData d, SymVal d) => SExecutable m (SBV a, SBV b, SBV c, SBV d) where+  sName_ (a, b, c, d) = sName_ (output a >> output b >> output c >> output c >> output d :: SymbolicT m (SBV d))   sName _             = sName_  -- 5 Tuple output-instance (NFData a, SymWord a, NFData b, SymWord b, NFData c, SymWord c, NFData d, SymWord d, NFData e, SymWord e) => SExecutable (SBV a, SBV b, SBV c, SBV d, SBV e) where-  sName_ (a, b, c, d, e) = sName_ (output a >> output b >> output c >> output d >> output e)+instance (ExtractIO m, NFData a, SymVal a, NFData b, SymVal b, NFData c, SymVal c, NFData d, SymVal d, NFData e, SymVal e) => SExecutable m (SBV a, SBV b, SBV c, SBV d, SBV e) where+  sName_ (a, b, c, d, e) = sName_ (output a >> output b >> output c >> output d >> output e :: SymbolicT m (SBV e))   sName _                = sName_  -- 6 Tuple output-instance (NFData a, SymWord a, NFData b, SymWord b, NFData c, SymWord c, NFData d, SymWord d, NFData e, SymWord e, NFData f, SymWord f) => SExecutable (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) where-  sName_ (a, b, c, d, e, f) = sName_ (output a >> output b >> output c >> output d >> output e >> output f)+instance (ExtractIO m, NFData a, SymVal a, NFData b, SymVal b, NFData c, SymVal c, NFData d, SymVal d, NFData e, SymVal e, NFData f, SymVal f) => SExecutable m (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) where+  sName_ (a, b, c, d, e, f) = sName_ (output a >> output b >> output c >> output d >> output e >> output f :: SymbolicT m (SBV f))   sName _                   = sName_  -- 7 Tuple output-instance (NFData a, SymWord a, NFData b, SymWord b, NFData c, SymWord c, NFData d, SymWord d, NFData e, SymWord e, NFData f, SymWord f, NFData g, SymWord g) => SExecutable (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) where-  sName_ (a, b, c, d, e, f, g) = sName_ (output a >> output b >> output c >> output d >> output e >> output f >> output g)+instance (ExtractIO m, NFData a, SymVal a, NFData b, SymVal b, NFData c, SymVal c, NFData d, SymVal d, NFData e, SymVal e, NFData f, SymVal f, NFData g, SymVal g) => SExecutable m (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) where+  sName_ (a, b, c, d, e, f, g) = sName_ (output a >> output b >> output c >> output d >> output e >> output f >> output g :: SymbolicT m (SBV g))   sName _                      = sName_  -- Functions-instance (SymWord a, SExecutable p) => SExecutable (SBV a -> p) where+instance (SymVal a, SExecutable m p) => SExecutable m (SBV a -> p) where    sName_        k = exists_   >>= \a -> sName_   $ k a    sName (s:ss)  k = exists s  >>= \a -> sName ss $ k a    sName []      k = sName_ k  -- 2 Tuple input-instance (SymWord a, SymWord b, SExecutable p) => SExecutable ((SBV a, SBV b) -> p) where+instance (SymVal a, SymVal b, SExecutable m p) => SExecutable m ((SBV a, SBV b) -> p) where   sName_        k = exists_  >>= \a -> sName_   $ \b -> k (a, b)   sName (s:ss)  k = exists s >>= \a -> sName ss $ \b -> k (a, b)   sName []      k = sName_ k  -- 3 Tuple input-instance (SymWord a, SymWord b, SymWord c, SExecutable p) => SExecutable ((SBV a, SBV b, SBV c) -> p) where+instance (SymVal a, SymVal b, SymVal c, SExecutable m p) => SExecutable m ((SBV a, SBV b, SBV c) -> p) where   sName_       k  = exists_  >>= \a -> sName_   $ \b c -> k (a, b, c)   sName (s:ss) k  = exists s >>= \a -> sName ss $ \b c -> k (a, b, c)   sName []     k  = sName_ k  -- 4 Tuple input-instance (SymWord a, SymWord b, SymWord c, SymWord d, SExecutable p) => SExecutable ((SBV a, SBV b, SBV c, SBV d) -> p) where+instance (SymVal a, SymVal b, SymVal c, SymVal d, SExecutable m p) => SExecutable m ((SBV a, SBV b, SBV c, SBV d) -> p) where   sName_        k = exists_  >>= \a -> sName_   $ \b c d -> k (a, b, c, d)   sName (s:ss)  k = exists s >>= \a -> sName ss $ \b c d -> k (a, b, c, d)   sName []      k = sName_ k  -- 5 Tuple input-instance (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, SExecutable p) => SExecutable ((SBV a, SBV b, SBV c, SBV d, SBV e) -> p) where+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SExecutable m p) => SExecutable m ((SBV a, SBV b, SBV c, SBV d, SBV e) -> p) where   sName_        k = exists_  >>= \a -> sName_   $ \b c d e -> k (a, b, c, d, e)   sName (s:ss)  k = exists s >>= \a -> sName ss $ \b c d e -> k (a, b, c, d, e)   sName []      k = sName_ k  -- 6 Tuple input-instance (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, SymWord f, SExecutable p) => SExecutable ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> p) where+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SExecutable m p) => SExecutable m ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) -> p) where   sName_        k = exists_  >>= \a -> sName_   $ \b c d e f -> k (a, b, c, d, e, f)   sName (s:ss)  k = exists s >>= \a -> sName ss $ \b c d e f -> k (a, b, c, d, e, f)   sName []      k = sName_ k  -- 7 Tuple input-instance (SymWord a, SymWord b, SymWord c, SymWord d, SymWord e, SymWord f, SymWord g, SExecutable p) => SExecutable ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> p) where+instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g, SExecutable m p) => SExecutable m ((SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) -> p) where   sName_        k = exists_  >>= \a -> sName_   $ \b c d e f g -> k (a, b, c, d, e, f, g)   sName (s:ss)  k = exists s >>= \a -> sName ss $ \b c d e f g -> k (a, b, c, d, e, f, g)   sName []      k = sName_ k
Data/SBV/Provers/Yices.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Provers.Yices--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Provers.Yices+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The connection to the Yices SMT solver -----------------------------------------------------------------------------@@ -23,6 +23,7 @@ yices = SMTSolver {            name         = Yices          , executable   = "yices-smt2"+         , preprocess   = id          , options      = const ["--incremental"]          , engine       = standardEngine "SBV_YICES" "SBV_YICES_OPTIONS"          , capabilities = SolverCapabilities {
Data/SBV/Provers/Z3.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Provers.MathSAT--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Provers.Z3+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The connection to the MathSAT SMT solver -----------------------------------------------------------------------------@@ -23,6 +23,7 @@ z3 = SMTSolver {            name         = Z3          , executable   = "z3"+         , preprocess   = id          , options      = modConfig ["-nw", "-in", "-smt2"]          , engine       = standardEngine "SBV_Z3" "SBV_Z3_OPTIONS"          , capabilities = SolverCapabilities {
Data/SBV/RegExp.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.RegExp--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.RegExp+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A collection of regular-expression related utilities. The recommended -- workflow is to import this module qualified as the names of the functions@@ -15,10 +15,11 @@ -----------------------------------------------------------------------------  {-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE OverloadedStrings    #-} {-# LANGUAGE Rank2Types           #-} {-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE TypeSynonymInstances #-}  module Data.SBV.RegExp (         -- * Regular expressions@@ -53,6 +54,8 @@ import Data.SBV.String import qualified Data.Char as C +import Data.Proxy+ -- For testing only import Data.SBV.Char @@ -61,7 +64,6 @@ -- $setup -- >>> import Prelude hiding (length, take, elem, notElem, head) -- >>> import Data.SBV.Provers.Prover (prove, sat)--- >>> import Data.SBV.Utils.Boolean  ((<=>), (==>), bAny, (&&&), (|||), bnot) -- >>> import Data.SBV.Core.Model -- >>> :set -XOverloadedStrings -- >>> :set -XScopedTypeVariables@@ -102,14 +104,14 @@ -- with @OverloadedStrings@ extension, you can simply use a Haskell -- string to mean the same thing, so this function is rarely needed. ----- >>> prove $ \(s :: SString) -> s `match` exactly "LITERAL" <=> s .== "LITERAL"+-- >>> prove $ \(s :: SString) -> s `match` exactly "LITERAL" .<=> s .== "LITERAL" -- Q.E.D. exactly :: String -> RegExp exactly = Literal  -- | Helper to define a character class. ----- >>> prove $ \(c :: SChar) -> c `match` oneOf "ABCD" <=> bAny (c .==) (map literal "ABCD")+-- >>> prove $ \(c :: SChar) -> c `match` oneOf "ABCD" .<=> sAny (c .==) (map literal "ABCD") -- Q.E.D. oneOf :: String -> RegExp oneOf xs = Union [exactly [x] | x <- xs]@@ -118,7 +120,7 @@ -- -- >>> newline -- (re.union (str.to.re "\n") (str.to.re "\r") (str.to.re "\f"))--- >>> prove $ \c -> c `match` newline ==> isSpace c+-- >>> prove $ \c -> c `match` newline .=> isSpace c -- Q.E.D. newline :: RegExp newline = oneOf "\n\r\f"@@ -127,7 +129,7 @@ -- -- >>> tab -- (str.to.re "\x09")--- >>> prove $ \c -> c `match` tab ==> c .== literal '\t'+-- >>> prove $ \c -> c `match` tab .=> c .== literal '\t' -- Q.E.D. tab :: RegExp tab = oneOf "\t"@@ -136,14 +138,14 @@ -- -- >>> whiteSpaceNoNewLine -- (re.union (str.to.re "\x09") (re.union (str.to.re "\v") (str.to.re "\xa0") (str.to.re " ")))--- >>> prove $ \c -> c `match` whiteSpaceNoNewLine ==> c `match` whiteSpace &&& c ./= literal '\n'+-- >>> prove $ \c -> c `match` whiteSpaceNoNewLine .=> c `match` whiteSpace .&& c ./= literal '\n' -- Q.E.D. whiteSpaceNoNewLine :: RegExp whiteSpaceNoNewLine = tab + oneOf "\v\160 "  -- | Recognize white space. ----- >>> prove $ \c -> c `match` whiteSpace ==> isSpace c+-- >>> prove $ \c -> c `match` whiteSpace .=> isSpace c -- Q.E.D. whiteSpace :: RegExp whiteSpace = newline + whiteSpaceNoNewLine@@ -151,7 +153,7 @@ -- | Recognize a punctuation character. Anything that satisfies the predicate 'isPunctuation' will -- be accepted.  (TODO: Will need modification when we move to unicode.) ----- >>> prove $ \c -> c `match` punctuation ==> isPunctuation c+-- >>> prove $ \c -> c `match` punctuation .=> isPunctuation c -- Q.E.D. punctuation :: RegExp punctuation = oneOf $ filter C.isPunctuation $ map C.chr [0..255]@@ -160,9 +162,9 @@ -- -- >>> asciiLetter -- (re.union (re.range "a" "z") (re.range "A" "Z"))--- >>> prove $ \c -> c `match` asciiLetter <=> toUpper c `match` asciiLetter+-- >>> prove $ \c -> c `match` asciiLetter .<=> toUpper c `match` asciiLetter -- Q.E.D.--- >>> prove $ \c -> c `match` asciiLetter <=> toLower c `match` asciiLetter+-- >>> prove $ \c -> c `match` asciiLetter .<=> toLower c `match` asciiLetter -- Q.E.D. asciiLetter :: RegExp asciiLetter = asciiLower + asciiUpper@@ -171,11 +173,11 @@ -- -- >>> asciiLower -- (re.range "a" "z")--- >>> prove $ \c -> (c :: SChar) `match` asciiLower  ==> c `match` asciiLetter+-- >>> prove $ \c -> (c :: SChar) `match` asciiLower  .=> c `match` asciiLetter -- Q.E.D.--- >>> prove $ \c -> c `match` asciiLower  ==> toUpper c `match` asciiUpper+-- >>> prove $ \c -> c `match` asciiLower  .=> toUpper c `match` asciiUpper -- Q.E.D.--- >>> prove $ \c -> c `match` asciiLetter ==> toLower c `match` asciiLower+-- >>> prove $ \c -> c `match` asciiLetter .=> toLower c `match` asciiLower -- Q.E.D. asciiLower :: RegExp asciiLower = Range 'a' 'z'@@ -184,11 +186,11 @@ -- -- >>> asciiUpper -- (re.range "A" "Z")--- >>> prove $ \c -> (c :: SChar) `match` asciiUpper  ==> c `match` asciiLetter+-- >>> prove $ \c -> (c :: SChar) `match` asciiUpper  .=> c `match` asciiLetter -- Q.E.D.--- >>> prove $ \c -> c `match` asciiUpper  ==> toLower c `match` asciiLower+-- >>> prove $ \c -> c `match` asciiUpper  .=> toLower c `match` asciiLower -- Q.E.D.--- >>> prove $ \c -> c `match` asciiLetter ==> toUpper c `match` asciiUpper+-- >>> prove $ \c -> c `match` asciiLetter .=> toUpper c `match` asciiUpper -- Q.E.D. asciiUpper :: RegExp asciiUpper = Range 'A' 'Z'@@ -197,7 +199,7 @@ -- -- >>> digit -- (re.range "0" "9")--- >>> prove $ \c -> c `match` digit <=> let v = digitToInt c in 0 .<= v &&& v .< 10+-- >>> prove $ \c -> c `match` digit .<=> let v = digitToInt c in 0 .<= v .&& v .< 10 -- Q.E.D. digit :: RegExp digit = Range '0' '9'@@ -206,9 +208,9 @@ -- -- >>> octDigit -- (re.range "0" "7")--- >>> prove $ \c -> c `match` octDigit <=> let v = digitToInt c in 0 .<= v &&& v .< 8+-- >>> prove $ \c -> c `match` octDigit .<=> let v = digitToInt c in 0 .<= v .&& v .< 8 -- Q.E.D.--- >>> prove $ \(c :: SChar) -> c `match` octDigit ==> c `match` digit+-- >>> prove $ \(c :: SChar) -> c `match` octDigit .=> c `match` digit -- Q.E.D. octDigit :: RegExp octDigit = Range '0' '7'@@ -217,9 +219,9 @@ -- -- >>> hexDigit -- (re.union (re.range "0" "9") (re.range "a" "f") (re.range "A" "F"))--- >>> prove $ \c -> c `match` hexDigit <=> let v = digitToInt c in 0 .<= v &&& v .< 16+-- >>> prove $ \c -> c `match` hexDigit .<=> let v = digitToInt c in 0 .<= v .&& v .< 16 -- Q.E.D.--- >>> prove $ \(c :: SChar) -> c `match` digit ==> c `match` hexDigit+-- >>> prove $ \(c :: SChar) -> c `match` digit .=> c `match` hexDigit -- Q.E.D. hexDigit :: RegExp hexDigit = digit + Range 'a' 'f' + Range 'A' 'F'@@ -228,7 +230,7 @@ -- -- >>> decimal -- (re.+ (re.range "0" "9"))--- >>> prove $ \s -> (s::SString) `match` decimal ==> bnot (s `match` KStar asciiLetter)+-- >>> prove $ \s -> (s::SString) `match` decimal .=> sNot (s `match` KStar asciiLetter) -- Q.E.D. decimal :: RegExp decimal = KPlus digit@@ -237,7 +239,7 @@ -- -- >>> octal -- (re.++ (re.union (str.to.re "0o") (str.to.re "0O")) (re.+ (re.range "0" "7")))--- >>> prove $ \s -> s `match` octal ==> bAny (.== take 2 s) ["0o", "0O"]+-- >>> prove $ \s -> s `match` octal .=> sAny (.== take 2 s) ["0o", "0O"] -- Q.E.D. octal :: RegExp octal = ("0o" + "0O") * KPlus octDigit@@ -246,7 +248,7 @@ -- -- >>> hexadecimal -- (re.++ (re.union (str.to.re "0x") (str.to.re "0X")) (re.+ (re.union (re.range "0" "9") (re.range "a" "f") (re.range "A" "F"))))--- >>> prove $ \s -> s `match` hexadecimal ==> bAny (.== take 2 s) ["0x", "0X"]+-- >>> prove $ \s -> s `match` hexadecimal .=> sAny (.== take 2 s) ["0x", "0X"] -- Q.E.D. hexadecimal :: RegExp hexadecimal = ("0x" + "0X") * KPlus hexDigit@@ -254,7 +256,7 @@ -- | Recognize a floating point number. The exponent part is optional if a fraction -- is present. The exponent may or may not have a sign. ----- >>> prove $ \s -> s `match` floating ==> length s .>= 3+-- >>> prove $ \s -> s `match` floating .=> length s .>= 3 -- Q.E.D. floating :: RegExp floating = withFraction + withoutFraction@@ -266,26 +268,26 @@ -- followed by zero or more letters, digits, underscores, and single quotes. The first -- letter must be lowercase. ----- >>> prove $ \s -> s `match` identifier ==> isAsciiLower (head s)+-- >>> prove $ \s -> s `match` identifier .=> isAsciiLower (head s) -- Q.E.D.--- >>> prove $ \s -> s `match` identifier ==> length s .>= 1+-- >>> prove $ \s -> s `match` identifier .=> length s .>= 1 -- Q.E.D. identifier :: RegExp identifier = asciiLower * KStar (asciiLetter + digit + "_" + "'")  -- | Lift a unary operator over strings.-lift1 :: forall a b. (SymWord a, SymWord b) => StrOp -> Maybe (a -> b) -> SBV a -> SBV b+lift1 :: forall a b. (SymVal a, SymVal b) => StrOp -> Maybe (a -> b) -> SBV a -> SBV b lift1 w mbOp a   | Just cv <- concEval1 mbOp a   = cv   | True   = SBV $ SVal k $ Right $ cache r-  where k = kindOf (undefined :: b)-        r st = do swa <- sbvToSW st a-                  newExpr st k (SBVApp (StrOp w) [swa])+  where k = kindOf (Proxy @b)+        r st = do sva <- sbvToSV st a+                  newExpr st k (SBVApp (StrOp w) [sva])  -- | Concrete evaluation for unary ops-concEval1 :: (SymWord a, SymWord b) => Maybe (a -> b) -> SBV a -> Maybe (SBV b)+concEval1 :: (SymVal a, SymVal b) => Maybe (a -> b) -> SBV a -> Maybe (SBV b) concEval1 mbOp a = literal <$> (mbOp <*> unliteral a)  -- | Quiet GHC about testing only imports@@ -303,19 +305,19 @@ an argument for matching. In practice, this means you might have to disambiguate with a type-ascription if it is not deducible from context. ->>> prove $ \s -> (s :: SString) `match` "hello" <=> s .== "hello"+>>> prove $ \s -> (s :: SString) `match` "hello" .<=> s .== "hello" Q.E.D.->>> prove $ \s -> s `match` Loop 2 5 "xyz" ==> length s .>= 6+>>> prove $ \s -> s `match` Loop 2 5 "xyz" .=> length s .>= 6 Q.E.D.->>> prove $ \s -> s `match` Loop 2 5 "xyz" ==> length s .<= 15+>>> prove $ \s -> s `match` Loop 2 5 "xyz" .=> length s .<= 15 Q.E.D.->>> prove $ \s -> match s (Loop 2 5 "xyz") ==> length s .>= 7+>>> prove $ \s -> match s (Loop 2 5 "xyz") .=> length s .>= 7 Falsifiable. Counter-example:   s0 = "xyzxyz" :: String->>> prove $ \s -> (s :: SString) `match` "hello" ==> s `match` ("hello" + "world")+>>> prove $ \s -> (s :: SString) `match` "hello" .=> s `match` ("hello" + "world") Q.E.D.->>> prove $ \s -> bnot $ (s::SString) `match` ("so close" * 0)+>>> prove $ \s -> sNot $ (s::SString) `match` ("so close" * 0) Q.E.D.->>> prove $ \c -> (c :: SChar) `match` oneOf "abcd" ==> ord c .>= ord (literal 'a') &&& ord c .<= ord (literal 'd')+>>> prove $ \c -> (c :: SChar) `match` oneOf "abcd" .=> ord c .>= ord (literal 'a') .&& ord c .<= ord (literal 'd') Q.E.D. -}
Data/SBV/SMT/SMT.hs view
@@ -1,19 +1,19 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.SMT.SMT--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.SMT.SMT+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Abstraction of SMT solvers ----------------------------------------------------------------------------- -{-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE DefaultSignatures          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE Rank2Types                 #-} {-# LANGUAGE NamedFieldPuns             #-}+{-# LANGUAGE Rank2Types                 #-}+{-# LANGUAGE ScopedTypeVariables        #-}  module Data.SBV.SMT.SMT (        -- * Model extraction@@ -172,94 +172,94 @@                                     (tag "Optimal in an extension field:" ++ "\n")  -- | Instances of 'SatModel' can be automatically extracted from models returned by the--- solvers. The idea is that the sbv infrastructure provides a stream of CW's (constant-words)+-- solvers. The idea is that the sbv infrastructure provides a stream of CV's (constant values) -- coming from the solver, and the type @a@ is interpreted based on these constants. Many typical -- instances are already provided, so new instances can be declared with relative ease. ----- Minimum complete definition: 'parseCWs'+-- Minimum complete definition: 'parseCVs' class SatModel a where   -- | Given a sequence of constant-words, extract one instance of the type @a@, returning   -- the remaining elements untouched. If the next element is not what's expected for this   -- type you should return 'Nothing'-  parseCWs  :: [CW] -> Maybe (a, [CW])+  parseCVs  :: [CV] -> Maybe (a, [CV])   -- | Given a parsed model instance, transform it using @f@, and return the result.   -- The default definition for this method should be sufficient in most use cases.-  cvtModel  :: (a -> Maybe b) -> Maybe (a, [CW]) -> Maybe (b, [CW])+  cvtModel  :: (a -> Maybe b) -> Maybe (a, [CV]) -> Maybe (b, [CV])   cvtModel f x = x >>= \(a, r) -> f a >>= \b -> return (b, r) -  default parseCWs :: Read a => [CW] -> Maybe (a, [CW])-  parseCWs (CW _ (CWUserSort (_, s)) : r) = Just (read s, r)-  parseCWs _                              = Nothing+  default parseCVs :: Read a => [CV] -> Maybe (a, [CV])+  parseCVs (CV _ (CUserSort (_, s)) : r) = Just (read s, r)+  parseCVs _                             = Nothing --- | Parse a signed/sized value from a sequence of CWs-genParse :: Integral a => Kind -> [CW] -> Maybe (a, [CW])-genParse k (x@(CW _ (CWInteger i)):r) | kindOf x == k = Just (fromIntegral i, r)-genParse _ _                                          = Nothing+-- | Parse a signed/sized value from a sequence of CVs+genParse :: Integral a => Kind -> [CV] -> Maybe (a, [CV])+genParse k (x@(CV _ (CInteger i)):r) | kindOf x == k = Just (fromIntegral i, r)+genParse _ _                                         = Nothing  -- | Base case for 'SatModel' at unit type. Comes in handy if there are no real variables. instance SatModel () where-  parseCWs xs = return ((), xs)+  parseCVs xs = return ((), xs)  -- | 'Bool' as extracted from a model instance SatModel Bool where-  parseCWs xs = do (x, r) <- genParse KBool xs+  parseCVs xs = do (x, r) <- genParse KBool xs                    return ((x :: Integer) /= 0, r)  -- | 'Word8' as extracted from a model instance SatModel Word8 where-  parseCWs = genParse (KBounded False 8)+  parseCVs = genParse (KBounded False 8)  -- | 'Int8' as extracted from a model instance SatModel Int8 where-  parseCWs = genParse (KBounded True 8)+  parseCVs = genParse (KBounded True 8)  -- | 'Word16' as extracted from a model instance SatModel Word16 where-  parseCWs = genParse (KBounded False 16)+  parseCVs = genParse (KBounded False 16)  -- | 'Int16' as extracted from a model instance SatModel Int16 where-  parseCWs = genParse (KBounded True 16)+  parseCVs = genParse (KBounded True 16)  -- | 'Word32' as extracted from a model instance SatModel Word32 where-  parseCWs = genParse (KBounded False 32)+  parseCVs = genParse (KBounded False 32)  -- | 'Int32' as extracted from a model instance SatModel Int32 where-  parseCWs = genParse (KBounded True 32)+  parseCVs = genParse (KBounded True 32)  -- | 'Word64' as extracted from a model instance SatModel Word64 where-  parseCWs = genParse (KBounded False 64)+  parseCVs = genParse (KBounded False 64)  -- | 'Int64' as extracted from a model instance SatModel Int64 where-  parseCWs = genParse (KBounded True 64)+  parseCVs = genParse (KBounded True 64)  -- | 'Integer' as extracted from a model instance SatModel Integer where-  parseCWs = genParse KUnbounded+  parseCVs = genParse KUnbounded  -- | 'AlgReal' as extracted from a model instance SatModel AlgReal where-  parseCWs (CW KReal (CWAlgReal i) : r) = Just (i, r)-  parseCWs _                            = Nothing+  parseCVs (CV KReal (CAlgReal i) : r) = Just (i, r)+  parseCVs _                           = Nothing  -- | 'Float' as extracted from a model instance SatModel Float where-  parseCWs (CW KFloat (CWFloat i) : r) = Just (i, r)-  parseCWs _                           = Nothing+  parseCVs (CV KFloat (CFloat i) : r) = Just (i, r)+  parseCVs _                          = Nothing  -- | 'Double' as extracted from a model instance SatModel Double where-  parseCWs (CW KDouble (CWDouble i) : r) = Just (i, r)-  parseCWs _                             = Nothing+  parseCVs (CV KDouble (CDouble i) : r) = Just (i, r)+  parseCVs _                            = Nothing --- | @CW@ as extracted from a model; trivial definition-instance SatModel CW where-  parseCWs (cw : r) = Just (cw, r)-  parseCWs []       = Nothing+-- | @CV@ as extracted from a model; trivial definition+instance SatModel CV where+  parseCVs (cv : r) = Just (cv, r)+  parseCVs []       = Nothing  -- | A rounding mode, extracted from a model. (Default definition suffices) instance SatModel RoundingMode@@ -268,47 +268,47 @@ -- go as long as we can (maximal-munch). Note that this never fails, as -- we can always return the empty list! instance SatModel a => SatModel [a] where-  parseCWs [] = Just ([], [])-  parseCWs xs = case parseCWs xs of-                  Just (a, ys) -> case parseCWs ys of+  parseCVs [] = Just ([], [])+  parseCVs xs = case parseCVs xs of+                  Just (a, ys) -> case parseCVs ys of                                     Just (as, zs) -> Just (a:as, zs)                                     Nothing       -> Just ([], ys)                   Nothing     -> Just ([], xs)  -- | Tuples extracted from a model instance (SatModel a, SatModel b) => SatModel (a, b) where-  parseCWs as = do (a, bs) <- parseCWs as-                   (b, cs) <- parseCWs bs+  parseCVs as = do (a, bs) <- parseCVs as+                   (b, cs) <- parseCVs bs                    return ((a, b), cs)  -- | 3-Tuples extracted from a model instance (SatModel a, SatModel b, SatModel c) => SatModel (a, b, c) where-  parseCWs as = do (a,      bs) <- parseCWs as-                   ((b, c), ds) <- parseCWs bs+  parseCVs as = do (a,      bs) <- parseCVs as+                   ((b, c), ds) <- parseCVs bs                    return ((a, b, c), ds)  -- | 4-Tuples extracted from a model instance (SatModel a, SatModel b, SatModel c, SatModel d) => SatModel (a, b, c, d) where-  parseCWs as = do (a,         bs) <- parseCWs as-                   ((b, c, d), es) <- parseCWs bs+  parseCVs as = do (a,         bs) <- parseCVs as+                   ((b, c, d), es) <- parseCVs bs                    return ((a, b, c, d), es)  -- | 5-Tuples extracted from a model instance (SatModel a, SatModel b, SatModel c, SatModel d, SatModel e) => SatModel (a, b, c, d, e) where-  parseCWs as = do (a, bs)            <- parseCWs as-                   ((b, c, d, e), fs) <- parseCWs bs+  parseCVs as = do (a, bs)            <- parseCVs as+                   ((b, c, d, e), fs) <- parseCVs bs                    return ((a, b, c, d, e), fs)  -- | 6-Tuples extracted from a model instance (SatModel a, SatModel b, SatModel c, SatModel d, SatModel e, SatModel f) => SatModel (a, b, c, d, e, f) where-  parseCWs as = do (a, bs)               <- parseCWs as-                   ((b, c, d, e, f), gs) <- parseCWs bs+  parseCVs as = do (a, bs)               <- parseCVs as+                   ((b, c, d, e, f), gs) <- parseCVs bs                    return ((a, b, c, d, e, f), gs)  -- | 7-Tuples extracted from a model instance (SatModel a, SatModel b, SatModel c, SatModel d, SatModel e, SatModel f, SatModel g) => SatModel (a, b, c, d, e, f, g) where-  parseCWs as = do (a, bs)                  <- parseCWs as-                   ((b, c, d, e, f, g), hs) <- parseCWs bs+  parseCVs as = do (a, bs)                  <- parseCVs as+                   ((b, c, d, e, f, g), hs) <- parseCVs bs                    return ((a, b, c, d, e, f, g), hs)  -- | Various SMT results that we can extract models out of.@@ -322,19 +322,19 @@    -- | Extract a model dictionary. Extract a dictionary mapping the variables to   -- their respective values as returned by the SMT solver. Also see `getModelDictionaries`.-  getModelDictionary :: a -> M.Map String CW+  getModelDictionary :: a -> M.Map String CV    -- | Extract a model value for a given element. Also see `getModelValues`.-  getModelValue :: SymWord b => String -> a -> Maybe b-  getModelValue v r = fromCW `fmap` (v `M.lookup` getModelDictionary r)+  getModelValue :: SymVal b => String -> a -> Maybe b+  getModelValue v r = fromCV `fmap` (v `M.lookup` getModelDictionary r)    -- | Extract a representative name for the model value of an uninterpreted kind.   -- This is supposed to correspond to the value as computed internally by the   -- SMT solver; and is unportable from solver to solver. Also see `getModelUninterpretedValues`.   getModelUninterpretedValue :: String -> a -> Maybe String   getModelUninterpretedValue v r = case v `M.lookup` getModelDictionary r of-                                     Just (CW _ (CWUserSort (_, s))) -> Just s-                                     _                               -> Nothing+                                     Just (CV _ (CUserSort (_, s))) -> Just s+                                     _                              -> Nothing    -- | A simpler variant of 'getModelAssignment' to get a model out without the fuss.   extractModel :: SatModel b => a -> Maybe b@@ -343,10 +343,10 @@                      _            -> Nothing    -- | Extract model objective values, for all optimization goals.-  getModelObjectives :: a -> M.Map String GeneralizedCW+  getModelObjectives :: a -> M.Map String GeneralizedCV    -- | Extract the value of an objective-  getModelObjectiveValue :: String -> a -> Maybe GeneralizedCW+  getModelObjectiveValue :: String -> a -> Maybe GeneralizedCV   getModelObjectiveValue v r = v `M.lookup` getModelObjectives r  -- | Return all the models from an 'Data.SBV.allSat' call, similar to 'extractModel' but@@ -355,11 +355,11 @@ extractModels (AllSatResult (_, _, xs)) = [ms | Right (_, ms) <- map getModelAssignment xs]  -- | Get dictionaries from an all-sat call. Similar to `getModelDictionary`.-getModelDictionaries :: AllSatResult -> [M.Map String CW]+getModelDictionaries :: AllSatResult -> [M.Map String CV] getModelDictionaries (AllSatResult (_, _, xs)) = map getModelDictionary xs  -- | Extract value of a variable from an all-sat call. Similar to `getModelValue`.-getModelValues :: SymWord b => String -> AllSatResult -> [Maybe b]+getModelValues :: SymVal b => String -> AllSatResult -> [Maybe b] getModelValues s (AllSatResult (_, _, xs)) =  map (s `getModelValue`) xs  -- | Extract value of an uninterpreted variable from an all-sat call. Similar to `getModelUninterpretedValue`.@@ -406,7 +406,7 @@  -- | Extract a model out, will throw error if parsing is unsuccessful parseModelOut :: SatModel a => SMTModel -> a-parseModelOut m = case parseCWs [c | (_, c) <- modelAssocs m] of+parseModelOut m = case parseCVs [c | (_, c) <- modelAssocs m] of                    Just (x, []) -> x                    Just (_, ys) -> error $ "SBV.parseModelOut: Partially constructed model; remaining elements: " ++ show ys                    Nothing      -> error $ "SBV.parseModelOut: Cannot construct a model from: " ++ show m@@ -438,10 +438,10 @@ -- | Show a model in human readable form. Ignore bindings to those variables that start -- with "__internal_sbv_" and also those marked as "nonModelVar" in the config; as these are only for internal purposes showModel :: SMTConfig -> SMTModel -> String-showModel cfg model = showModelDictionary cfg [(n, RegularCW c) | (n, c) <- modelAssocs model]+showModel cfg model = showModelDictionary cfg [(n, RegularCV c) | (n, c) <- modelAssocs model]  -- | Show bindings in a generalized model dictionary, tabulated-showModelDictionary :: SMTConfig -> [(String, GeneralizedCW)] -> String+showModelDictionary :: SMTConfig -> [(String, GeneralizedCV)] -> String showModelDictionary cfg allVars    | null allVars    = "[There are no variables bound by the model.]"@@ -452,7 +452,7 @@   where relevantVars  = filter (not . ignore) allVars         ignore (s, _) = "__internal_sbv_" `isPrefixOf` s || isNonModelVar cfg s -        shM (s, RegularCW v) = let vs = shCW cfg v in ((length s, s), (vlength vs, vs))+        shM (s, RegularCV v) = let vs = shCV cfg v in ((length s, s), (vlength vs, vs))         shM (s, other)       = let vs = show other in ((length s, s), (vlength vs, vs))          display svs   = map line svs@@ -473,8 +473,8 @@         lTrimRight = length . dropWhile isSpace . reverse  -- | Show a constant value, in the user-specified base-shCW :: SMTConfig -> CW -> String-shCW = sh . printBase+shCV :: SMTConfig -> CV -> String+shCV = sh . printBase   where sh 2  = binS         sh 10 = show         sh 16 = hexS@@ -538,6 +538,8 @@  = do let nm  = show (name (solver cfg))           msg = debug cfg . map ("*** " ++) +          clean = preprocess (solver cfg)+       (send, ask, getResponseFromSolver, terminateSolver, cleanUp, pid) <- do                 (inh, outh, errh, pid) <- runInteractiveProcess execPath opts Nothing Nothing @@ -546,15 +548,17 @@                     send :: Maybe Int -> String -> IO ()                     send mbTimeOut command                       | parenDeficit command /= 0-                      = error $ unlines [ ""-                                        , "*** Data.SBV: Unbalanced input detected."-                                        , "***"-                                        , "***   Sending: " ++ command-                                        , "***"-                                        , "*** This is most likely an SBV bug. Please report!"-                                        ]+                      = error $ unlines $  [ ""+                                           , "*** Data.SBV: Unbalanced input detected."+                                           , "***"+                                           , "***   Sending: "+                                           ]+                                        ++ [ "***     " ++ l | l <- lines command ]+                                        ++ [ "***"+                                           , "*** This is most likely an SBV bug. Please report!"+                                           ]                       | True-                      = do hPutStrLn inh command+                      = do hPutStrLn inh (clean command)                            hFlush inh                            recordTranscript (transcript cfg) $ Left (command, mbTimeOut) @@ -796,7 +800,7 @@                                                  , queryAssertionStackDepth = 0                                                  , queryTblArrPreserveIndex = Nothing                                                  }-                                 qsp = queryState ctx+                                 qsp = rQueryState ctx                               mbQS <- readIORef qsp
Data/SBV/SMT/SMTLib.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.SMT.SMTLib--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.SMT.SMTLib+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Conversion of symbolic programs to SMTLib format -----------------------------------------------------------------------------@@ -37,7 +37,7 @@ -- | Convert to SMTLib-2 format toSMTLib2 :: SMTLibConverter SMTLibPgm toSMTLib2 = cvt SMTLib2-  where cvt v kindInfo isSat comments qinps skolemMap consts tbls arrs uis axs asgnsSeq cstrs out config+  where cvt v ctx kindInfo isSat comments qinps skolemMap consts tbls arrs uis axs asgnsSeq cstrs out config          | KUnbounded `Set.member` kindInfo && not (supportsUnboundedInts solverCaps)          = unsupported "unbounded integers"          | KReal `Set.member` kindInfo  && not (supportsReals solverCaps)@@ -50,14 +50,14 @@          = unsupported "uninterpreted sorts"          | True          = SMTLibPgm v pgm-         where sorts = [s | KUserSort s _ <- Set.toList kindInfo]+         where sorts = [s | KUninterpreted s _ <- Set.toList kindInfo]                solverCaps = capabilities (solver config)                unsupported w = error $ unlines [ "SBV: Given problem needs " ++ w                                                , "*** Which is not supported by SBV for the chosen solver: " ++ show (name (solver config))                                                ]                converter = case v of                              SMTLib2 -> SMT2.cvt-               pgm = converter kindInfo isSat comments qinps skolemMap consts tbls arrs uis axs asgnsSeq cstrs out config+               pgm = converter ctx kindInfo isSat comments qinps skolemMap consts tbls arrs uis axs asgnsSeq cstrs out config                 needsFloats  = KFloat  `Set.member` kindInfo                needsDoubles = KDouble `Set.member` kindInfo
Data/SBV/SMT/SMTLib2.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.SMT.SMTLib2--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.SMT.SMTLib2+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Conversion of symbolic programs to SMTLib format, Using v2 of the standard -----------------------------------------------------------------------------@@ -14,27 +14,29 @@ module Data.SBV.SMT.SMTLib2(cvt, cvtInc) where  import Data.Bits  (bit)-import Data.List  (intercalate, partition, unzip3, nub)+import Data.List  (intercalate, partition, unzip3, nub, sort) import Data.Maybe (listToMaybe, fromMaybe)  import qualified Data.Foldable as F (toList) import qualified Data.Map.Strict      as M import qualified Data.IntMap.Strict   as IM+import           Data.Set             (Set) import qualified Data.Set             as Set  import Data.SBV.Core.Data+import Data.SBV.Core.Symbolic (QueryContext(..)) import Data.SBV.Core.Kind (smtType) import Data.SBV.SMT.Utils import Data.SBV.Control.Types -import Data.SBV.Utils.PrettyNum (smtRoundingMode, cwToSMTLib)+import Data.SBV.Utils.PrettyNum (smtRoundingMode, cvToSMTLib)  tbd :: String -> a tbd e = error $ "SBV.SMTLib2: Not-yet-supported: " ++ e  -- | Translate a problem into an SMTLib2 script cvt :: SMTLibConverter [String]-cvt kindInfo isSat comments (inputs, trackerVars) skolemInps consts tbls arrs uis axs (SBVPgm asgnsSeq) cstrs out cfg = pgm+cvt ctx kindInfo isSat comments (inputs, trackerVars) skolemInps consts tbls arrs uis axs (SBVPgm asgnsSeq) cstrs out cfg = pgm   where hasInteger     = KUnbounded `Set.member` kindInfo         hasReal        = KReal      `Set.member` kindInfo         hasFloat       = KFloat     `Set.member` kindInfo@@ -42,10 +44,12 @@         hasChar        = KChar      `Set.member` kindInfo         hasDouble      = KDouble    `Set.member` kindInfo         hasBVs         = hasChar || not (null [() | KBounded{} <- Set.toList kindInfo])   -- Remember, characters map to Word8-        usorts         = [(s, dt) | KUserSort s dt <- Set.toList kindInfo]+        usorts         = [(s, dt) | KUninterpreted s dt <- Set.toList kindInfo]+        tupleArities   = findTupleArities kindInfo         hasNonBVArrays = (not . null) [() | (_, (_, (k1, k2), _)) <- arrs, not (isBounded k1 && isBounded k2)]         hasArrayInits  = (not . null) [() | (_, (_, _, ArrayFree (Just _))) <- arrs]         hasList        = any isList kindInfo+        hasTuples      = not . null $ tupleArities         rm             = roundingMode cfg         solverCaps     = capabilities (solver cfg) @@ -80,15 +84,22 @@              else if hasBVs                   then ["(set-logic QF_FPBV)"]                   else ["(set-logic QF_FP)"]-           | hasInteger || hasReal || not (null usorts) || hasNonBVArrays+           | hasInteger || hasReal || not (null usorts) || hasNonBVArrays || hasTuples            = let why | hasInteger        = "has unbounded values"                      | hasReal           = "has algebraic reals"                      | not (null usorts) = "has user-defined sorts"                      | hasNonBVArrays    = "has non-bitvector arrays"+                     | hasTuples         = "has tuples"                      | True              = "cannot determine the SMTLib-logic to use"              in ["(set-logic ALL) ; "  ++ why ++ ", using catch-all."]++           -- If we're in a user query context, we'll pick ALL, otherwise+           -- we'll stick to some bit-vector logic based on what we see in the problem.+           -- This is controversial, but seems to work well in practice.            | True-           = ["(set-logic " ++ qs ++ as ++ ufs ++ "BV)"]+           = case ctx of+               QueryExternal -> ["(set-logic ALL) ; external query, using all logics."]+               QueryInternal -> ["(set-logic " ++ qs ++ as ++ ufs ++ "BV)"]           where qs  | null foralls && null axs = "QF_"  -- axioms are likely to contain quantifiers                     | True                     = ""                 as  | null arrs                = ""@@ -113,16 +124,18 @@              ++ settings              ++ [ "; --- uninterpreted sorts ---" ]              ++ concatMap declSort usorts+             ++ [ "; --- tuples ---" ]+             ++ concatMap declTuple tupleArities              ++ [ "; --- literal constants ---" ]-             ++ map (declConst cfg) consts+             ++ concatMap (declConst cfg) consts              ++ [ "; --- skolem constants ---" ]-             ++ [ "(declare-fun " ++ show s ++ " " ++ swFunType ss s ++ ")" ++ userName s | Right (s, ss) <- skolemInps]+             ++ [ "(declare-fun " ++ show s ++ " " ++ svFunType ss s ++ ")" ++ userName s | Right (s, ss) <- skolemInps]              ++ [ "; --- optimization tracker variables ---" | not (null trackerVars) ]-             ++ [ "(declare-fun " ++ show s ++ " " ++ swFunType [] s ++ ") ; tracks " ++ nm | (s, nm) <- trackerVars]+             ++ [ "(declare-fun " ++ show s ++ " " ++ svFunType [] s ++ ") ; tracks " ++ nm | (s, nm) <- trackerVars]              ++ [ "; --- constant tables ---" ]              ++ concatMap (constTable False) constTables              ++ [ "; --- skolemized tables ---" ]-             ++ map (skolemTable (unwords (map swType foralls))) skolemTables+             ++ map (skolemTable (unwords (map svType foralls))) skolemTables              ++ [ "; --- arrays ---" ]              ++ concat arrayConstants              ++ [ "; --- uninterpreted constants ---" ]@@ -133,7 +146,7 @@               ++ map (declDef cfg skolemMap tableMap) preQuantifierAssigns              ++ ["(assert (forall (" ++ intercalate "\n                 "-                                        ["(" ++ show s ++ " " ++ swType s ++ ")" | s <- foralls] ++ ")"+                                        ["(" ++ show s ++ " " ++ svType s ++ ")" | s <- foralls] ++ ")"                 | not (null foralls)                 ]              ++ map mkAssign postQuantifierAssigns@@ -155,7 +168,7 @@            where first      = nodeId (minimum foralls)                  pre (s, _) = nodeId s < first -                 nodeId (SW _ n) = n+                 nodeId (SV _ n) = n          noOfCloseParens           | null foralls = 0@@ -177,9 +190,11 @@         letShift = align 12          finalAssert+          | null foralls && noConstraints+          = []           | null foralls-          =    map (\a -> "(assert "      ++ uncurry addAnnotations a ++ ")") hardAsserts-            ++ map (\a -> "(assert-soft " ++ uncurry addAnnotations a ++ ")") softAsserts+          =    map (\(attr, v) -> "(assert "      ++ addAnnotations attr (mkLiteral v) ++ ")") hardAsserts+            ++ map (\(attr, v) -> "(assert-soft " ++ addAnnotations attr (mkLiteral v) ++ ")") softAsserts           | not (null namedAsserts)           = error $ intercalate "\n" [ "SBV: Constraints with attributes and quantifiers cannot be mixed!"                                      , "   Quantified variables: " ++ unwords (map show foralls)@@ -192,15 +207,28 @@                                      ]           | True           = [impAlign (letShift combined) ++ replicate noOfCloseParens ')']-          where namedAsserts = [findName attrs | (_, attrs, _) <- assertions, not (null attrs)]+          where mkLiteral (Left  v) =            cvtSV skolemMap v+                mkLiteral (Right v) = "(not " ++ cvtSV skolemMap v ++ ")"++                (noConstraints, assertions) = finalAssertions++                namedAsserts = [findName attrs | (_, attrs, _) <- assertions, not (null attrs)]                  where findName attrs = fromMaybe "<anonymous>" (listToMaybe [nm | (":named", nm) <- attrs]) +                hardAsserts, softAsserts :: [([(String, String)], Either SV SV)]                 hardAsserts = [(attr, v) | (False, attr, v) <- assertions]                 softAsserts = [(attr, v) | (True,  attr, v) <- assertions] -                combined = case map snd hardAsserts of-                             [x] -> x-                             xs  -> "(and " ++ unwords xs ++ ")"+                combined = case lits of+                             []               -> "true"+                             [x]              -> mkLiteral x+                             xs  | any bad xs -> "false"+                                 | True       -> "(and " ++ unwords (map mkLiteral xs) ++ ")"+                  where lits = filter (not . redundant) $ nub (sort (map snd hardAsserts))+                        redundant (Left v)  = v == trueSV+                        redundant (Right v) = v == falseSV+                        bad (Left  v) = v == falseSV+                        bad (Right v) = v == trueSV          impAlign s           | null delayedEqualities = s@@ -208,23 +236,10 @@          align n s = replicate n ' ' ++ s -        -- We have:-        --    - cstrs   : Explicitly given constraints (via calls to constrain)-        --    - p1..pn  : The path conditions in a case-split that led us here. This is given in a case-split.-        --    - c1..cm  : All the other case-split constraints for the coverage case. This is in a case-coverage.-        -- if sat:-        --     -- we assert (cstrs /\ (p1 /\ p2 /\ ... /\ pn) /\ ~(c1 \/ c2 \/ .. \/ cm) /\ out)-        --            i.e., cstrs /\ p1 /\ p2 /\ ... /\ pn /\ ~c1 /\ ~c2 /\ ~c3 .. /\ ~cm /\ out-        -- if prove:-        --     -- we assert ~((cstrs /\  (p1 /\ p2 /\ .. /\ pn) /\ ~(c1 \/ c2 \/ .. \/ cm)) => out)-        --            i.e., cstrs /\ p1 /\ p2 /\ .. /\ pn /\ ~c1 /\ ~c2 /\ ~c3 .. /\ ~cm /\ ~out-        -- That is, we always assert all path constraints and path conditions AND-        --     -- negation of the output in a prove-        --     -- output itself in a sat-        assertions :: [(Bool, [(String, String)], String)]-        assertions-           | null finals = [(False, [], cvtSW skolemMap trueSW)]-           | True        = finals+        finalAssertions :: (Bool, [(Bool, [(String, String)], Either SV SV)])  -- If Left: positive, Right: negative+        finalAssertions+           | null finals = (True,  [(False, [], Left trueSV)])+           | True        = (False, finals)             where finals  = cstrs' ++ maybe [] (\r -> [(False, [], r)]) mbO @@ -234,14 +249,14 @@                      | True  = neg out                   neg s-                  | s == trueSW  = Just $ cvtSW skolemMap falseSW-                  | s == falseSW = Nothing-                  | True         = Just $ "(not " ++ cvtSW skolemMap s ++ ")"+                  | s == falseSV = Nothing+                  | s == trueSV  = Just $ Left falseSV+                  | True         = Just $ Right s                   pos s-                  | s == trueSW  = Nothing-                  | s == falseSW = Just $ cvtSW skolemMap falseSW-                  | True         = Just $ cvtSW skolemMap s+                  | s == trueSV  = Nothing+                  | s == falseSV = Just $ Left falseSV+                  | True         = Just $ Left s          skolemMap = M.fromList [(s, ss) | Right (s, ss) <- skolemInps, not (null ss)]         tableMap  = IM.fromList $ map mkConstTable constTables ++ map mkSkTable skolemTables@@ -253,7 +268,7 @@           | null foralls = declDef cfg skolemMap tableMap a           | True         = letShift (mkLet a) -        mkLet (s, SBVApp (Label m) [e]) = "(let ((" ++ show s ++ " " ++ cvtSW                skolemMap          e ++ ")) ; " ++ m+        mkLet (s, SBVApp (Label m) [e]) = "(let ((" ++ show s ++ " " ++ cvtSV                skolemMap          e ++ ")) ; " ++ m         mkLet (s, e)                    = "(let ((" ++ show s ++ " " ++ cvtExp solverCaps rm skolemMap tableMap e ++ "))"          userName s = case s `lookup` map snd inputs of@@ -273,13 +288,52 @@               body [_]    i = show i               body (c:cs) i = "(ite (= x " ++ c ++ ") " ++ show i ++ " " ++ body cs (i+1) ++ ")" +-- | Declare tuple datatypes+--+-- eg:+--+-- @+-- (declare-datatypes ((SBVTuple2 2)) ((par (T1 T2)+--                                     ((mkSBVTuple2 (proj_1_SBVTuple2 T1)+--                                                   (proj_2_SBVTuple2 T2))))))+-- @+declTuple :: Int -> [String]+declTuple arity+  | arity == 0 = ["(declare-datatypes () ((SBVTuple0 SBVTuple0)))"]+  | arity == 1 = error "Data.SBV.declTuple: Unexpected one-tuple"+  | True       =    (l1 ++ "(par (" ++ unwords [param i | i <- [1..arity]] ++ ")")+                 :  [pre i ++ proj i ++ post i    | i <- [1..arity]]+  where l1     = "(declare-datatypes ((SBVTuple" ++ show arity ++ " " ++ show arity ++ ")) ("+        l2     = replicate (length l1) ' ' ++ "((mkSBVTuple" ++ show arity ++ " "+        tab    = replicate (length l2) ' '++        pre 1  = l2+        pre _  = tab++        proj i = "(proj_" ++ show i ++ "_SBVTuple" ++ show arity ++ " " ++ param i ++ ")"++        post i = if i == arity then ")))))" else ""++        param i = "T" ++ show i++-- | Find the set of tuple sizes to declare, eg (2-tuple, 5-tuple).+-- NB. We do *not* need to recursively go into list/tuple kinds here,+-- because register-kind function automatically registers all subcomponent+-- kinds, thus everything we need is available at the top-level.+findTupleArities :: Set Kind -> [Int]+findTupleArities ks = Set.toAscList+                    $ Set.map length+                    $ Set.fromList [ tupKs | KTuple tupKs <- Set.toList ks ]+ -- | Convert in a query context cvtInc :: Bool -> SMTLibIncConverter [String]-cvtInc afterAPush inps ks consts arrs tbls uis (SBVPgm asgnsSeq) cfg =+cvtInc afterAPush inps newKs consts arrs tbls uis (SBVPgm asgnsSeq) cfg =             -- sorts-               concatMap declSort [(s, dt) | KUserSort s dt <- Set.toList ks]+               concatMap declSort [(s, dt) | KUninterpreted s dt <- Set.toList newKs]+            -- tuples. NB. Only declare the new sizes, old sizes persist.+            ++ concatMap declTuple (findTupleArities newKs)             -- constants-            ++ map (declConst cfg) consts+            ++ concatMap (declConst cfg) consts             -- inputs             ++ map declInp inps             -- arrays@@ -300,7 +354,7 @@          rm = roundingMode cfg -        declInp (s, _) = "(declare-fun " ++ show s ++ " () " ++ swType s ++ ")"+        declInp (s, _) = "(declare-fun " ++ show s ++ " () " ++ svType s ++ ")"          (arrayConstants, arrayDelayeds, arraySetups) = unzip3 $ map (declArray cfg afterAPush False consts skolemMap) arrs @@ -308,21 +362,26 @@         tableMap  = IM.fromList $ map mkTable allTables           where mkTable (((t, _, _), _), _) = (t, "table" ++ show t) -declDef :: SMTConfig -> SkolemMap -> TableMap -> (SW, SBVExpr) -> String+declDef :: SMTConfig -> SkolemMap -> TableMap -> (SV, SBVExpr) -> String declDef cfg skolemMap tableMap (s, expr) =         case expr of-          SBVApp  (Label m) [e] -> defineFun (s, cvtSW          skolemMap          e) (Just m)+          SBVApp  (Label m) [e] -> defineFun (s, cvtSV          skolemMap          e) (Just m)           e                     -> defineFun (s, cvtExp caps rm skolemMap tableMap e) Nothing   where caps = capabilities (solver cfg)         rm   = roundingMode cfg -defineFun :: (SW, String) -> Maybe String -> String+defineFun :: (SV, String) -> Maybe String -> String defineFun (s, def) mbComment = "(define-fun "   ++ varT ++ " " ++ def ++ ")" ++ cmnt-  where varT      = show s ++ " " ++ swFunType [] s+  where varT      = show s ++ " " ++ svFunType [] s         cmnt      = maybe "" (" ; " ++) mbComment -declConst :: SMTConfig -> (SW, CW) -> String-declConst cfg (s, c) = defineFun (s, cvtCW (roundingMode cfg) c) Nothing+-- Declare constants. NB. We don't declare true/false; but just inline those as necessary+declConst :: SMTConfig -> (SV, CV) -> [String]+declConst cfg (s, c)+  | s == falseSV || s == trueSV+  = []+  | True+  = [defineFun (s, cvtCV (roundingMode cfg) c) Nothing]  declUI :: (String, SBVType) -> [String] declUI (i, t) = ["(declare-fun " ++ i ++ " " ++ cvtType t ++ ")"]@@ -331,7 +390,7 @@ declAx :: (String, [String]) -> String declAx (nm, ls) = (";; -- user given axiom: " ++ nm ++ "\n") ++ intercalate "\n" ls -constTable :: Bool -> (((Int, Kind, Kind), [SW]), [String]) -> [String]+constTable :: Bool -> (((Int, Kind, Kind), [SV]), [String]) -> [String] constTable afterAPush (((i, ak, rk), _elts), is) = decl : zipWith wrap [(0::Int)..] is ++ setup   where t       = "table" ++ show i         decl    = "(declare-fun " ++ t ++ " (" ++ smtType ak ++ ") " ++ smtType rk ++ ")"@@ -355,32 +414,35 @@                              ]  -skolemTable :: String -> (((Int, Kind, Kind), [SW]), [String]) -> String+skolemTable :: String -> (((Int, Kind, Kind), [SV]), [String]) -> String skolemTable qsIn (((i, ak, rk), _elts), _) = decl   where qs   = if null qsIn then "" else qsIn ++ " "         t    = "table" ++ show i         decl = "(declare-fun " ++ t ++ " (" ++ qs ++ smtType ak ++ ") " ++ smtType rk ++ ")"  -- Left if all constants, Right if otherwise-genTableData :: RoundingMode -> SkolemMap -> (Bool, String) -> [SW] -> ((Int, Kind, Kind), [SW]) -> Either [String] [String]+genTableData :: RoundingMode -> SkolemMap -> (Bool, String) -> [SV] -> ((Int, Kind, Kind), [SV]) -> Either [String] [String] genTableData rm skolemMap (_quantified, args) consts ((i, aknd, _), elts)   | null post = Left  (map (topLevel . snd) pre)   | True      = Right (map (nested   . snd) (pre ++ post))-  where ssw = cvtSW skolemMap+  where ssv = cvtSV skolemMap         (pre, post) = partition fst (zipWith mkElt elts [(0::Int)..])         t           = "table" ++ show i-        mkElt x k   = (isReady, (idx, ssw x))-          where idx = cvtCW rm (mkConstCW aknd k)++        mkElt x k   = (isReady, (idx, ssv x))+          where idx = cvtCV rm (mkConstCV aknd k)                 isReady = x `Set.member` constsSet+         topLevel (idx, v) = "(= (" ++ t ++ " " ++ idx ++ ") " ++ v ++ ")"         nested   (idx, v) = "(= (" ++ t ++ args ++ " " ++ idx ++ ") " ++ v ++ ")"+         constsSet = Set.fromList consts  -- TODO: We currently do not support non-constant arrays when quantifiers are present, as -- we might have to skolemize those. Implement this properly. -- The difficulty is with the Mutate/Merge: We have to postpone an init if -- the components are themselves postponed, so this cannot be implemented as a simple map.-declArray :: SMTConfig -> Bool -> Bool -> [(SW, CW)] -> SkolemMap -> (Int, ArrayInfo) -> ([String], [String], [String])+declArray :: SMTConfig -> Bool -> Bool -> [(SV, CV)] -> SkolemMap -> (Int, ArrayInfo) -> ([String], [String], [String]) declArray cfg afterAPush quantified consts skolemMap (i, (_, (aKnd, bKnd), ctx)) = (adecl : zipWith wrap [(0::Int)..] (map snd pre), zipWith wrap [lpre..] (map snd post), setup)   where constNames = map fst consts         topLevel = not quantified || case ctx of@@ -389,11 +451,13 @@                                        ArrayMerge c _ _   -> c `elem` constNames         (pre, post) = partition fst ctxInfo         nm = "array_" ++ show i-        ssw sw-         | topLevel || sw `elem` constNames-         = cvtSW skolemMap sw++        ssv sv+         | topLevel || sv `elem` constNames+         = cvtSV skolemMap sv          | True          = tbd "Non-constant array initializer in a quantified context"+         atyp  = "(Array " ++ smtType aKnd ++ " " ++ smtType bKnd ++ ")"          adecl = case ctx of@@ -403,22 +467,25 @@         -- CVC4 chokes if the initializer is not a constant. (Z3 is ok with it.) So, print it as         -- a constant if we have it in the constants; otherwise, we merely print it and hope for the best.         constInit v = case v `lookup` consts of-                        Nothing -> ssw v                      -- Z3 will work, CVC4 will choke. Others don't even support this.-                        Just c  -> cvtCW (roundingMode cfg) c -- Z3 and CVC4 will work. Other's don't support this.+                        Nothing -> ssv v                      -- Z3 will work, CVC4 will choke. Others don't even support this.+                        Just c  -> cvtCV (roundingMode cfg) c -- Z3 and CVC4 will work. Other's don't support this.          ctxInfo = case ctx of                     ArrayFree _       -> []-                    ArrayMutate j a b -> [(all (`elem` constNames) [a, b], "(= " ++ nm ++ " (store array_" ++ show j ++ " " ++ ssw a ++ " " ++ ssw b ++ "))")]-                    ArrayMerge  t j k -> [(t `elem` constNames,            "(= " ++ nm ++ " (ite " ++ ssw t ++ " array_" ++ show j ++ " array_" ++ show k ++ "))")]+                    ArrayMutate j a b -> [(all (`elem` constNames) [a, b], "(= " ++ nm ++ " (store array_" ++ show j ++ " " ++ ssv a ++ " " ++ ssv b ++ "))")]+                    ArrayMerge  t j k -> [(t `elem` constNames,            "(= " ++ nm ++ " (ite " ++ ssv t ++ " array_" ++ show j ++ " array_" ++ show k ++ "))")]          -- Arrange for initializers         mkInit idx    = "array_" ++ show i ++ "_initializer_" ++ show (idx :: Int)         initializer   = "array_" ++ show i ++ "_initializer"+         wrap index s           | afterAPush = "(define-fun " ++ mkInit index ++ " () Bool " ++ s ++ ")"           | True       = "(assert " ++ s ++ ")"+         lpre          = length pre         lAll          = lpre + length post+         setup           | not afterAPush = []           | lAll == 0      = [ "(define-fun " ++ initializer ++ " () Bool true) ; no initializiation needed"@@ -430,29 +497,34 @@                              , "(assert " ++ initializer ++ ")"                              ] -swType :: SW -> String-swType s = smtType (kindOf s)+svType :: SV -> String+svType s = smtType (kindOf s) -swFunType :: [SW] -> SW -> String-swFunType ss s = "(" ++ unwords (map swType ss) ++ ") " ++ swType s+svFunType :: [SV] -> SV -> String+svFunType ss s = "(" ++ unwords (map svType ss) ++ ") " ++ svType s  cvtType :: SBVType -> String cvtType (SBVType []) = error "SBV.SMT.SMTLib2.cvtType: internal: received an empty type!" cvtType (SBVType xs) = "(" ++ unwords (map smtType body) ++ ") " ++ smtType ret   where (body, ret) = (init xs, last xs) -type SkolemMap = M.Map  SW [SW]+type SkolemMap = M.Map SV [SV] type TableMap  = IM.IntMap String -cvtSW :: SkolemMap -> SW -> String-cvtSW skolemMap s+-- Present an SV; inline true/false as needed+cvtSV :: SkolemMap -> SV -> String+cvtSV skolemMap s@(SV _ (NodeId n))   | Just ss <- s `M.lookup` skolemMap   = "(" ++ show s ++ concatMap ((" " ++) . show) ss ++ ")"+  | s == trueSV+  = "true"+  | s == falseSV+  = "false"   | True-  = show s+  = 's' : show n -cvtCW :: RoundingMode -> CW -> String-cvtCW = cwToSMTLib+cvtCV :: RoundingMode -> CV -> String+cvtCV = cvToSMTLib  getTable :: TableMap -> Int -> String getTable m i@@ -461,7 +533,7 @@  cvtExp :: SolverCapabilities -> RoundingMode -> SkolemMap -> TableMap -> SBVExpr -> String cvtExp caps rm skolemMap tableMap expr@(SBVApp _ arguments) = sh expr-  where ssw = cvtSW skolemMap+  where ssv = cvtSV skolemMap          supportsPB = supportsPseudoBooleans caps @@ -505,7 +577,7 @@           where mkAbs x cmp neg = "(ite " ++ ltz ++ " " ++ nx ++ " " ++ x ++ ")"                   where ltz = "(" ++ cmp ++ " " ++ x ++ " " ++ z ++ ")"                         nx  = "(" ++ neg ++ " " ++ x ++ ")"-                        z   = cvtCW rm (mkConstCW (kindOf (head arguments)) (0::Integer))+                        z   = cvtCV rm (mkConstCV (kindOf (head arguments)) (0::Integer))          lift2B bOp vOp           | boolOp = lift2 bOp@@ -542,7 +614,7 @@                       | True                = lift2 o          unintComp o [a, b]-          | KUserSort s (Right _) <- kindOf (head arguments)+          | KUninterpreted s (Right _) <- kindOf (head arguments)           = let idx v = "(" ++ s ++ "_constrIndex " ++ v ++ ")" in "(" ++ o ++ " " ++ idx a ++ " " ++ idx b ++ ")"         unintComp o sbvs = error $ "SBV.SMT.SMTLib2.sh.unintComp: Unexpected arguments: "   ++ show (o, sbvs) @@ -565,70 +637,76 @@         lift1  o _ [x]    = "(" ++ o ++ " " ++ x ++ ")"         lift1  o _ sbvs   = error $ "SBV.SMT.SMTLib2.sh.lift1: Unexpected arguments: "   ++ show (o, sbvs) -        sh (SBVApp Ite [a, b, c]) = "(ite " ++ ssw a ++ " " ++ ssw b ++ " " ++ ssw c ++ ")"+        sh (SBVApp Ite [a, b, c]) = "(ite " ++ ssv a ++ " " ++ ssv b ++ " " ++ ssv c ++ ")"          sh (SBVApp (LkUp (t, aKnd, _, l) i e) [])-          | needsCheck = "(ite " ++ cond ++ ssw e ++ " " ++ lkUp ++ ")"+          | needsCheck = "(ite " ++ cond ++ ssv e ++ " " ++ lkUp ++ ")"           | True       = lkUp           where needsCheck = case aKnd of-                              KBool         -> (2::Integer) > fromIntegral l-                              KBounded _ n  -> (2::Integer)^n > fromIntegral l-                              KUnbounded    -> True-                              KReal         -> error "SBV.SMT.SMTLib2.cvtExp: unexpected real valued index"-                              KFloat        -> error "SBV.SMT.SMTLib2.cvtExp: unexpected float valued index"-                              KDouble       -> error "SBV.SMT.SMTLib2.cvtExp: unexpected double valued index"-                              KChar         -> error "SBV.SMT.SMTLib2.cvtExp: unexpected char valued index"-                              KString       -> error "SBV.SMT.SMTLib2.cvtExp: unexpected string valued index"-                              KList k       -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected list valued: " ++ show k-                              KUserSort s _ -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected uninterpreted valued index: " ++ s-                lkUp = "(" ++ getTable tableMap t ++ " " ++ ssw i ++ ")"+                              KBool              -> (2::Integer) > fromIntegral l+                              KBounded _ n       -> (2::Integer)^n > fromIntegral l+                              KUnbounded         -> True+                              KReal              -> error "SBV.SMT.SMTLib2.cvtExp: unexpected real valued index"+                              KFloat             -> error "SBV.SMT.SMTLib2.cvtExp: unexpected float valued index"+                              KDouble            -> error "SBV.SMT.SMTLib2.cvtExp: unexpected double valued index"+                              KChar              -> error "SBV.SMT.SMTLib2.cvtExp: unexpected char valued index"+                              KString            -> error "SBV.SMT.SMTLib2.cvtExp: unexpected string valued index"+                              KList k            -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected list valued: " ++ show k+                              KTuple k           -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected tuple valued: " ++ show k+                              KUninterpreted s _ -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected uninterpreted valued index: " ++ s++                lkUp = "(" ++ getTable tableMap t ++ " " ++ ssv i ++ ")"+                 cond                  | hasSign i = "(or " ++ le0 ++ " " ++ gtl ++ ") "                  | True      = gtl ++ " "+                 (less, leq) = case aKnd of-                                KBool         -> error "SBV.SMT.SMTLib2.cvtExp: unexpected boolean valued index"-                                KBounded{}    -> if hasSign i then ("bvslt", "bvsle") else ("bvult", "bvule")-                                KUnbounded    -> ("<", "<=")-                                KReal         -> ("<", "<=")-                                KFloat        -> ("fp.lt", "fp.leq")-                                KDouble       -> ("fp.lt", "fp.geq")-                                KChar         -> error "SBV.SMT.SMTLib2.cvtExp: unexpected string valued index"-                                KString       -> error "SBV.SMT.SMTLib2.cvtExp: unexpected string valued index"-                                KList k       -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected sequence valued index: " ++ show k-                                KUserSort s _ -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected uninterpreted valued index: " ++ s-                mkCnst = cvtCW rm . mkConstCW (kindOf i)-                le0  = "(" ++ less ++ " " ++ ssw i ++ " " ++ mkCnst 0 ++ ")"-                gtl  = "(" ++ leq  ++ " " ++ mkCnst l ++ " " ++ ssw i ++ ")"+                                KBool              -> error "SBV.SMT.SMTLib2.cvtExp: unexpected boolean valued index"+                                KBounded{}         -> if hasSign i then ("bvslt", "bvsle") else ("bvult", "bvule")+                                KUnbounded         -> ("<", "<=")+                                KReal              -> ("<", "<=")+                                KFloat             -> ("fp.lt", "fp.leq")+                                KDouble            -> ("fp.lt", "fp.geq")+                                KChar              -> error "SBV.SMT.SMTLib2.cvtExp: unexpected string valued index"+                                KString            -> error "SBV.SMT.SMTLib2.cvtExp: unexpected string valued index"+                                KList k            -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected sequence valued index: " ++ show k+                                KTuple k           -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected tuple valued index: " ++ show k+                                KUninterpreted s _ -> error $ "SBV.SMT.SMTLib2.cvtExp: unexpected uninterpreted valued index: " ++ s -        sh (SBVApp (KindCast f t) [a]) = handleKindCast f t (ssw a)+                mkCnst = cvtCV rm . mkConstCV (kindOf i)+                le0  = "(" ++ less ++ " " ++ ssv i ++ " " ++ mkCnst 0 ++ ")"+                gtl  = "(" ++ leq  ++ " " ++ mkCnst l ++ " " ++ ssv i ++ ")" +        sh (SBVApp (KindCast f t) [a]) = handleKindCast f t (ssv a)+         sh (SBVApp (ArrEq i j) [])  = "(= array_" ++ show i ++ " array_" ++ show j ++")"-        sh (SBVApp (ArrRead i) [a]) = "(select array_" ++ show i ++ " " ++ ssw a ++ ")"+        sh (SBVApp (ArrRead i) [a]) = "(select array_" ++ show i ++ " " ++ ssv a ++ ")"          sh (SBVApp (Uninterpreted nm) [])   = nm-        sh (SBVApp (Uninterpreted nm) args) = "(" ++ nm ++ " " ++ unwords (map ssw args) ++ ")"+        sh (SBVApp (Uninterpreted nm) args) = "(" ++ nm ++ " " ++ unwords (map ssv args) ++ ")" -        sh (SBVApp (Extract i j) [a]) | ensureBV = "((_ extract " ++ show i ++ " " ++ show j ++ ") " ++ ssw a ++ ")"+        sh (SBVApp (Extract i j) [a]) | ensureBV = "((_ extract " ++ show i ++ " " ++ show j ++ ") " ++ ssv a ++ ")"          sh (SBVApp (Rol i) [a])-           | bvOp  = rot ssw "rotate_left"  i a+           | bvOp  = rot ssv "rotate_left"  i a            | True  = bad          sh (SBVApp (Ror i) [a])-           | bvOp  = rot  ssw "rotate_right" i a+           | bvOp  = rot  ssv "rotate_right" i a            | True  = bad          sh (SBVApp Shl [a, i])-           | bvOp   = shft ssw "bvshl"  "bvshl" a i+           | bvOp   = shft ssv "bvshl"  "bvshl" a i            | True   = bad          sh (SBVApp Shr [a, i])-           | bvOp  = shft ssw "bvlshr" "bvashr" a i+           | bvOp  = shft ssv "bvlshr" "bvashr" a i            | True  = bad          sh (SBVApp op args)           | Just f <- lookup op smtBVOpTable, ensureBVOrBool-          = f (any hasSign args) (map ssw args)+          = f (any hasSign args) (map ssv args)           where -- The first 4 operators below do make sense for Integer's in Haskell, but there's                 -- no obvious counterpart for them in the SMTLib translation.                 -- TODO: provide support for these.@@ -639,44 +717,48 @@                                , (Join, lift2 "concat")                                ] -        sh (SBVApp (Label _) [a]) = cvtSW skolemMap a  -- This won't be reached; but just in case!+        sh (SBVApp (Label _) [a]) = cvtSV skolemMap a  -- This won't be reached; but just in case! -        sh (SBVApp (IEEEFP (FP_Cast kFrom kTo m)) args) = handleFPCast kFrom kTo (ssw m) (unwords (map ssw args))-        sh (SBVApp (IEEEFP w                    ) args) = "(" ++ show w ++ " " ++ unwords (map ssw args) ++ ")"+        sh (SBVApp (IEEEFP (FP_Cast kFrom kTo m)) args) = handleFPCast kFrom kTo (ssv m) (unwords (map ssv args))+        sh (SBVApp (IEEEFP w                    ) args) = "(" ++ show w ++ " " ++ unwords (map ssv args) ++ ")"          sh (SBVApp (PseudoBoolean pb) args)           | supportsPB = handlePB pb args'           | True       = reducePB pb args'-          where args' = map ssw args+          where args' = map ssv args          -- NB: Z3 semantics have the predicates reversed: i.e., it returns true if overflow isn't possible. Hence the not.-        sh (SBVApp (OverflowOp op) args) = "(not (" ++ show op ++ " " ++ unwords (map ssw args) ++ "))"+        sh (SBVApp (OverflowOp op) args) = "(not (" ++ show op ++ " " ++ unwords (map ssv args) ++ "))"          -- Note the unfortunate reversal in StrInRe..-        sh (SBVApp (StrOp (StrInRe r)) args) = "(str.in.re " ++ unwords (map ssw args) ++ " " ++ show r ++ ")"-        sh (SBVApp (StrOp op)          args) = "(" ++ show op ++ " " ++ unwords (map ssw args) ++ ")"+        sh (SBVApp (StrOp (StrInRe r)) args) = "(str.in.re " ++ unwords (map ssv args) ++ " " ++ show r ++ ")"+        sh (SBVApp (StrOp op)          args) = "(" ++ show op ++ " " ++ unwords (map ssv args) ++ ")" -        sh (SBVApp (SeqOp op) args) = "(" ++ show op ++ " " ++ unwords (map ssw args) ++ ")"+        sh (SBVApp (SeqOp op) args) = "(" ++ show op ++ " " ++ unwords (map ssv args) ++ ")" +        sh (SBVApp (TupleConstructor 0)   [])    = "SBVTuple0"+        sh (SBVApp (TupleConstructor n)   args)  = "(mkSBVTuple" ++ show n ++ " " ++ unwords (map ssv args) ++ ")"+        sh (SBVApp (TupleAccess      i n) [tup]) = "(proj_" ++ show i ++ "_SBVTuple" ++ show n ++ " " ++ ssv tup ++ ")"+         sh inp@(SBVApp op args)           | intOp, Just f <- lookup op smtOpIntTable-          = f True (map ssw args)+          = f True (map ssv args)           | boolOp, Just f <- lookup op boolComps-          = f (map ssw args)+          = f (map ssv args)           | bvOp, Just f <- lookup op smtOpBVTable-          = f (any hasSign args) (map ssw args)+          = f (any hasSign args) (map ssv args)           | realOp, Just f <- lookup op smtOpRealTable-          = f (any hasSign args) (map ssw args)+          = f (any hasSign args) (map ssv args)           | floatOp || doubleOp, Just f <- lookup op smtOpFloatDoubleTable-          = f (any hasSign args) (map ssw args)+          = f (any hasSign args) (map ssv args)           | charOp, Just f <- lookup op smtCharTable-          = f False (map ssw args)+          = f False (map ssv args)           | stringOp, Just f <- lookup op smtStringTable-          = f (map ssw args)+          = f (map ssv args)           | listOp, Just f <- lookup op smtListTable-          = f (map ssw args)+          = f (map ssv args)           | Just f <- lookup op uninterpretedTable-          = f (map ssw args)+          = f (map ssv args)           | True           = if not (null args) && isUninterpreted (head args)             then error $ unlines [ ""@@ -838,11 +920,11 @@         -- Nothing else should come up:         cast f                  d                  _ = error $ "SBV.SMTLib2: Unexpected FPCast from: " ++ show f ++ " to " ++ show d -rot :: (SW -> String) -> String -> Int -> SW -> String-rot ssw o c x = "((_ " ++ o ++ " " ++ show c ++ ") " ++ ssw x ++ ")"+rot :: (SV -> String) -> String -> Int -> SV -> String+rot ssv o c x = "((_ " ++ o ++ " " ++ show c ++ ") " ++ ssv x ++ ")" -shft :: (SW -> String) -> String -> String -> SW -> SW -> String-shft ssw oW oS x c = "(" ++ o ++ " " ++ ssw x ++ " " ++ ssw c ++ ")"+shft :: (SV -> String) -> String -> String -> SV -> SV -> String+shft ssv oW oS x c = "(" ++ o ++ " " ++ ssv x ++ " " ++ ssv c ++ ")"    where o = if hasSign x then oS else oW  -- Various casts
Data/SBV/SMT/SMTLibNames.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.SMT.SMTLibNames--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.SMT.SMTLibNames+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- SMTLib Reserved names -----------------------------------------------------------------------------
Data/SBV/SMT/Utils.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.SMT.Utils--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.SMT.Utils+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A few internally used types/routines -----------------------------------------------------------------------------@@ -27,6 +27,7 @@ import qualified Control.Exception as C  import Data.SBV.Core.Data+import Data.SBV.Core.Symbolic (QueryContext) import Data.SBV.Utils.Lib (joinArgs)  import Data.List (intercalate)@@ -35,31 +36,32 @@ import System.Exit (ExitCode(..))  -- | An instance of SMT-Lib converter; instantiated for SMT-Lib v1 and v2. (And potentially for newer versions in the future.)-type SMTLibConverter a =  Set.Set Kind                                  -- ^ Kinds used in the problem+type SMTLibConverter a =  QueryContext                                  -- ^ Internal or external query?+                       -> Set.Set Kind                                  -- ^ Kinds used in the problem                        -> Bool                                          -- ^ is this a sat problem?                        -> [String]                                      -- ^ extra comments to place on top                        -> ([(Quantifier, NamedSymVar)], [NamedSymVar])  -- ^ inputs and aliasing names and trackers-                       -> [Either SW (SW, [SW])]                        -- ^ skolemized inputs-                       -> [(SW, CW)]                                    -- ^ constants-                       -> [((Int, Kind, Kind), [SW])]                   -- ^ auto-generated tables+                       -> [Either SV (SV, [SV])]                        -- ^ skolemized inputs+                       -> [(SV, CV)]                                    -- ^ constants+                       -> [((Int, Kind, Kind), [SV])]                   -- ^ auto-generated tables                        -> [(Int, ArrayInfo)]                            -- ^ user specified arrays                        -> [(String, SBVType)]                           -- ^ uninterpreted functions/constants                        -> [(String, [String])]                          -- ^ user given axioms                        -> SBVPgm                                        -- ^ assignments-                       -> [(Bool, [(String, String)], SW)]              -- ^ extra constraints-                       -> SW                                            -- ^ output variable+                       -> [(Bool, [(String, String)], SV)]              -- ^ extra constraints+                       -> SV                                            -- ^ output variable                        -> SMTConfig                                     -- ^ configuration                        -> a  -- | An instance of SMT-Lib converter; instantiated for SMT-Lib v1 and v2. (And potentially for newer versions in the future.)-type SMTLibIncConverter a =  [NamedSymVar]               -- ^ inputs-                          -> Set.Set Kind                -- ^ Newly registered kinds-                          -> [(SW, CW)]                  -- ^ constants-                          -> [(Int, ArrayInfo)]          -- ^ newly created arrays-                          -> [((Int, Kind, Kind), [SW])] -- ^ newly created tables-                          -> [(String, SBVType)]         -- ^ newly created uninterpreted functions/constants-                          -> SBVPgm                      -- ^ assignments-                          -> SMTConfig                   -- ^ configuration+type SMTLibIncConverter a =  [NamedSymVar]                -- ^ inputs+                          -> Set.Set Kind                 -- ^ new kinds+                          -> [(SV, CV)]                   -- ^ constants+                          -> [(Int, ArrayInfo)]           -- ^ newly created arrays+                          -> [((Int, Kind, Kind), [SV])]  -- ^ newly created tables+                          -> [(String, SBVType)]          -- ^ newly created uninterpreted functions/constants+                          -> SBVPgm                       -- ^ assignments+                          -> SMTConfig                    -- ^ configuration                           -> a  -- | Create an annotated term
Data/SBV/String.hs view
@@ -1,14 +1,10 @@-{-# LANGUAGE Rank2Types          #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}- ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.String--- Copyright   :  (c) Joel Burget, Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.String+-- Author    : Joel Burget, Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A collection of string/character utilities, useful when working -- with symbolic strings. To the extent possible, the functions@@ -18,11 +14,16 @@ -- used as symbolic-strings. ----------------------------------------------------------------------------- +{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE Rank2Types          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}+ module Data.SBV.String (         -- * Length, emptiness           length, null         -- * Deconstructing/Reconstructing-        , head, tail, init, singleton, strToStrAt, strToCharAt, (.!!), implode, concat, (.:), (.++)+        , head, tail, uncons, init, singleton, strToStrAt, strToCharAt, (.!!), implode, concat, (.:), nil, (.++)         -- * Containment         , isInfixOf, isSuffixOf, isPrefixOf         -- * Substrings@@ -36,17 +37,17 @@  import Data.SBV.Core.Data hiding (SeqOp(..)) import Data.SBV.Core.Model-import Data.SBV.Utils.Boolean ((==>))  import qualified Data.Char as C import Data.List (genericLength, genericIndex, genericDrop, genericTake) import qualified Data.List as L (tails, isSuffixOf, isPrefixOf, isInfixOf) +import Data.Proxy+ -- For doctest use only -- -- $setup -- >>> import Data.SBV.Provers.Prover (prove, sat)--- >>> import Data.SBV.Utils.Boolean  ((&&&), bnot, (<=>)) -- >>> :set -XOverloadedStrings  -- | Length of a string.@@ -63,9 +64,9 @@  -- | @`null` s@ is True iff the string is empty ----- >>> prove $ \s -> null s <=> length s .== 0+-- >>> prove $ \s -> null s .<=> length s .== 0 -- Q.E.D.--- >>> prove $ \s -> null s <=> s .== ""+-- >>> prove $ \s -> null s .<=> s .== "" -- Q.E.D. null :: SString -> SBool null s@@ -85,9 +86,9 @@ -- -- >>> prove $ \h s -> tail (singleton h .++ s) .== s -- Q.E.D.--- >>> prove $ \s -> length s .> 0 ==> length (tail s) .== length s - 1+-- >>> prove $ \s -> length s .> 0 .=> length (tail s) .== length s - 1 -- Q.E.D.--- >>> prove $ \s -> bnot (null s) ==> singleton (head s) .++ tail s .== s+-- >>> prove $ \s -> sNot (null s) .=> singleton (head s) .++ tail s .== s -- Q.E.D. tail :: SString -> SString tail s@@ -96,6 +97,10 @@  | True  = subStr s 1 (length s - 1) +-- | @`uncons` returns the pair of the first character and tail. Unspecified if the string is empty.+uncons :: SString -> (SChar, SString)+uncons l = (head l, tail l)+ -- | @`init`@ returns all but the last element of the list. Unspecified if the string is empty. -- -- >>> prove $ \c t -> init (t .++ singleton c) .== t@@ -110,7 +115,7 @@ -- | @`singleton` c@ is the string of length 1 that contains the only character -- whose value is the 8-bit value @c@. ----- >>> prove $ \c -> c .== literal 'A' ==> singleton c .== "A"+-- >>> prove $ \c -> c .== literal 'A' .=> singleton c .== "A" -- Q.E.D. -- >>> prove $ \c -> length (singleton c) .== 1 -- Q.E.D.@@ -123,7 +128,7 @@ -- -- >>> prove $ \s1 s2 -> strToStrAt (s1 .++ s2) (length s1) .== strToStrAt s2 0 -- Q.E.D.--- >>> sat $ \s -> length s .>= 2 &&& strToStrAt s 0 ./= strToStrAt s (length s - 1)+-- >>> sat $ \s -> length s .>= 2 .&& strToStrAt s 0 ./= strToStrAt s (length s - 1) -- Satisfiable. Model: --   s0 = "\NUL\NUL\128" :: String strToStrAt :: SString -> SInteger -> SString@@ -132,9 +137,9 @@ -- | @`strToCharAt` s i@ is the 8-bit value stored at location @i@. Unspecified if -- index is out of bounds. ----- >>> prove $ \i -> i .>= 0 &&& i .<= 4 ==> "AAAAA" `strToCharAt` i .== literal 'A'+-- >>> prove $ \i -> i .>= 0 .&& i .<= 4 .=> "AAAAA" `strToCharAt` i .== literal 'A' -- Q.E.D.--- >>> prove $ \s i c -> s `strToCharAt` i .== c ==> indexOf s (singleton c) .<= i+-- >>> prove $ \s i c -> s `strToCharAt` i .== c .=> indexOf s (singleton c) .<= i -- Q.E.D. strToCharAt :: SString -> SInteger -> SChar strToCharAt s i@@ -150,7 +155,7 @@         y si st = do c <- internalVariable st w8                      cs <- newExpr st KString (SBVApp (StrOp StrUnit) [c])                      let csSBV = SBV (SVal KString (Right (cache (\_ -> return cs))))-                     internalConstraint st False [] $ unSBV $ length s .> i ==> csSBV .== si+                     internalConstraint st False [] $ unSBV $ length s .> i .=> csSBV .== si                      return c  -- | Short cut for 'strToCharAt'@@ -173,6 +178,13 @@ (.:) :: SChar -> SString -> SString c .: cs = singleton c .++ cs +-- | Empty string. This value has the property that it's the only string with length 0:+--+-- >>> prove $ \l -> length l .== 0 .<=> l .== nil+-- Q.E.D.+nil :: SString+nil = ""+ -- | Concatenate two strings. See also `.++`. concat :: SString -> SString -> SString concat x y | isConcretelyEmpty x = y@@ -181,7 +193,7 @@  -- | Short cut for `concat`. ----- >>> sat $ \x y z -> length x .== 5 &&& length y .== 1 &&& x .++ y .++ z .== "Hello world!"+-- >>> sat $ \x y z -> length x .== 5 .&& length y .== 1 .&& x .++ y .++ z .== "Hello world!" -- Satisfiable. Model: --   s0 =  "Hello" :: String --   s1 =      " " :: String@@ -194,7 +206,7 @@ -- -- >>> prove $ \s1 s2 s3 -> s2 `isInfixOf` (s1 .++ s2 .++ s3) -- Q.E.D.--- >>> prove $ \s1 s2 -> s1 `isInfixOf` s2 &&& s2 `isInfixOf` s1 <=> s1 .== s2+-- >>> prove $ \s1 s2 -> s1 `isInfixOf` s2 .&& s2 `isInfixOf` s1 .<=> s1 .== s2 -- Q.E.D. isInfixOf :: SString -> SString -> SBool sub `isInfixOf` s@@ -207,7 +219,7 @@ -- -- >>> prove $ \s1 s2 -> s1 `isPrefixOf` (s1 .++ s2) -- Q.E.D.--- >>> prove $ \s1 s2 -> s1 `isPrefixOf` s2 ==> subStr s2 0 (length s1) .== s1+-- >>> prove $ \s1 s2 -> s1 `isPrefixOf` s2 .=> subStr s2 0 (length s1) .== s1 -- Q.E.D. isPrefixOf :: SString -> SString -> SBool pre `isPrefixOf` s@@ -220,7 +232,7 @@ -- -- >>> prove $ \s1 s2 -> s2 `isSuffixOf` (s1 .++ s2) -- Q.E.D.--- >>> prove $ \s1 s2 -> s1 `isSuffixOf` s2 ==> subStr s2 (length s2 - length s1) (length s1) .== s1+-- >>> prove $ \s1 s2 -> s1 `isSuffixOf` s2 .=> subStr s2 (length s2 - length s1) (length s1) .== s1 -- Q.E.D. isSuffixOf :: SString -> SString -> SBool suf `isSuffixOf` s@@ -231,7 +243,7 @@  -- | @`take` len s@. Corresponds to Haskell's `take` on symbolic-strings. ----- >>> prove $ \s i -> i .>= 0 ==> length (take i s) .<= i+-- >>> prove $ \s i -> i .>= 0 .=> length (take i s) .<= i -- Q.E.D. take :: SInteger -> SString -> SString take i s = ite (i .<= 0)        (literal "")@@ -254,7 +266,7 @@ -- This function is under-specified when the offset is outside the range of positions in @s@ or @len@ -- is negative or @offset+len@ exceeds the length of @s@. ----- >>> prove $ \s i -> i .>= 0 &&& i .< length s ==> subStr s 0 i .++ subStr s i (length s - i) .== s+-- >>> prove $ \s i -> i .>= 0 .&& i .< length s .=> subStr s 0 i .++ subStr s i (length s - i) .== s -- Q.E.D. -- >>> sat  $ \i j -> subStr "hello" i j .== "ell" -- Satisfiable. Model:@@ -278,9 +290,9 @@  -- | @`replace` s src dst@. Replace the first occurrence of @src@ by @dst@ in @s@ ----- >>> prove $ \s -> replace "hello" s "world" .== "world" ==> s .== "hello"+-- >>> prove $ \s -> replace "hello" s "world" .== "world" .=> s .== "hello" -- Q.E.D.--- >>> prove $ \s1 s2 s3 -> length s2 .> length s1 ==> replace s1 s2 s3 .== s1+-- >>> prove $ \s1 s2 s3 -> length s2 .> length s1 .=> replace s1 s2 s3 .== s1 -- Q.E.D. replace :: SString -> SString -> SString -> SString replace s src dst@@ -301,13 +313,13 @@ -- | @`indexOf` s sub@. Retrieves first position of @sub@ in @s@, @-1@ if there are no occurrences. -- Equivalent to @`offsetIndexOf` s sub 0@. ----- >>> prove $ \s i -> i .> 0 &&& i .< length s ==> indexOf s (subStr s i 1) .<= i+-- >>> prove $ \s i -> i .> 0 .&& i .< length s .=> indexOf s (subStr s i 1) .<= i -- Q.E.D.--- >>> prove $ \s i -> i .> 0 &&& i .< length s ==> indexOf s (subStr s i 1) .== i+-- >>> prove $ \s i -> i .> 0 .&& i .< length s .=> indexOf s (subStr s i 1) .== i -- Falsifiable. Counter-example: --   s0 = " \NUL\NUL\NUL\NUL\NUL" :: String --   s1 =                       3 :: Integer--- >>> prove $ \s1 s2 -> length s2 .> length s1 ==> indexOf s1 s2 .== -1+-- >>> prove $ \s1 s2 -> length s2 .> length s1 .=> indexOf s1 s2 .== -1 -- Q.E.D. indexOf :: SString -> SString -> SInteger indexOf s sub = offsetIndexOf s sub 0@@ -317,9 +329,9 @@ -- -- >>> prove $ \s sub -> offsetIndexOf s sub 0 .== indexOf s sub -- Q.E.D.--- >>> prove $ \s sub i -> i .>= length s &&& length sub .> 0 ==> offsetIndexOf s sub i .== -1+-- >>> prove $ \s sub i -> i .>= length s .&& length sub .> 0 .=> offsetIndexOf s sub i .== -1 -- Q.E.D.--- >>> prove $ \s sub i -> i .> length s ==> offsetIndexOf s sub i .== -1+-- >>> prove $ \s sub i -> i .> length s .=> offsetIndexOf s sub i .== -1 -- Q.E.D. offsetIndexOf :: SString -> SString -> SInteger -> SInteger offsetIndexOf s sub offset@@ -338,7 +350,7 @@ -- that is, if it encodes a natural number. Otherwise, it returns '-1'. -- See <http://cvc4.cs.stanford.edu/wiki/Strings> for details. ----- >>> prove $ \s -> let n = strToNat s in n .>= 0 &&& n .< 10 ==> length s .== 1+-- >>> prove $ \s -> let n = strToNat s in n .>= 0 .&& n .< 10 .=> length s .== 1 -- Q.E.D. strToNat :: SString -> SInteger strToNat s@@ -354,7 +366,7 @@ -- produces empty string, even though we take an integer as an argument. -- See <http://cvc4.cs.stanford.edu/wiki/Strings> for details. ----- >>> prove $ \i -> length (natToStr i) .== 3 ==> i .<= 999+-- >>> prove $ \i -> length (natToStr i) .== 3 .=> i .<= 999 -- Q.E.D. natToStr :: SInteger -> SString natToStr i@@ -364,51 +376,51 @@  = lift1 StrNatToStr Nothing i  -- | Lift a unary operator over strings.-lift1 :: forall a b. (SymWord a, SymWord b) => StrOp -> Maybe (a -> b) -> SBV a -> SBV b+lift1 :: forall a b. (SymVal a, SymVal b) => StrOp -> Maybe (a -> b) -> SBV a -> SBV b lift1 w mbOp a   | Just cv <- concEval1 mbOp a   = cv   | True   = SBV $ SVal k $ Right $ cache r-  where k = kindOf (undefined :: b)-        r st = do swa <- sbvToSW st a-                  newExpr st k (SBVApp (StrOp w) [swa])+  where k = kindOf (Proxy @b)+        r st = do sva <- sbvToSV st a+                  newExpr st k (SBVApp (StrOp w) [sva])  -- | Lift a binary operator over strings.-lift2 :: forall a b c. (SymWord a, SymWord b, SymWord c) => StrOp -> Maybe (a -> b -> c) -> SBV a -> SBV b -> SBV c+lift2 :: forall a b c. (SymVal a, SymVal b, SymVal c) => StrOp -> Maybe (a -> b -> c) -> SBV a -> SBV b -> SBV c lift2 w mbOp a b   | Just cv <- concEval2 mbOp a b   = cv   | True   = SBV $ SVal k $ Right $ cache r-  where k = kindOf (undefined :: c)-        r st = do swa <- sbvToSW st a-                  swb <- sbvToSW st b-                  newExpr st k (SBVApp (StrOp w) [swa, swb])+  where k = kindOf (Proxy @c)+        r st = do sva <- sbvToSV st a+                  svb <- sbvToSV st b+                  newExpr st k (SBVApp (StrOp w) [sva, svb])  -- | Lift a ternary operator over strings.-lift3 :: forall a b c d. (SymWord a, SymWord b, SymWord c, SymWord d) => StrOp -> Maybe (a -> b -> c -> d) -> SBV a -> SBV b -> SBV c -> SBV d+lift3 :: forall a b c d. (SymVal a, SymVal b, SymVal c, SymVal d) => StrOp -> Maybe (a -> b -> c -> d) -> SBV a -> SBV b -> SBV c -> SBV d lift3 w mbOp a b c   | Just cv <- concEval3 mbOp a b c   = cv   | True   = SBV $ SVal k $ Right $ cache r-  where k = kindOf (undefined :: d)-        r st = do swa <- sbvToSW st a-                  swb <- sbvToSW st b-                  swc <- sbvToSW st c-                  newExpr st k (SBVApp (StrOp w) [swa, swb, swc])+  where k = kindOf (Proxy @d)+        r st = do sva <- sbvToSV st a+                  svb <- sbvToSV st b+                  svc <- sbvToSV st c+                  newExpr st k (SBVApp (StrOp w) [sva, svb, svc])  -- | Concrete evaluation for unary ops-concEval1 :: (SymWord a, SymWord b) => Maybe (a -> b) -> SBV a -> Maybe (SBV b)+concEval1 :: (SymVal a, SymVal b) => Maybe (a -> b) -> SBV a -> Maybe (SBV b) concEval1 mbOp a = literal <$> (mbOp <*> unliteral a)  -- | Concrete evaluation for binary ops-concEval2 :: (SymWord a, SymWord b, SymWord c) => Maybe (a -> b -> c) -> SBV a -> SBV b -> Maybe (SBV c)+concEval2 :: (SymVal a, SymVal b, SymVal c) => Maybe (a -> b -> c) -> SBV a -> SBV b -> Maybe (SBV c) concEval2 mbOp a b = literal <$> (mbOp <*> unliteral a <*> unliteral b)  -- | Concrete evaluation for ternary ops-concEval3 :: (SymWord a, SymWord b, SymWord c, SymWord d) => Maybe (a -> b -> c -> d) -> SBV a -> SBV b -> SBV c -> Maybe (SBV d)+concEval3 :: (SymVal a, SymVal b, SymVal c, SymVal d) => Maybe (a -> b -> c -> d) -> SBV a -> SBV b -> SBV c -> Maybe (SBV d) concEval3 mbOp a b c = literal <$> (mbOp <*> unliteral a <*> unliteral b <*> unliteral c)  -- | Is the string concretely known empty?
+ Data/SBV/Tools/BMC.hs view
@@ -0,0 +1,71 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Tools.BMC+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Bounded model checking interface. See "Documentation.SBV.Examples.ProofTools.BMC"+-- for an example use case.+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns   #-}++module Data.SBV.Tools.BMC (+         bmc, bmcWith+       ) where++import Data.SBV+import Data.SBV.Control++import Control.Monad (when)++-- | Bounded model checking, using the default solver. See "Documentation.SBV.Examples.ProofTools.BMC"+-- for an example use case.+--+-- Note that the BMC engine does *not* guarantee that the solution is unique. However, if it does+-- find a solution at depth @i@, it is guaranteed that there are no shorter solutions.+bmc :: (EqSymbolic st, Queriable IO st res)+    => Maybe Int                            -- ^ Optional bound+    -> Bool                                 -- ^ Verbose: prints iteration count+    -> Symbolic ()                          -- ^ Setup code, if necessary. (Typically used for 'Data.SBV.setOption' calls. Pass @return ()@ if not needed.)+    -> (st -> SBool)                        -- ^ Initial condition+    -> (st -> [st])                         -- ^ Transition relation+    -> (st -> SBool)                        -- ^ Goal to cover, i.e., we find a set of transitions that satisfy this predicate.+    -> IO (Either String (Int, [res]))      -- ^ Either a result, or a satisfying path of given length and intermediate observations.+bmc = bmcWith defaultSMTCfg++-- | Bounded model checking, configurable with the solver+bmcWith :: (EqSymbolic st, Queriable IO st res)+        => SMTConfig+        -> Maybe Int+        -> Bool+        -> Symbolic ()+        -> (st -> SBool)+        -> (st -> [st])+        -> (st -> SBool)+        -> IO (Either String (Int, [res]))+bmcWith cfg mbLimit chatty setup initial trans goal+  = runSMTWith cfg $ do setup+                        query $ do state <- fresh+                                   constrain $ initial state+                                   go 0 state []+   where go i _ _+          | Just l <- mbLimit, i >= l+          = return $ Left $ "BMC limit of " ++ show l ++ " reached"+         go i curState sofar = do when chatty $ io $ putStrLn $ "BMC: Iteration: " ++ show i+                                  push 1+                                  constrain $ goal curState+                                  cs <- checkSat+                                  case cs of+                                    Sat   -> do when chatty $ io $ putStrLn $ "BMC: Solution found at iteration " ++ show i+                                                ms <- mapM extract (curState : sofar)+                                                return $ Right (i, reverse ms)+                                    Unk   -> do when chatty $ io $ putStrLn $ "BMC: Backend solver said unknown at iteration " ++ show  i+                                                return $ Left $ "BMC: Solver said unknown in iteration " ++ show i+                                    Unsat -> do pop 1+                                                nextState <- fresh+                                                constrain $ sAny (nextState .==) (trans curState)+                                                go (i+1) nextState (curState : sofar)
Data/SBV/Tools/BoundedFix.hs view
@@ -1,15 +1,15 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Tools.BoundedFix--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Tools.BoundedFix+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Bounded fixed-point unrolling. ----------------------------------------------------------------------------- -{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleContexts #-}  module Data.SBV.Tools.BoundedFix (          bfix@@ -41,12 +41,12 @@ -- This definition unrolls the recursion in factorial at most 10 times before uninterpreting the result. -- We can now prove: ----- >>> prove $ \n -> n .>= 1 &&& n .<= 9 ==> bfac n .== n * bfac (n-1)+-- >>> prove $ \n -> n .>= 1 .&& n .<= 9 .=> bfac n .== n * bfac (n-1) -- Q.E.D. -- -- And we would get a bogus counter-example if the proof of our property needs a larger bound: ----- >>> prove $ \n -> n .== 10 ==> bfac n .== 3628800+-- >>> prove $ \n -> n .== 10 .=> bfac n .== 3628800 -- Falsifiable. Counter-example: --   s0 = 10 :: Integer --@@ -55,17 +55,17 @@ -- only applies if the given argument is symbolic. This fact can be used to observe concrete -- values to see where the bounded-model-checking approach fails: ----- >>> prove $ \n -> n .== 10 ==> observe "bfac_n" (bfac n) .== observe "bfac_10" (bfac 10)+-- >>> prove $ \n -> n .== 10 .=> observe "bfac_n" (bfac n) .== observe "bfac_10" (bfac 10) -- Falsifiable. Counter-example:---   s0      =      10 :: Integer---   bfac_n  = 7257600 :: Integer --   bfac_10 = 3628800 :: Integer+--   bfac_n  = 7257600 :: Integer+--   s0      =      10 :: Integer -- -- Here, we see that the SMT solver must have decided to assign the value @2@ in the final call just -- as it was reaching the base case, and thus got the final result incorrect. (Note -- that @7257600 = 2 * 3628800@.) A wrapper algorithm can then assert the actual value of -- @bfac 10@ here as an extra constraint and can search for "deeper bugs."-bfix :: (SymWord a, Uninterpreted (SBV a -> r)) => Int -> String -> ((SBV a -> r) -> (SBV a -> r)) -> SBV a -> r+bfix :: (SymVal a, Uninterpreted (SBV a -> r)) => Int -> String -> ((SBV a -> r) -> (SBV a -> r)) -> SBV a -> r bfix bound nm f x   | isConcrete x = g x   | True         = unroll bound x
+ Data/SBV/Tools/BoundedList.hs view
@@ -0,0 +1,145 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Tools.BoundedList+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- A collection of bounded list utilities, useful when working with symbolic lists.+-- These functions all take a concrete bound, and operate on the prefix of a symbolic+-- list that is at most that long. Due to limitations on writing recursive functions+-- over lists (the classic symbolic termination problem), we cannot write arbitrary+-- recursive programs on symbolic lists. But most of the time all we need is a+-- bounded prefix of this list, at which point these functions come in handy.+-----------------------------------------------------------------------------++{-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE Rank2Types          #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.SBV.Tools.BoundedList (+     -- * General folds+     bfoldr, bfoldrM, bfoldl, bfoldlM+     -- * Map, filter, zipWith, elem+   , bmap, bmapM, bfilter, bzipWith, belem+     -- * Aggregates+   , bsum, bprod, band, bor, bany, ball, bmaximum, bminimum+     -- * Miscellaneous: Reverse and sort+   , breverse, bsort+   )+   where++import Data.SBV+import Data.SBV.List ((.:), (.++))+import qualified Data.SBV.List as L++-- | Case analysis on a symbolic list. (Not exported.)+lcase :: (SymVal a, Mergeable b) => SList a -> b -> (SBV a -> SList a -> b) -> b+lcase s e c = ite (L.null s) e (c (L.head s) (L.tail s))++-- | Bounded fold from the right.+bfoldr :: (SymVal a, SymVal b) => Int -> (SBV a -> SBV b -> SBV b) -> SBV b -> SList a -> SBV b+bfoldr cnt f b = go (cnt `max` 0)+  where go 0 _ = b+        go i s = lcase s b (\h t -> h `f` go (i-1) t)++-- | Bounded monadic fold from the right.+bfoldrM :: forall a b m. (SymVal a, SymVal b, Monad m, Mergeable (m (SBV b)))+        => Int -> (SBV a -> SBV b -> m (SBV b)) -> SBV b -> SList a -> m (SBV b)+bfoldrM cnt f b = go (cnt `max` 0)+  where go :: Int -> SList a -> m (SBV b)+        go 0 _ = return b+        go i s = lcase s (return b) (\h t -> f h =<< go (i-1) t)++-- | Bounded fold from the left.+bfoldl :: (SymVal a, SymVal b) => Int -> (SBV b -> SBV a -> SBV b) -> SBV b -> SList a -> SBV b+bfoldl cnt f = go (cnt `max` 0)+  where go 0 b _ = b+        go i b s = lcase s b (\h t -> go (i-1) (b `f` h) t)++-- | Bounded monadic fold from the left.+bfoldlM :: forall a b m. (SymVal a, SymVal b, Monad m, Mergeable (m (SBV b)))+        => Int -> (SBV b -> SBV a -> m (SBV b)) -> SBV b -> SList a -> m (SBV b)+bfoldlM cnt f = go (cnt `max` 0)+  where go :: Int -> SBV b -> SList a -> m (SBV b)+        go 0 b _ = return b+        go i b s = lcase s (return b) (\h t -> do { fbh <- f b h; go (i-1) fbh t })++-- | Bounded sum.+bsum :: (SymVal a, Num a) => Int -> SList a -> SBV a+bsum i = bfoldl i (+) 0++-- | Bounded product.+bprod :: (SymVal a, Num a) => Int -> SList a -> SBV a+bprod i = bfoldl i (*) 1++-- | Bounded map.+bmap :: (SymVal a, SymVal b) => Int -> (SBV a -> SBV b) -> SList a -> SList b+bmap i f = bfoldr i (\x -> (f x .:)) []++-- | Bounded monadic map.+bmapM :: (SymVal a, SymVal b, Monad m, Mergeable (m (SBV [b])))+      => Int -> (SBV a -> m (SBV b)) -> SList a -> m (SList b)+bmapM i f = bfoldrM i (\a bs -> (.:) <$> f a <*> pure bs) []++-- | Bounded filter.+bfilter :: SymVal a => Int -> (SBV a -> SBool) -> SList a -> SList a+bfilter i f = bfoldr i (\x y -> ite (f x) (x .: y) y) []++-- | Bounded logical and+band :: Int -> SList Bool -> SBool+band i = bfoldr i (.&&) (sTrue  :: SBool)++-- | Bounded logical or+bor :: Int -> SList Bool -> SBool+bor i = bfoldr i (.||) (sFalse :: SBool)++-- | Bounded any+bany :: SymVal a => Int -> (SBV a -> SBool) -> SList a -> SBool+bany i f = bor i . bmap i f++-- | Bounded all+ball :: SymVal a => Int -> (SBV a -> SBool) -> SList a -> SBool+ball i f = band i . bmap i f++-- | Bounded maximum. Undefined if list is empty.+bmaximum :: SymVal a => Int -> SList a -> SBV a+bmaximum i l = bfoldl (i-1) smax (L.head l) (L.tail l)++-- | Bounded minimum. Undefined if list is empty.+bminimum :: SymVal a => Int -> SList a -> SBV a+bminimum i l = bfoldl (i-1) smin (L.head l) (L.tail l)++-- | Bounded zipWith+bzipWith :: (SymVal a, SymVal b, SymVal c) => Int -> (SBV a -> SBV b -> SBV c) -> SList a -> SList b -> SList c+bzipWith cnt f = go (cnt `max` 0)+   where go 0 _  _  = []+         go i xs ys = ite (L.null xs .|| L.null ys)+                          []+                          (f (L.head xs) (L.head ys) .: go (i-1) (L.tail xs) (L.tail ys))++-- | Bounded element check+belem :: SymVal a => Int -> SBV a -> SList a -> SBool+belem i e = bany i (e .==)++-- | Bounded reverse+breverse :: SymVal a => Int -> SList a -> SList a+breverse cnt = bfoldr cnt (\a b -> b .++ L.singleton a) []++-- | Bounded paramorphism (not exported).+bpara :: (SymVal a, SymVal b) => Int -> (SBV a -> SBV [a] -> SBV b -> SBV b) -> SBV b -> SList a -> SBV b+bpara cnt f b = go (cnt `max` 0)+  where go 0 _ = b+        go i s = lcase s b (\h t -> f h t (go (i-1) t))++-- | Insert an element into a sorted list (not exported).+binsert :: SymVal a => Int -> SBV a -> SList a -> SList a+binsert cnt a = bpara cnt f (L.singleton a)+  where f sortedHd sortedTl sortedTl' = ite (a .< sortedHd)+                                            (a .: sortedHd .: sortedTl)+                                            (sortedHd .: sortedTl')++-- | Bounded insertion sort+bsort :: SymVal a => Int -> SList a -> SList a+bsort cnt = bfoldr cnt (binsert cnt) []
Data/SBV/Tools/CodeGen.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Tools.CodeGen--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Tools.CodeGen+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Code-generation from SBV programs. -----------------------------------------------------------------------------
Data/SBV/Tools/GenTest.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Tools.GenTest--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Tools.GenTest+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test generation from symbolic programs -----------------------------------------------------------------------------@@ -26,12 +26,12 @@ import Data.SBV.Utils.PrettyNum  -- | Type of test vectors (abstract)-newtype TestVectors = TV [([CW], [CW])]+newtype TestVectors = TV [([CV], [CV])]  -- | Retrieve the test vectors for further processing. This function -- is useful in cases where 'renderTest' is not sufficient and custom -- output (or further preprocessing) is needed.-getTestValues :: TestVectors -> [([CW], [CW])]+getTestValues :: TestVectors -> [([CV], [CV])] getTestValues (TV vs) = vs  -- | Generate a set of concrete test values from a symbolic program. The output@@ -46,7 +46,7 @@                        gen (i+1) (t:sofar)         tc = do (_, Result {resTraces=tvals, resConsts=cs, resConstraints=cstrs, resOutputs=os}) <- runSymbolic Concrete (m >>= output)                 let cval = fromMaybe (error "Cannot generate tests in the presence of uninterpeted constants!") . (`lookup` cs)-                    cond = and [cwToBool (cval v) | (False, _, v) <- cstrs] -- Only pick-up "hard" constraints, as indicated by False in the fist component+                    cond = and [cvToBool (cval v) | (False, _, v) <- cstrs] -- Only pick-up "hard" constraints, as indicated by False in the fist component                 if cond                    then return (map snd tvals, map cval os)                    else tc   -- try again, with the same set of constraints@@ -64,7 +64,7 @@ renderTest (C n)          (TV vs) = c       n vs renderTest (Forte n b ss) (TV vs) = forte   n b ss vs -haskell :: String -> [([CW], [CW])] -> String+haskell :: String -> [([CV], [CV])] -> String haskell vname vs = intercalate "\n" $ [ "-- Automatically generated by SBV. Do not edit!"                                       , ""                                       , "module " ++ modName ++ "(" ++ n ++ ") where"@@ -89,13 +89,13 @@                 needsInt     = any isSW params                 needsWord    = any isUW params                 needsRatio   = any isR params-                isR cw       = case kindOf cw of+                isR cv       = case kindOf cv of                                  KReal -> True                                  _     -> False-                isSW cw      = case kindOf cw of+                isSW cv      = case kindOf cv of                                  KBounded True _ -> True                                  _               -> False-                isUW cw      = case kindOf cw of+                isUW cv      = case kindOf cv of                                  KBounded False sz -> sz > 1                                  _                 -> False         modName = let (f:r) = n in toUpper f : r@@ -103,7 +103,7 @@         getType []         = "[a]"         getType ((i, o):_) = "[(" ++ mapType typeOf i ++ ", " ++ mapType typeOf o ++ ")]"         mkLine  (i, o)     = "("  ++ mapType valOf  i ++ ", " ++ mapType valOf  o ++ ")"-        mapType f cws = mkTuple $ map f $ groupBy ((==) `on` kindOf) cws+        mapType f cvs = mkTuple $ map f $ groupBy ((==) `on` kindOf) cvs         mkTuple [x] = x         mkTuple xs  = "(" ++ intercalate ", " xs ++ ")"         typeOf []    = "()"@@ -113,39 +113,40 @@         valOf  [x]   = s x         valOf  xs    = "[" ++ intercalate ", " (map s xs) ++ "]" -        t cw = case kindOf cw of-                 KBool             -> "Bool"-                 KBounded False 8  -> "Word8"-                 KBounded False 16 -> "Word16"-                 KBounded False 32 -> "Word32"-                 KBounded False 64 -> "Word64"-                 KBounded True  8  -> "Int8"-                 KBounded True  16 -> "Int16"-                 KBounded True  32 -> "Int32"-                 KBounded True  64 -> "Int64"-                 KUnbounded        -> "Integer"-                 KFloat            -> "Float"-                 KDouble           -> "Double"-                 KChar             -> error "SBV.renderTest: Unsupported char"-                 KString           -> error "SBV.renderTest: Unsupported string"-                 KReal             -> error $ "SBV.renderTest: Unsupported real valued test value: " ++ show cw-                 KList es          -> error $ "SBV.renderTest: Unsupported list valued test: [" ++ show es ++ "]"-                 KUserSort us _    -> error $ "SBV.renderTest: Unsupported uninterpreted sort: " ++ us-                 _                 -> error $ "SBV.renderTest: Unexpected CW: " ++ show cw+        t cv = case kindOf cv of+                 KBool               -> "Bool"+                 KBounded False 8    -> "Word8"+                 KBounded False 16   -> "Word16"+                 KBounded False 32   -> "Word32"+                 KBounded False 64   -> "Word64"+                 KBounded True  8    -> "Int8"+                 KBounded True  16   -> "Int16"+                 KBounded True  32   -> "Int32"+                 KBounded True  64   -> "Int64"+                 KUnbounded          -> "Integer"+                 KFloat              -> "Float"+                 KDouble             -> "Double"+                 KChar               -> error "SBV.renderTest: Unsupported char"+                 KString             -> error "SBV.renderTest: Unsupported string"+                 KReal               -> error $ "SBV.renderTest: Unsupported real valued test value: " ++ show cv+                 KList es            -> error $ "SBV.renderTest: Unsupported list valued test: [" ++ show es ++ "]"+                 KUninterpreted us _ -> error $ "SBV.renderTest: Unsupported uninterpreted sort: " ++ us+                 _                   -> error $ "SBV.renderTest: Unexpected CV: " ++ show cv -        s cw = case kindOf cw of-                  KBool             -> take 5 (show (cwToBool cw) ++ repeat ' ')-                  KBounded sgn   sz -> let CWInteger w = cwVal cw in shex  False True (sgn, sz) w-                  KUnbounded        -> let CWInteger w = cwVal cw in shexI False True           w-                  KFloat            -> let CWFloat w   = cwVal cw in showHFloat w-                  KDouble           -> let CWDouble w  = cwVal cw in showHDouble w-                  KChar             -> error "SBV.renderTest: Unsupported char"-                  KString           -> error "SBV.renderTest: Unsupported string"-                  KReal             -> let CWAlgReal w = cwVal cw in algRealToHaskell w-                  KList es          -> error $ "SBV.renderTest: Unsupported list valued sort: [" ++ show es ++ "]"-                  KUserSort us _    -> error $ "SBV.renderTest: Unsupported uninterpreted sort: " ++ us+        s cv = case kindOf cv of+                  KBool               -> take 5 (show (cvToBool cv) ++ repeat ' ')+                  KBounded sgn   sz   -> let CInteger w = cvVal cv in shex  False True (sgn, sz) w+                  KUnbounded          -> let CInteger w = cvVal cv in shexI False True           w+                  KFloat              -> let CFloat   w = cvVal cv in showHFloat w+                  KDouble             -> let CDouble  w = cvVal cv in showHDouble w+                  KChar               -> error "SBV.renderTest: Unsupported char"+                  KString             -> error "SBV.renderTest: Unsupported string"+                  KReal               -> let CAlgReal w = cvVal cv in algRealToHaskell w+                  KList es            -> error $ "SBV.renderTest: Unsupported list valued sort: [" ++ show es ++ "]"+                  KUninterpreted us _ -> error $ "SBV.renderTest: Unsupported uninterpreted sort: " ++ us+                  k@KTuple{}          -> error $ "SBV.renderTest: Unsupported tuple: " ++ show k -c :: String -> [([CW], [CW])] -> String+c :: String -> [([CV], [CV])] -> String c n vs = intercalate "\n" $               [ "/* Automatically generated by SBV. Do not edit! */"               , ""@@ -207,50 +208,55 @@               , "  return 0;"               , "}"               ]-  where mkField p cw i = "    " ++ t ++ " " ++ p ++ show i ++ ";"-            where t = case kindOf cw of-                        KBool             -> "SBool"-                        KBounded False 8  -> "SWord8"-                        KBounded False 16 -> "SWord16"-                        KBounded False 32 -> "SWord32"-                        KBounded False 64 -> "SWord64"-                        KBounded True  8  -> "SInt8"-                        KBounded True  16 -> "SInt16"-                        KBounded True  32 -> "SInt32"-                        KBounded True  64 -> "SInt64"-                        KFloat            -> "SFloat"-                        KDouble           -> "SDouble"-                        KChar             -> error "SBV.renderTest: Unsupported char"-                        KString           -> error "SBV.renderTest: Unsupported string"-                        KUnbounded        -> error "SBV.renderTest: Unbounded integers are not supported when generating C test-cases."-                        KReal             -> error "SBV.renderTest: Real values are not supported when generating C test-cases."-                        KUserSort us _    -> error $ "SBV.renderTest: Unsupported uninterpreted sort: " ++ us-                        _                 -> error $ "SBV.renderTest: Unexpected CW: " ++ show cw+  where mkField p cv i = "    " ++ t ++ " " ++ p ++ show i ++ ";"+            where t = case kindOf cv of+                        KBool               -> "SBool"+                        KBounded False 8    -> "SWord8"+                        KBounded False 16   -> "SWord16"+                        KBounded False 32   -> "SWord32"+                        KBounded False 64   -> "SWord64"+                        KBounded True  8    -> "SInt8"+                        KBounded True  16   -> "SInt16"+                        KBounded True  32   -> "SInt32"+                        KBounded True  64   -> "SInt64"+                        KFloat              -> "SFloat"+                        KDouble             -> "SDouble"+                        KChar               -> error "SBV.renderTest: Unsupported char"+                        KString             -> error "SBV.renderTest: Unsupported string"+                        KUnbounded          -> error "SBV.renderTest: Unbounded integers are not supported when generating C test-cases."+                        KReal               -> error "SBV.renderTest: Real values are not supported when generating C test-cases."+                        KUninterpreted us _ -> error $ "SBV.renderTest: Unsupported uninterpreted sort: " ++ us+                        _                   -> error $ "SBV.renderTest: Unexpected CV: " ++ show cv+         mkLine (is, os) = "{{" ++ intercalate ", " (map v is) ++ "}, {" ++ intercalate ", " (map v os) ++ "}}"-        v cw = case kindOf cw of-                  KBool           -> if cwToBool cw then "true " else "false"-                  KBounded sgn sz -> let CWInteger w = cwVal cw in chex  False True (sgn, sz) w-                  KUnbounded      -> let CWInteger w = cwVal cw in shexI False True           w-                  KFloat          -> let CWFloat w   = cwVal cw in showCFloat w-                  KDouble         -> let CWDouble w  = cwVal cw in showCDouble w-                  KChar           -> error "SBV.renderTest: Unsupported char"-                  KString         -> error "SBV.renderTest: Unsupported string"-                  k@KList{}       -> error $ "SBV.renderTest: Unsupported list sort!" ++ show k-                  KUserSort us _  -> error $ "SBV.renderTest: Unsupported uninterpreted sort: " ++ us-                  KReal           -> error "SBV.renderTest: Real values are not supported when generating C test-cases."++        v cv = case kindOf cv of+                  KBool               -> if cvToBool cv then "true " else "false"+                  KBounded sgn sz     -> let CInteger w = cvVal cv in chex  False True (sgn, sz) w+                  KUnbounded          -> let CInteger w = cvVal cv in shexI False True           w+                  KFloat              -> let CFloat w   = cvVal cv in showCFloat w+                  KDouble             -> let CDouble w  = cvVal cv in showCDouble w+                  KChar               -> error "SBV.renderTest: Unsupported char"+                  KString             -> error "SBV.renderTest: Unsupported string"+                  k@KList{}           -> error $ "SBV.renderTest: Unsupported list sort!" ++ show k+                  KUninterpreted us _ -> error $ "SBV.renderTest: Unsupported uninterpreted sort: " ++ us+                  KReal               -> error "SBV.renderTest: Real values are not supported when generating C test-cases."+                  k@KTuple{}          -> error $ "SBV.renderTest: Unsupported tuple sort!" ++ show k+         outLine           | null vs = "printf(\"\");"           | True    = "printf(\"%*d. " ++ fmtString ++ "\\n\", " ++ show (length (show (length vs - 1))) ++ ", i"                     ++ concatMap ("\n           , " ++ ) (zipWith inp is [(0::Int)..] ++ zipWith out os [(0::Int)..])                     ++ ");"           where (is, os) = head vs-                inp cw i = mkBool cw (n ++ "[i].input.i"  ++ show i)-                out cw i = mkBool cw (n ++ "[i].output.o" ++ show i)-                mkBool cw s = case kindOf cw of+                inp cv i = mkBool cv (n ++ "[i].input.i"  ++ show i)+                out cv i = mkBool cv (n ++ "[i].output.o" ++ show i)+                mkBool cv s = case kindOf cv of                                 KBool -> "(" ++ s ++ " == true) ? \"true \" : \"false\""                                 _     -> s                 fmtString = unwords (map fmt is) ++ " -> " ++ unwords (map fmt os)-        fmt cw = case kindOf cw of++        fmt cv = case kindOf cv of                     KBool             -> "%s"                     KBounded False  8 -> "0x%02\"PRIx8\""                     KBounded False 16 -> "0x%04\"PRIx16\"U"@@ -266,9 +272,9 @@                     KString           -> error "SBV.renderTest: Unsupported string"                     KUnbounded        -> error "SBV.renderTest: Unsupported unbounded integers for C generation."                     KReal             -> error "SBV.renderTest: Unsupported real valued values for C generation."-                    _                 -> error $ "SBV.renderTest: Unexpected CW: " ++ show cw+                    _                 -> error $ "SBV.renderTest: Unexpected CV: " ++ show cv -forte :: String -> Bool -> ([Int], [Int]) -> [([CW], [CW])] -> String+forte :: String -> Bool -> ([Int], [Int]) -> [([CV], [CV])] -> String forte vname bigEndian ss vs = intercalate "\n" $ [ "// Automatically generated by SBV. Do not edit!"                                              , "let " ++ n ++ " ="                                              , "   let c s = val [_, r] = str_split s \"'\" in " ++ blaster@@ -284,33 +290,37 @@          | True      = "rev (map (\\s. s == \"1\") (explode (string_tl r)))"         toF True  = '1'         toF False = '0'-        blast cw = let noForte w = error "SBV.renderTest: " ++ w ++ " values are not supported when generating Forte test-cases."-                   in case kindOf cw of-                       KBool             -> [toF (cwToBool cw)]-                       KBounded False 8  -> xlt  8 (cwVal cw)-                       KBounded False 16 -> xlt 16 (cwVal cw)-                       KBounded False 32 -> xlt 32 (cwVal cw)-                       KBounded False 64 -> xlt 64 (cwVal cw)-                       KBounded True 8   -> xlt  8 (cwVal cw)-                       KBounded True 16  -> xlt 16 (cwVal cw)-                       KBounded True 32  -> xlt 32 (cwVal cw)-                       KBounded True 64  -> xlt 64 (cwVal cw)-                       KFloat            -> noForte "Float"-                       KDouble           -> noForte "Double"-                       KChar             -> noForte "Char"-                       KString           -> noForte "String"-                       KReal             -> noForte "Real"-                       KList ek          -> noForte $ "List of " ++ show ek-                       KUnbounded        -> noForte "Unbounded integers"-                       _                 -> error $ "SBV.renderTest: Unexpected CW: " ++ show cw-        xlt s (CWInteger  v)  = [toF (testBit v i) | i <- [s-1, s-2 .. 0]]-        xlt _ (CWFloat    r)  = error $ "SBV.renderTest.Forte: Unexpected float value: "         ++ show r-        xlt _ (CWDouble   r)  = error $ "SBV.renderTest.Forte: Unexpected double value: "        ++ show r-        xlt _ (CWChar     r)  = error $ "SBV.renderTest.Forte: Unexpected char value: "          ++ show r-        xlt _ (CWString   r)  = error $ "SBV.renderTest.Forte: Unexpected string value: "        ++ show r-        xlt _ (CWAlgReal  r)  = error $ "SBV.renderTest.Forte: Unexpected real value: "          ++ show r-        xlt _ CWList{}        = error   "SBV.renderTest.Forte: Unexpected list value!"-        xlt _ (CWUserSort r)  = error $ "SBV.renderTest.Forte: Unexpected uninterpreted value: " ++ show r+        blast cv = let noForte w = error "SBV.renderTest: " ++ w ++ " values are not supported when generating Forte test-cases."+                   in case kindOf cv of+                        KBool              -> [toF (cvToBool cv)]+                        KBounded False 8   -> xlt  8 (cvVal cv)+                        KBounded False 16  -> xlt 16 (cvVal cv)+                        KBounded False 32  -> xlt 32 (cvVal cv)+                        KBounded False 64  -> xlt 64 (cvVal cv)+                        KBounded True 8    -> xlt  8 (cvVal cv)+                        KBounded True 16   -> xlt 16 (cvVal cv)+                        KBounded True 32   -> xlt 32 (cvVal cv)+                        KBounded True 64   -> xlt 64 (cvVal cv)+                        KFloat             -> noForte "Float"+                        KDouble            -> noForte "Double"+                        KChar              -> noForte "Char"+                        KString            -> noForte "String"+                        KReal              -> noForte "Real"+                        KList ek           -> noForte $ "List of " ++ show ek+                        KUnbounded         -> noForte "Unbounded integers"+                        KUninterpreted s _ -> noForte $ "Uninterpreted kind " ++ show s+                        _                  -> error $ "SBV.renderTest: Unexpected CV: " ++ show cv++        xlt s (CInteger  v)  = [toF (testBit v i) | i <- [s-1, s-2 .. 0]]+        xlt _ (CFloat    r)  = error $ "SBV.renderTest.Forte: Unexpected float value: "         ++ show r+        xlt _ (CDouble   r)  = error $ "SBV.renderTest.Forte: Unexpected double value: "        ++ show r+        xlt _ (CChar     r)  = error $ "SBV.renderTest.Forte: Unexpected char value: "          ++ show r+        xlt _ (CString   r)  = error $ "SBV.renderTest.Forte: Unexpected string value: "        ++ show r+        xlt _ (CAlgReal  r)  = error $ "SBV.renderTest.Forte: Unexpected real value: "          ++ show r+        xlt _ CList{}        = error   "SBV.renderTest.Forte: Unexpected list value!"+        xlt _ CTuple{}       = error   "SBV.renderTest.Forte: Unexpected list value!"+        xlt _ (CUserSort r)  = error $ "SBV.renderTest.Forte: Unexpected uninterpreted value: " ++ show r+         mkLine  (i, o) = "("  ++ mkTuple (form (fst ss) (concatMap blast i)) ++ ", " ++ mkTuple (form (snd ss) (concatMap blast o)) ++ ")"         mkTuple []  = "()"         mkTuple [x] = x
+ Data/SBV/Tools/Induction.hs view
@@ -0,0 +1,146 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Tools.Induction+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Induction engine for state transition systems. See the following examples+-- for details:+--+--   * "Documentation.SBV.Examples.ProofTools.Strengthen": Use of strengthening+--     to establish inductive invariants.+--+--   * "Documentation.SBV.Examples.ProofTools.Sum": Proof for correctness of+--     an algorithm to sum up numbers,+--+--   * "Documentation.SBV.Examples.ProofTools.Fibonacci": Proof for correctness of+--     an algorithm to fast-compute fibonacci numbers, using axiomatization.+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns   #-}++module Data.SBV.Tools.Induction (+         InductionResult(..), InductionStep(..), induct, inductWith+       ) where++import Data.SBV+import Data.SBV.Control++import Data.List     (intercalate)+import Control.Monad (when)++-- | A step in an inductive proof. If the tag is present (i.e., @Just nm@), then+-- the step belongs to the subproof that establishes the strengthening named @nm@.+data InductionStep = Initiation  (Maybe String)+                   | Consecution (Maybe String)+                   | PartialCorrectness++-- | Show instance for 'InductionStep', diagnostic purposes only.+instance Show InductionStep where+   show (Initiation  Nothing)  = "initiation"+   show (Initiation  (Just s)) = "initiation for strengthening " ++ show s+   show (Consecution Nothing)  = "consecution"+   show (Consecution (Just s)) = "consecution for strengthening " ++ show s+   show PartialCorrectness     = "partial correctness"++-- | Result of an inductive proof, with a counter-example in case of failure.+--+-- If a proof is found (indicated by a 'Proven' result), then the invariant holds+-- and the goal is established once the termination condition holds. If it fails, then+-- it can fail either in an initiation step or in a consecution step:+--+--    * A 'Failed' result in an 'Initiation' step means that the invariant does /not/ hold for+--      the initial state, and thus indicates a true failure.+--+--    * A 'Failed' result in a 'Consecution' step will return a state /s/. This state is known as a+--      CTI (counterexample to inductiveness): It will lead to a violation of the invariant+--      in one step. However, this does not mean the property is invalid: It could be the+--      case that it is simply not inductive. In this case, human intervention---or a smarter+--      algorithm like IC3 for certain domains---is needed to see if one can strengthen the+--      invariant so an inductive proof can be found. How this strengthening can be done remains+--      an art, but the science is improving with algorithms like IC3.+--+--    * A 'Failed' result in a 'PartialCorrectness' step means that the invariant holds, but assuming the+--      termination condition the goal still does not follow. That is, the partial correctness+--      does not hold.+data InductionResult a = Failed InductionStep a+                       | Proven++-- | Show instance for 'InductionResult', diagnostic purposes only.+instance Show a => Show (InductionResult a) where+  show Proven       = "Q.E.D."+  show (Failed s e) = intercalate "\n" [ "Failed while establishing " ++ show s ++ "."+                                       , "Counter-example to inductiveness:"+                                       , intercalate "\n" ["  " ++ l | l <- lines (show e)]+                                       ]++-- | Induction engine, using the default solver. See "Documentation.SBV.Examples.ProofTools.Strengthen"+-- and "Documentation.SBV.Examples.ProofTools.Sum" for examples.+induct :: (Show res, Queriable IO st res)+       => Bool                             -- ^ Verbose mode+       -> Symbolic ()                      -- ^ Setup code, if necessary. (Typically used for 'Data.SBV.setOption' calls. Pass @return ()@ if not needed.)+       -> (st -> SBool)                    -- ^ Initial condition+       -> (st -> [st])                     -- ^ Transition relation+       -> [(String, st -> SBool)]          -- ^ Strengthenings, if any. The @String@ is a simple tag.+       -> (st -> SBool)                    -- ^ Invariant that ensures the goal upon termination+       -> (st -> (SBool, SBool))           -- ^ Termination condition and the goal to establish+       -> IO (InductionResult res)         -- ^ Either proven, or a concrete state value that, if reachable, fails the invariant.+induct = inductWith defaultSMTCfg++-- | Induction engine, configurable with the solver+inductWith :: (Show res, Queriable IO st res)+           => SMTConfig+           -> Bool+           -> Symbolic ()+           -> (st -> SBool)+           -> (st -> [st])+           -> [(String, st -> SBool)]+           -> (st -> SBool)+           -> (st -> (SBool, SBool))+           -> IO (InductionResult res)+inductWith cfg chatty setup initial trans strengthenings inv goal =+     try "Proving initiation"+         (\s -> initial s .=> inv s)+         (Failed (Initiation Nothing))+         $ strengthen strengthenings+         $ try "Proving consecution"+               (\s -> sAnd (inv s : [st s | (_, st) <- strengthenings]) .=> sAll inv (trans s))+               (Failed (Consecution Nothing))+               $ try "Proving partial correctness"+                     (\s -> let (term, result) = goal s in inv s .&& term .=> result)+                     (Failed PartialCorrectness)+                     (msg "Done" >> return Proven)++  where msg = when chatty . putStrLn++        try m p wrap cont = do msg m+                               res <- check p+                               case res of+                                 Just ex -> return $ wrap ex+                                 Nothing -> cont++        check p = runSMTWith cfg $ do+                        setup+                        query $ do st <- fresh+                                   constrain $ sNot (p st)++                                   cs <- checkSat+                                   case cs of+                                     Unk   -> error "Solver said unknown"+                                     Unsat -> return Nothing+                                     Sat   -> do io $ msg "Failed:"+                                                 ex <- extract st+                                                 io $ msg $ show ex+                                                 return $ Just ex++        strengthen []             cont = cont+        strengthen ((nm, st):sts) cont = try ("Proving strengthening initation  : " ++ nm)+                                             (\s -> initial s .=> st s)+                                             (Failed (Initiation (Just nm)))+                                             $ try ("Proving strengthening consecution: " ++ nm)+                                                   (\s -> st s .=> sAll st (trans s))+                                                   (Failed (Consecution (Just nm)))+                                                   (strengthen sts cont)
Data/SBV/Tools/Overflow.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Tools.Overflow--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Tools.Overflow+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Implementation of overflow detection functions. -- Based on: <http://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/z3prefix.pdf>@@ -15,6 +15,7 @@ {-# LANGUAGE ImplicitParams       #-} {-# LANGUAGE Rank2Types           #-} {-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeApplications     #-} {-# LANGUAGE TypeSynonymInstances #-}  module Data.SBV.Tools.Overflow (@@ -31,17 +32,16 @@ import Data.SBV.Core.Symbolic import Data.SBV.Core.Model import Data.SBV.Core.Operations-import Data.SBV.Utils.Boolean  import GHC.Stack  import Data.Int import Data.Word+import Data.Proxy  -- Doctest only -- $setup -- >>> import Data.SBV.Provers.Prover (prove, allSat)--- >>> import Data.SBV.Utils.Boolean ((<=>))  -- | Detecting underflow/overflow conditions. For each function, -- the first result is the condition under which the computation@@ -52,7 +52,7 @@   --   -- A tell tale sign of unsigned addition overflow is when the sum is less than minumum of the arguments.   ---  -- >>> prove $ \x y -> snd (bvAddO x (y::SWord16)) <=> x + y .< x `smin` y+  -- >>> prove $ \x y -> snd (bvAddO x (y::SWord16)) .<=> x + y .< x `smin` y   -- Q.E.D.   bvAddO :: a -> a -> (SBool, SBool) @@ -81,7 +81,7 @@   -- | Bit-vector negation. Unsigned negation neither underflows nor overflows. Signed negation can only overflow, when the argument is   -- @minBound@:   ---  -- >>> prove $ \x -> x .== minBound <=> snd (bvNegO (x::SInt16))+  -- >>> prove $ \x -> x .== minBound .<=> snd (bvNegO (x::SInt16))   -- Q.E.D.   bvNegO :: a -> (SBool, SBool) @@ -105,7 +105,7 @@ -- | A class of checked-arithmetic operations. These follow the usual arithmetic, -- except make calls to 'Data.SBV.sAssert' to ensure no overflow/underflow can occur. -- Use them in conjunction with 'Data.SBV.safe' to ensure no overflow can happen.-class (ArithOverflow (SBV a), Num a, SymWord a) => CheckedArithmetic a where+class (ArithOverflow (SBV a), Num a, SymVal a) => CheckedArithmetic a where   (+!)          :: (?loc :: CallStack) => SBV a -> SBV a -> SBV a   (-!)          :: (?loc :: CallStack) => SBV a -> SBV a -> SBV a   (*!)          :: (?loc :: CallStack) => SBV a -> SBV a -> SBV a@@ -389,19 +389,19 @@ -- (254 :: SWord8,(True,False)) -- >>> sFromIntegralO (2 :: SInt16) :: (SWord8, (SBool, SBool)) -- (2 :: SWord8,(False,False))--- >>> prove $ \x -> sFromIntegralO (x::SInt32) .== (sFromIntegral x :: SInteger, (false, false))+-- >>> prove $ \x -> sFromIntegralO (x::SInt32) .== (sFromIntegral x :: SInteger, (sFalse, sFalse)) -- Q.E.D. -- -- As the last example shows, converting to `sInteger` never underflows or overflows for any value.-sFromIntegralO :: forall a b. (Integral a, HasKind a, Num a, SymWord a, HasKind b, Num b, SymWord b) => SBV a -> (SBV b, (SBool, SBool))-sFromIntegralO x = case (kindOf x, kindOf (undefined :: b)) of+sFromIntegralO :: forall a b. (Integral a, HasKind a, Num a, SymVal a, HasKind b, Num b, SymVal b) => SBV a -> (SBV b, (SBool, SBool))+sFromIntegralO x = case (kindOf x, kindOf (Proxy @b)) of                      (KBounded False n, KBounded False m) -> (res, u2u n m)                      (KBounded False n, KBounded True  m) -> (res, u2s n m)                      (KBounded True n,  KBounded False m) -> (res, s2u n m)                      (KBounded True n,  KBounded True  m) -> (res, s2s n m)                      (KUnbounded,       KBounded s m)     -> (res, checkBounds s m)-                     (KBounded{},       KUnbounded)       -> (res, (false, false))-                     (KUnbounded,       KUnbounded)       -> (res, (false, false))+                     (KBounded{},       KUnbounded)       -> (res, (sFalse, sFalse))+                     (KUnbounded,       KUnbounded)       -> (res, (sFalse, sFalse))                      (kFrom,            kTo)              -> error $ "sFromIntegralO: Expected bounded-BV types, received: " ++ show (kFrom, kTo)    where res :: SBV b@@ -425,16 +425,16 @@          u2u :: Int -> Int -> (SBool, SBool)         u2u n m = (underflow, overflow)-          where underflow  = false+          where underflow  = sFalse                 overflow-                  | n <= m = false+                  | n <= m = sFalse                   | True   = SBV $ svNot $ allZero (n-1) m x          u2s :: Int -> Int -> (SBool, SBool)         u2s n m = (underflow, overflow)-          where underflow = false+          where underflow = sFalse                 overflow-                  | m > n = false+                  | m > n = sFalse                   | True  = SBV $ svNot $ allZero (n-1) (m-1) x          s2u :: Int -> Int -> (SBool, SBool)@@ -442,26 +442,26 @@           where underflow = SBV $ (unSBV x `svTestBit` (n-1)) `svEqual` svTrue                  overflow-                  | m >= n - 1 = false+                  | m >= n - 1 = sFalse                   | True       = SBV $ svAll [(unSBV x `svTestBit` (n-1)) `svEqual` svFalse, svNot $ allZero (n-1) m x]          s2s :: Int -> Int -> (SBool, SBool)         s2s n m = (underflow, overflow)           where underflow-                  | m > n = false+                  | m > n = sFalse                   | True  = SBV $ svAll [(unSBV x `svTestBit` (n-1)) `svEqual` svTrue,  svNot $ allOne  (n-1) (m-1) x]                  overflow-                  | m > n = false+                  | m > n = sFalse                   | True  = SBV $ svAll [(unSBV x `svTestBit` (n-1)) `svEqual` svFalse, svNot $ allZero (n-1) (m-1) x]  -- | Version of 'sFromIntegral' that has calls to 'Data.SBV.sAssert' for checking no overflow/underflow can happen. Use it with a 'Data.SBV.safe' call.-sFromIntegralChecked :: forall a b. (?loc :: CallStack, Integral a, HasKind a, HasKind b, Num a, SymWord a, HasKind b, Num b, SymWord b) => SBV a -> SBV b-sFromIntegralChecked x = sAssert (Just ?loc) (msg "underflows") (bnot u)-                       $ sAssert (Just ?loc) (msg "overflows")  (bnot o)+sFromIntegralChecked :: forall a b. (?loc :: CallStack, Integral a, HasKind a, HasKind b, Num a, SymVal a, HasKind b, Num b, SymVal b) => SBV a -> SBV b+sFromIntegralChecked x = sAssert (Just ?loc) (msg "underflows") (sNot u)+                       $ sAssert (Just ?loc) (msg "overflows")  (sNot o)                          r   where kFrom = show $ kindOf x-        kTo   = show $ kindOf (undefined :: b)+        kTo   = show $ kindOf (Proxy @b)         msg c = "Casting from " ++ kFrom ++ " to " ++ kTo ++ " " ++ c          (r, (u, o)) = sFromIntegralO x@@ -486,18 +486,18 @@  | True      = let (u, o) = fu n a in (SBV u, SBV o)  where n = intSizeOf a -checkOp1 :: HasKind a => CallStack -> String -> (a -> SBV b) -> (a -> (SBool, SBool)) -> a -> SBV b-checkOp1 loc w op cop a = sAssert (Just loc) (msg "underflows") (bnot u)-                        $ sAssert (Just loc) (msg "overflows")  (bnot o)+checkOp1 :: (HasKind a, HasKind b) => CallStack -> String -> (a -> SBV b) -> (a -> (SBool, SBool)) -> a -> SBV b+checkOp1 loc w op cop a = sAssert (Just loc) (msg "underflows") (sNot u)+                        $ sAssert (Just loc) (msg "overflows")  (sNot o)                         $ op a   where k = show $ kindOf a         msg c = k ++ " " ++ w ++ " " ++ c          (u, o) = cop a -checkOp2 :: HasKind a => CallStack -> String -> (a -> b -> SBV c) -> (a -> b -> (SBool, SBool)) -> a -> b -> SBV c-checkOp2 loc w op cop a b = sAssert (Just loc) (msg "underflows") (bnot u)-                          $ sAssert (Just loc) (msg "overflows")  (bnot o)+checkOp2 :: (HasKind a, HasKind c) => CallStack -> String -> (a -> b -> SBV c) -> (a -> b -> (SBool, SBool)) -> a -> b -> SBV c+checkOp2 loc w op cop a b = sAssert (Just loc) (msg "underflows") (sNot u)+                          $ sAssert (Just loc) (msg "overflows")  (sNot o)                           $ a `op` b   where k = show $ kindOf a         msg c = k ++ " " ++ w ++ " " ++ c
Data/SBV/Tools/Polynomial.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Tools.Polynomials--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Tools.Polynomial+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Implementation of polynomial arithmetic -----------------------------------------------------------------------------@@ -27,8 +27,6 @@ import Data.SBV.Core.Data import Data.SBV.Core.Model -import Data.SBV.Utils.Boolean- -- | Implements polynomial addition, multiplication, division, and modulus operations -- over GF(2^n).  NB. Similar to 'sQuotRem', division by @0@ is interpreted as follows: --@@ -70,7 +68,7 @@  -- controls if the final type is shown as well.  showPolynomial :: Bool -> a -> String - -- defaults.. Minumum complete definition: pMult, pDivMod, showPolynomial+ {-# MINIMAL pMult, pDivMod, showPolynomial #-}  polynomial = foldr (flip setBit) 0  pAdd       = xor  pDiv x y   = fst (pDivMod x y)@@ -87,11 +85,11 @@ instance Polynomial SWord32 where {showPolynomial b = liftS (sp b); pMult = polyMult;      pDivMod = polyDivMod} instance Polynomial SWord64 where {showPolynomial b = liftS (sp b); pMult = polyMult;      pDivMod = polyDivMod} -lift :: SymWord a => ((SBV a, SBV a, [Int]) -> SBV a) -> (a, a, [Int]) -> a+lift :: SymVal a => ((SBV a, SBV a, [Int]) -> SBV a) -> (a, a, [Int]) -> a lift f (x, y, z) = fromJust $ unliteral $ f (literal x, literal y, z)-liftC :: SymWord a => (SBV a -> SBV a -> (SBV a, SBV a)) -> a -> a -> (a, a)+liftC :: SymVal a => (SBV a -> SBV a -> (SBV a, SBV a)) -> a -> a -> (a, a) liftC f x y = let (a, b) = f (literal x) (literal y) in (fromJust (unliteral a), fromJust (unliteral b))-liftS :: SymWord a => (a -> String) -> SBV a -> String+liftS :: SymVal a => (a -> String) -> SBV a -> String liftS f s   | Just x <- unliteral s = f x   | True                  = show s@@ -114,11 +112,11 @@ addPoly :: [SBool] -> [SBool] -> [SBool] addPoly xs    []      = xs addPoly []    ys      = ys-addPoly (x:xs) (y:ys) = x <+> y : addPoly xs ys+addPoly (x:xs) (y:ys) = x .<+> y : addPoly xs ys  -- | Run down a boolean condition over two lists. Note that this is -- different than zipWith as shorter list is assumed to be filled with--- false at the end (i.e., zero-bits); which nicely pads it when+-- sFalse at the end (i.e., zero-bits); which nicely pads it when -- considered as an unsigned number in little-endian form. ites :: SBool -> [SBool] -> [SBool] -> [SBool] ites s xs ys@@ -127,8 +125,8 @@  | True  = go xs ys  where go []     []     = []-       go []     (b:bs) = ite s false b : go [] bs-       go (a:as) []     = ite s a false : go as []+       go []     (b:bs) = ite s sFalse b : go [] bs+       go (a:as) []     = ite s a sFalse : go as []        go (a:as) (b:bs) = ite s a b : go as bs  -- | Multiply two polynomials and reduce by the third (concrete) irreducible, given by its coefficients.@@ -140,13 +138,13 @@   | not (isBounded x)   = error $ "SBV.polyMult: Received infinite precision value: " ++ show x   | True-  = fromBitsLE $ genericTake sz $ r ++ repeat false+  = fromBitsLE $ genericTake sz $ r ++ repeat sFalse   where (_, r) = mdp ms rs-        ms = genericTake (2*sz) $ mul (blastLE x) (blastLE y) [] ++ repeat false-        rs = genericTake (2*sz) $ [if i `elem` red then true else false |  i <- [0 .. foldr max 0 red] ] ++ repeat false+        ms = genericTake (2*sz) $ mul (blastLE x) (blastLE y) [] ++ repeat sFalse+        rs = genericTake (2*sz) $ [fromBool (i `elem` red) |  i <- [0 .. foldr max 0 red] ] ++ repeat sFalse         sz = intSizeOf x         mul _  []     ps = ps-        mul as (b:bs) ps = mul (false:as) bs (ites b (as `addPoly` ps) ps)+        mul as (b:bs) ps = mul (sFalse:as) bs (ites b (as `addPoly` ps) ps)  polyDivMod :: SFiniteBits a => SBV a -> SBV a -> (SBV a, SBV a) polyDivMod x y@@ -156,7 +154,7 @@    = error $ "SBV.polyDivMod: Received infinite precision value: " ++ show x    | True    = ite (y .== 0) (0, x) (adjust d, adjust r)-   where adjust xs = fromBitsLE $ genericTake sz $ xs ++ repeat false+   where adjust xs = fromBitsLE $ genericTake sz $ xs ++ repeat sFalse          sz        = intSizeOf x          (d, r)    = mdp (blastLE x) (blastLE y) @@ -180,13 +178,13 @@          | True     = let (rqs, rrs) = go (n-1) bs                       in (ites b (reverse qs) rqs, ites b rs rrs)          where degQuot = degTop - n-               ys' = replicate degQuot false ++ ys+               ys' = replicate degQuot sFalse ++ ys                (qs, rs) = divx (degQuot+1) degTop xs ys' --- return the element at index i; if not enough elements, return false--- N.B. equivalent to '(xs ++ repeat false) !! i', but more efficient+-- return the element at index i; if not enough elements, return sFalse+-- N.B. equivalent to '(xs ++ repeat sFalse) !! i', but more efficient idx :: [SBool] -> Int -> SBool-idx []     _ = false+idx []     _ = sFalse idx (x:_)  0 = x idx (_:xs) i = idx xs (i-1) @@ -230,12 +228,12 @@ -- There are many variants on final XOR's, reversed polynomials etc., so -- it is essential to double check you use the correct /algorithm/. crcBV :: Int -> [SBool] -> [SBool] -> [SBool]-crcBV n m p = take n $ go (replicate n false) (m ++ replicate n false)+crcBV n m p = take n $ go (replicate n sFalse) (m ++ replicate n sFalse)   where mask = drop (length p - n) p         go c []     = c         go c (b:bs) = go next bs           where c' = drop 1 c ++ [b]-                next = ite (head c) (zipWith (<+>) c' mask) c'+                next = ite (head c) (zipWith (.<+>) c' mask) c'  -- | Compute CRC's over polynomials, i.e., symbolic words. The first -- 'Int' argument plays the same role as the one in the 'crcBV' function.@@ -246,5 +244,5 @@   | not (isBounded m) || not (isBounded p)   = error $ "SBV.crc: Received an infinite precision value: " ++ show (m, p)   | True-  = fromBitsBE $ replicate (sz - n) false ++ crcBV n (blastBE m) (blastBE p)+  = fromBitsBE $ replicate (sz - n) sFalse ++ crcBV n (blastBE m) (blastBE p)   where sz = intSizeOf p
Data/SBV/Tools/Range.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Tools.Range--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Tools.Range+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Single variable valid range detection. -----------------------------------------------------------------------------@@ -25,7 +25,7 @@ import Data.SBV import Data.SBV.Control -import Data.SBV.Internals hiding (Range)+import Data.SBV.Internals hiding (Range, free_)  -- Doctest only -- $setup@@ -61,35 +61,35 @@ -- disjoint ranges that the predicate is satisfied over. (Linear in the number of ranges.) Note that the -- number of ranges is large, this can take a long time! Some examples: ----- >>> ranges (\(_ :: SInteger) -> false)+-- >>> ranges (\(_ :: SInteger) -> sFalse) -- []--- >>> ranges (\(_ :: SInteger) -> true)+-- >>> ranges (\(_ :: SInteger) -> sTrue) -- [(-oo,oo)]--- >>> ranges (\(x :: SInteger) -> bAnd [x .<= 120, x .>= -12, x ./= 3])+-- >>> ranges (\(x :: SInteger) -> sAnd [x .<= 120, x .>= -12, x ./= 3]) -- [[-12,3),(3,120]]--- >>> ranges (\(x :: SInteger) -> bAnd [x .<= 75, x .>= 5, x ./= 6, x ./= 67])+-- >>> ranges (\(x :: SInteger) -> sAnd [x .<= 75, x .>= 5, x ./= 6, x ./= 67]) -- [[5,6),(6,67),(67,75]]--- >>> ranges (\(x :: SInteger) -> bAnd [x .<= 75, x ./= 3, x ./= 67])+-- >>> ranges (\(x :: SInteger) -> sAnd [x .<= 75, x ./= 3, x ./= 67]) -- [(-oo,3),(3,67),(67,75]]--- >>> ranges (\(x :: SReal) -> bAnd [x .> 3.2, x .<  12.7])+-- >>> ranges (\(x :: SReal) -> sAnd [x .> 3.2, x .<  12.7]) -- [(3.2,12.7)]--- >>> ranges (\(x :: SReal) -> bAnd [x .> 3.2, x .<= 12.7])+-- >>> ranges (\(x :: SReal) -> sAnd [x .> 3.2, x .<= 12.7]) -- [(3.2,12.7]]--- >>> ranges (\(x :: SReal) -> bAnd [x .<= 12.7, x ./= 8])+-- >>> ranges (\(x :: SReal) -> sAnd [x .<= 12.7, x ./= 8]) -- [(-oo,8.0),(8.0,12.7]]--- >>> ranges (\(x :: SReal) -> bAnd [x .>= 12.7, x ./= 15])+-- >>> ranges (\(x :: SReal) -> sAnd [x .>= 12.7, x ./= 15]) -- [[12.7,15.0),(15.0,oo)]--- >>> ranges (\(x :: SInt8) -> bAnd [x .<= 7, x ./= 6])+-- >>> ranges (\(x :: SInt8) -> sAnd [x .<= 7, x ./= 6]) -- [[-128,6),(6,7]] -- >>> ranges $ \x -> x .> (0::SReal) -- [(0.0,oo)] -- >>> ranges $ \x -> x .< (0::SReal) -- [(-oo,0.0)]-ranges :: forall a. (Num a, SymWord a,  SMTValue a, SatModel a, Metric (SBV a)) => (SBV a -> SBool) -> IO [Range a]+ranges :: forall a. (Num a, SymVal a,  SMTValue a, SatModel a, Metric (SBV a)) => (SBV a -> SBool) -> IO [Range a] ranges = rangesWith defaultSMTCfg  -- | Compute ranges, using the given solver configuration.-rangesWith :: forall a. (Num a, SymWord a,  SMTValue a, SatModel a, Metric (SBV a)) => SMTConfig -> (SBV a -> SBool) -> IO [Range a]+rangesWith :: forall a. (Num a, SymVal a,  SMTValue a, SatModel a, Metric (SBV a)) => SMTConfig -> (SBV a -> SBool) -> IO [Range a] rangesWith cfg prop = do mbBounds <- getInitialBounds                          case mbBounds of                            Nothing -> return []@@ -97,21 +97,21 @@    where getInitialBounds :: IO (Maybe (Range a))         getInitialBounds = do-            let getGenVal :: GeneralizedCW -> Boundary a-                getGenVal (RegularCW  cw)  = Closed $ getRegVal cw-                getGenVal (ExtendedCW ecw) = getExtVal ecw+            let getGenVal :: GeneralizedCV -> Boundary a+                getGenVal (RegularCV  cv)  = Closed $ getRegVal cv+                getGenVal (ExtendedCV ecv) = getExtVal ecv -                getExtVal :: ExtCW -> Boundary a+                getExtVal :: ExtCV -> Boundary a                 getExtVal (Infinite _) = Unbounded-                getExtVal (Epsilon  k) = Open $ getRegVal (mkConstCW k (0::Integer))+                getExtVal (Epsilon  k) = Open $ getRegVal (mkConstCV k (0::Integer))                 getExtVal i@Interval{} = error $ unlines [ "*** Data.SBV.ranges.getExtVal: Unexpected interval bounds!"                                                          , "***"                                                          , "*** Found bound: " ++ show i                                                          , "*** Please report this as a bug!"                                                          ]-                getExtVal (BoundedCW cw) = Closed $ getRegVal cw-                getExtVal (AddExtCW a b) = getExtVal a `addBound` getExtVal b-                getExtVal (MulExtCW a b) = getExtVal a `mulBound` getExtVal b+                getExtVal (BoundedCV cv) = Closed $ getRegVal cv+                getExtVal (AddExtCV a b) = getExtVal a `addBound` getExtVal b+                getExtVal (MulExtCV a b) = getExtVal a `mulBound` getExtVal b                  opBound :: (a -> a -> a) -> Boundary a -> Boundary a -> Boundary a                 opBound f x y = case (fromBound x, fromBound y, isClosed x && isClosed y) of@@ -126,10 +126,10 @@                 addBound = opBound (+)                 mulBound = opBound (*) -                getRegVal :: CW -> a-                getRegVal cw = case parseCWs [cw] of+                getRegVal :: CV -> a+                getRegVal cv = case parseCVs [cv] of                                  Just (v, []) -> v-                                 _            -> error $ "Data.SBV.interval.getRegVal: Cannot parse " ++ show cw+                                 _            -> error $ "Data.SBV.interval.getRegVal: Cannot parse " ++ show cv              IndependentResult m <- optimizeWith cfg Independent $ do x <- free_                                                                      constrain $ prop x@@ -149,14 +149,14 @@                                      x <- free_                                       let restrict v open closed = case v of-                                                                    Unbounded -> true+                                                                    Unbounded -> sTrue                                                                     Open   a  -> x `open`   literal a                                                                     Closed a  -> x `closed` literal a                                           lower = restrict lo (.>) (.>=)                                          upper = restrict hi (.<) (.<=) -                                     constrain $ lower &&& upper &&& bnot (prop x)+                                     constrain $ lower .&& upper .&& sNot (prop x)                                       query $ do cs <- checkSat                                                 case cs of
Data/SBV/Tools/STree.hs view
@@ -1,25 +1,28 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Tools.STree--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Tools.STree+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Implementation of full-binary symbolic trees, providing logarithmic -- time access to elements. Both reads and writes are supported. ----------------------------------------------------------------------------- -{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE TypeSynonymInstances #-}  module Data.SBV.Tools.STree (STree, readSTree, writeSTree, mkSTree) where  import Data.SBV.Core.Data import Data.SBV.Core.Model +import Data.Proxy+ -- | A symbolic tree containing values of type e, indexed by -- elements of type i. Note that these are full-trees, and their -- their shapes remain constant. There is no API provided that@@ -34,14 +37,14 @@                        | SBin  (STreeInternal i e) (STreeInternal i e)                        deriving Show -instance SymWord e => Mergeable (STree i e) where+instance SymVal e => Mergeable (STree i e) where   symbolicMerge f b (SLeaf i)  (SLeaf j)    = SLeaf (symbolicMerge f b i j)   symbolicMerge f b (SBin l r) (SBin l' r') = SBin  (symbolicMerge f b l l') (symbolicMerge f b r r')   symbolicMerge _ _ _          _            = error "SBV.STree.symbolicMerge: Impossible happened while merging states"  -- | Reading a value. We bit-blast the index and descend down the full tree -- according to bit-values.-readSTree :: (SFiniteBits i, SymWord e) => STree i e -> SBV i -> SBV e+readSTree :: (SFiniteBits i, SymVal e) => STree i e -> SBV i -> SBV e readSTree s i = walk (blastBE i) s   where walk []     (SLeaf v)  = v         walk (b:bs) (SBin l r) = ite b (walk bs r) (walk bs l)@@ -49,7 +52,7 @@  -- | Writing a value, similar to how reads are done. The important thing is that the tree -- representation keeps updates to a minimum.-writeSTree :: (SFiniteBits i, SymWord e) => STree i e -> SBV i -> SBV e -> STree i e+writeSTree :: (SFiniteBits i, SymVal e) => STree i e -> SBV i -> SBV e -> STree i e writeSTree s i j = walk (blastBE i) s   where walk []     _          = SLeaf j         walk (b:bs) (SBin l r) = SBin (ite b l (walk bs l)) (ite b (walk bs r) r)@@ -58,15 +61,15 @@ -- | Construct the fully balanced initial tree using the given values. mkSTree :: forall i e. HasKind i => [SBV e] -> STree i e mkSTree ivals-  | isReal (undefined :: i)+  | isReal (Proxy @i)   = error "SBV.STree.mkSTree: Cannot build a real-valued sized tree"-  | not (isBounded (undefined :: i))+  | not (isBounded (Proxy @i))   = error "SBV.STree.mkSTree: Cannot build an infinitely large tree"   | reqd /= given   = error $ "SBV.STree.mkSTree: Required " ++ show reqd ++ " elements, received: " ++ show given   | True   = go ivals-  where reqd = 2 ^ intSizeOf (undefined :: i)+  where reqd = 2 ^ intSizeOf (Proxy @i)         given = length ivals         go []  = error "SBV.STree.mkSTree: Impossible happened, ran out of elements"         go [l] = SLeaf l
+ Data/SBV/Trans.hs view
@@ -0,0 +1,172 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Trans+-- Author    : Brian Schroeder, Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- More generalized alternative to @Data.SBV@ for advanced client use+-----------------------------------------------------------------------------++module Data.SBV.Trans (+  -- * Symbolic types++  -- ** Booleans+    SBool+  -- *** Boolean values and functions+  , sTrue, sFalse, sNot, (.&&), (.||), (.<+>), (.~&), (.~|), (.=>), (.<=>), fromBool, oneIf+  -- *** Logical functions+  , sAnd, sOr, sAny, sAll+  -- ** Bit-vectors+  -- *** Unsigned bit-vectors+  , SWord8, SWord16, SWord32, SWord64+  -- *** Signed bit-vectors+  , SInt8, SInt16, SInt32, SInt64+  -- ** Unbounded integers+  , SInteger+  -- ** Floating point numbers+  , SFloat, SDouble+  -- ** Algebraic reals+  , SReal, AlgReal, sRealToSInteger+  -- ** Characters, Strings and Regular Expressions+  , SChar, SString+  -- ** Symbolic lists+  , SList+  -- * Arrays of symbolic values+  , SymArray(newArray_, newArray, readArray, writeArray, mergeArrays), SArray, SFunArray++  -- * Creating symbolic values+  -- ** Single value+  , sBool, sWord8, sWord16, sWord32, sWord64, sInt8, sInt16, sInt32, sInt64, sInteger, sReal, sFloat, sDouble, sChar, sString, sList++  -- ** List of values+  , sBools, sWord8s, sWord16s, sWord32s, sWord64s, sInt8s, sInt16s, sInt32s, sInt64s, sIntegers, sReals, sFloats, sDoubles, sChars, sStrings, sLists++  -- * Symbolic Equality and Comparisons+  , EqSymbolic(..), OrdSymbolic(..), Equality(..)+  -- * Conditionals: Mergeable values+  , Mergeable(..), ite, iteLazy++  -- * Symbolic integral numbers+  , SIntegral+  -- * Division and Modulus+  , SDivisible(..)+  -- * Bit-vector operations+  -- ** Conversions+  , sFromIntegral+  -- ** Shifts and rotates+  , sShiftLeft, sShiftRight, sRotateLeft, sRotateRight, sSignedShiftArithRight+  -- ** Finite bit-vector operations+  , SFiniteBits(..)+  -- ** Splitting, joining, and extending+  , Splittable(..)+  -- ** Exponentiation+  , (.^)+  -- * IEEE-floating point numbers+  , IEEEFloating(..), RoundingMode(..), SRoundingMode, nan, infinity, sNaN, sInfinity+  -- ** Rounding modes+  , sRoundNearestTiesToEven, sRoundNearestTiesToAway, sRoundTowardPositive, sRoundTowardNegative, sRoundTowardZero, sRNE, sRNA, sRTP, sRTN, sRTZ+  -- ** Conversion to/from floats+  , IEEEFloatConvertable(..)+  -- ** Bit-pattern conversions+  , sFloatAsSWord32, sWord32AsSFloat, sDoubleAsSWord64, sWord64AsSDouble, blastSFloat, blastSDouble++  -- * Enumerations+  , mkSymbolicEnumeration++  -- * Uninterpreted sorts, constants, and functions+  , Uninterpreted(..), addAxiom++  -- * Properties, proofs, and satisfiability+  , Predicate, Goal, MProvable(..), Provable, proveWithAll, proveWithAny , satWithAll+  , satWithAny, generateSMTBenchmark+  , solve+  -- * Constraints+  -- ** General constraints+  , constrain, softConstrain++  -- ** Constraint Vacuity++  -- ** Named constraints and attributes+  , namedConstraint, constrainWithAttribute++  -- ** Unsat cores++  -- ** Cardinality constraints+  , pbAtMost, pbAtLeast, pbExactly, pbLe, pbGe, pbEq, pbMutexed, pbStronglyMutexed++  -- * Checking safety+  , sAssert, isSafe, SExecutable(..)++  -- * Quick-checking+  , sbvQuickCheck++  -- * Optimization++  -- ** Multiple optimization goals+  , OptimizeStyle(..)+  -- ** Objectives+  , Objective(..), Metric(..)+  -- ** Soft assumptions+  , assertWithPenalty , Penalty(..)+  -- ** Field extensions+  -- | If an optimization results in an infinity/epsilon value, the returned `CV` value will be in the corresponding extension field.+  , ExtCV(..), GeneralizedCV(..)++  -- * Model extraction++  -- ** Inspecting proof results+  , ThmResult(..), SatResult(..), AllSatResult(..), SafeResult(..), OptimizeResult(..), SMTResult(..), SMTReasonUnknown(..)++  -- ** Observing expressions+  , observe++  -- ** Programmable model extraction+  , SatModel(..), Modelable(..), displayModels, extractModels+  , getModelDictionaries, getModelValues, getModelUninterpretedValues++  -- * SMT Interface+  , SMTConfig(..), Timing(..), SMTLibVersion(..), Solver(..), SMTSolver(..)+  -- ** Controlling verbosity++  -- ** Solvers+  , boolector, cvc4, yices, z3, mathSAT, abc+  -- ** Configurations+  , defaultSolverConfig, defaultSMTCfg, sbvCheckSolverInstallation, sbvAvailableSolvers+  , setLogic, Logic(..), setOption, setInfo, setTimeOut+  -- ** SBV exceptions+  , SBVException(..)++  -- * Abstract SBV type+  , SBV, HasKind(..), Kind(..), SymVal(..)+  , MonadSymbolic(..), Symbolic, SymbolicT, label, output, runSMT, runSMTWith++  -- * Module exports++  , module Data.Bits+  , module Data.Word+  , module Data.Int+  , module Data.Ratio+  ) where++import Data.SBV.Core.AlgReals+import Data.SBV.Core.Data+import Data.SBV.Core.Model+import Data.SBV.Core.Floating+import Data.SBV.Core.Splittable+import Data.SBV.Core.Symbolic++import Data.SBV.Provers.Prover++import Data.SBV.Client++import Data.SBV.Utils.TDiff   (Timing(..))++import Data.Bits+import Data.Int+import Data.Ratio+import Data.Word++import Data.SBV.SMT.Utils (SBVException(..))+import Data.SBV.Control.Types (SMTReasonUnknown(..), Logic(..))
+ Data/SBV/Trans/Control.hs view
@@ -0,0 +1,84 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Trans.Control+-- Author    : Brian Schroeder, Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- More generalized alternative to @Data.SBV.Control@ for advanced client use+-----------------------------------------------------------------------------++module Data.SBV.Trans.Control (++     -- * User queries+       ExtractIO(..), MonadQuery(..), QueryT, Query, query++     -- * Create a fresh variable+     , freshVar_, freshVar++     -- * Create a fresh array+     , freshArray_, freshArray++     -- * Checking satisfiability+     , CheckSatResult(..), checkSat, ensureSat, checkSatUsing, checkSatAssuming, checkSatAssumingWithUnsatisfiableSet++     -- * Querying the solver+     -- ** Extracting values+     , SMTValue(..), getValue, getUninterpretedValue, getModel, getAssignment, getSMTResult, getUnknownReason, getObservables++     -- ** Extracting the unsat core+     , getUnsatCore++     -- ** Extracting a proof+     , getProof++     -- ** Extracting interpolants+     , getInterpolant++     -- ** Extracting assertions+     , getAssertions++     -- * Getting solver information+     , SMTInfoFlag(..), SMTErrorBehavior(..), SMTInfoResponse(..)+     , getInfo, getOption++     -- * Entering and exiting assertion stack+     , getAssertionStackDepth, push, pop, inNewAssertionStack++     -- * Higher level tactics+     , caseSplit++     -- * Resetting the solver state+     , resetAssertions++     -- * Constructing assignments+     , (|->)++     -- * Terminating the query+     , mkSMTResult+     , exit++     -- * Controlling the solver behavior+     , ignoreExitCode, timeout++     -- * Miscellaneous+     , queryDebug+     , echo+     , io++     -- * Solver options+     , SMTOption(..)+     ) where++import Data.SBV.Core.Data     (SMTConfig(..))+import Data.SBV.Core.Symbolic (MonadQuery(..), QueryT, Query, SymbolicT, QueryContext(..))++import Data.SBV.Control.Query+import Data.SBV.Control.Utils (SMTValue(..), queryDebug, executeQuery)++import Data.SBV.Utils.ExtractIO++-- | Run a custom query.+query :: ExtractIO m => QueryT m a -> SymbolicT m a+query = executeQuery QueryExternal
+ Data/SBV/Tuple.hs view
@@ -0,0 +1,295 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Tuple+-- Author    : Joel Burget, Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Accessing symbolic tuple fields and deconstruction.+-----------------------------------------------------------------------------++{-# LANGUAGE DataKinds              #-}+{-# LANGUAGE FlexibleContexts       #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures         #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE Rank2Types             #-}+{-# LANGUAGE ScopedTypeVariables    #-}+{-# LANGUAGE TypeApplications       #-}++module Data.SBV.Tuple (+  -- * Symbolic field access+    (^.), _1, _2, _3, _4, _5, _6, _7, _8+  -- * Tupling and untupling+  , tuple, untuple+  ) where++import GHC.TypeLits++import Data.SBV.Core.Data+import Data.SBV.Core.Symbolic+import Data.SBV.Core.Model () -- instances only++-- For doctest use only+--+-- $setup+-- >>> :set -XTypeApplications+-- >>> import Data.SBV.Provers.Prover (prove)+-- >>> import Data.SBV.Core.Model++-- | Field access, inspired by the lens library. This is merely reverse+-- application, but allows us to write things like @(1, 2)^._1@ which is+-- likely to be familiar to most Haskell programmers out there. Note that+-- this is precisely equivalent to @_1 (1, 2)@, but perhaps it reads a little+-- nicer.+(^.) :: a -> (a -> b) -> b+t ^. f = f t+infixl 8 ^.++-- | Dynamic interface to exporting tuples, this function is not+-- exported on purpose; use it only via the field functions '_1', '_2', etc.+symbolicFieldAccess :: (SymVal a, HasKind tup) => Int -> SBV tup -> SBV a+symbolicFieldAccess i tup+  | 1 > i || i > lks+  = bad $ "Index is out of bounds, " ++ show i ++ " is outside [1," ++ show lks ++ "]"+  | SBV (SVal kval (Left v)) <- tup+  = case cvVal v of+      CTuple vs | kval      /= ktup -> bad $ "Kind/value mismatch: "      ++ show kval+                | length vs /= lks  -> bad $ "Value has fewer elements: " ++ show (CV kval (CTuple vs))+                | True              -> literal $ fromCV $ CV kElem (vs !! (i-1))+      _                             -> bad $ "Kind/value mismatch: " ++ show v+  | True+  = symAccess+  where ktup = kindOf tup++        (lks, eks) = case ktup of+                       KTuple ks -> (length ks, ks)+                       _         -> bad "Was expecting to receive a tuple!"++        kElem = eks !! (i-1)++        bad :: String -> a+        bad problem = error $ unlines [ "*** Data.SBV.field: Impossible happened"+                                      , "***   Accessing element: " ++ show i+                                      , "***   Argument kind    : " ++ show ktup+                                      , "***   Problem          : " ++ problem+                                      , "*** Please report this as a bug!"+                                      ]++        symAccess :: SBV a+        symAccess = SBV $ SVal kElem $ Right $ cache y+          where y st = do sv <- svToSV st $ unSBV tup+                          newExpr st kElem (SBVApp (TupleAccess i lks) [sv])++-- | Field labels+data Label (l :: Symbol) = Get++-- | The class 'HasField' captures the notion that a type has a certain field+class (SymVal elt, HasKind tup) => HasField l elt tup | l tup -> elt where+  field :: Label l -> SBV tup -> SBV elt++instance (HasKind a, HasKind b                                                                  , SymVal a) => HasField "_1" a (a, b)                   where field _ = symbolicFieldAccess 1+instance (HasKind a, HasKind b, HasKind c                                                       , SymVal a) => HasField "_1" a (a, b, c)                where field _ = symbolicFieldAccess 1+instance (HasKind a, HasKind b, HasKind c, HasKind d                                            , SymVal a) => HasField "_1" a (a, b, c, d)             where field _ = symbolicFieldAccess 1+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e                                 , SymVal a) => HasField "_1" a (a, b, c, d, e)          where field _ = symbolicFieldAccess 1+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f                      , SymVal a) => HasField "_1" a (a, b, c, d, e, f)       where field _ = symbolicFieldAccess 1+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g           , SymVal a) => HasField "_1" a (a, b, c, d, e, f, g)    where field _ = symbolicFieldAccess 1+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g, HasKind h, SymVal a) => HasField "_1" a (a, b, c, d, e, f, g, h) where field _ = symbolicFieldAccess 1++instance (HasKind a, HasKind b                                                                  , SymVal b) => HasField "_2" b (a, b)                   where field _ = symbolicFieldAccess 2+instance (HasKind a, HasKind b, HasKind c                                                       , SymVal b) => HasField "_2" b (a, b, c)                where field _ = symbolicFieldAccess 2+instance (HasKind a, HasKind b, HasKind c, HasKind d                                            , SymVal b) => HasField "_2" b (a, b, c, d)             where field _ = symbolicFieldAccess 2+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e                                 , SymVal b) => HasField "_2" b (a, b, c, d, e)          where field _ = symbolicFieldAccess 2+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f                      , SymVal b) => HasField "_2" b (a, b, c, d, e, f)       where field _ = symbolicFieldAccess 2+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g           , SymVal b) => HasField "_2" b (a, b, c, d, e, f, g)    where field _ = symbolicFieldAccess 2+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g, HasKind h, SymVal b) => HasField "_2" b (a, b, c, d, e, f, g, h) where field _ = symbolicFieldAccess 2++instance (HasKind a, HasKind b, HasKind c                                                       , SymVal c) => HasField "_3" c (a, b, c)                where field _ = symbolicFieldAccess 3+instance (HasKind a, HasKind b, HasKind c, HasKind d                                            , SymVal c) => HasField "_3" c (a, b, c, d)             where field _ = symbolicFieldAccess 3+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e                                 , SymVal c) => HasField "_3" c (a, b, c, d, e)          where field _ = symbolicFieldAccess 3+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f                      , SymVal c) => HasField "_3" c (a, b, c, d, e, f)       where field _ = symbolicFieldAccess 3+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g           , SymVal c) => HasField "_3" c (a, b, c, d, e, f, g)    where field _ = symbolicFieldAccess 3+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g, HasKind h, SymVal c) => HasField "_3" c (a, b, c, d, e, f, g, h) where field _ = symbolicFieldAccess 3++instance (HasKind a, HasKind b, HasKind c, HasKind d                                            , SymVal d) => HasField "_4" d (a, b, c, d)             where field _ = symbolicFieldAccess 4+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e                                 , SymVal d) => HasField "_4" d (a, b, c, d, e)          where field _ = symbolicFieldAccess 4+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f                      , SymVal d) => HasField "_4" d (a, b, c, d, e, f)       where field _ = symbolicFieldAccess 4+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g           , SymVal d) => HasField "_4" d (a, b, c, d, e, f, g)    where field _ = symbolicFieldAccess 4+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g, HasKind h, SymVal d) => HasField "_4" d (a, b, c, d, e, f, g, h) where field _ = symbolicFieldAccess 4++instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e                                 , SymVal e) => HasField "_5" e (a, b, c, d, e)          where field _ = symbolicFieldAccess 5+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f                      , SymVal e) => HasField "_5" e (a, b, c, d, e, f)       where field _ = symbolicFieldAccess 5+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g           , SymVal e) => HasField "_5" e (a, b, c, d, e, f, g)    where field _ = symbolicFieldAccess 5+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g, HasKind h, SymVal e) => HasField "_5" e (a, b, c, d, e, f, g, h) where field _ = symbolicFieldAccess 5++instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f                      , SymVal f) => HasField "_6" f (a, b, c, d, e, f)       where field _ = symbolicFieldAccess 6+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g           , SymVal f) => HasField "_6" f (a, b, c, d, e, f, g)    where field _ = symbolicFieldAccess 6+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g, HasKind h, SymVal f) => HasField "_6" f (a, b, c, d, e, f, g, h) where field _ = symbolicFieldAccess 6++instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g           , SymVal g) => HasField "_7" g (a, b, c, d, e, f, g)    where field _ = symbolicFieldAccess 7+instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g, HasKind h, SymVal g) => HasField "_7" g (a, b, c, d, e, f, g, h) where field _ = symbolicFieldAccess 7++instance (HasKind a, HasKind b, HasKind c, HasKind d, HasKind e, HasKind f, HasKind g, HasKind h, SymVal h) => HasField "_8" h (a, b, c, d, e, f, g, h) where field _ = symbolicFieldAccess 8++-- | Access the 1st element of an @STupleN@, @2 <= N <= 8@. Also see '^.'.+_1 :: HasField "_1" b a => SBV a -> SBV b+_1 = field (Get @"_1")++-- | Access the 2nd element of an @STupleN@, @2 <= N <= 8@. Also see '^.'.+_2 :: HasField "_2" b a => SBV a -> SBV b+_2 = field (Get @"_2")++-- | Access the 3nd element of an @STupleN@, @3 <= N <= 8@. Also see '^.'.+_3 :: HasField "_3" b a => SBV a -> SBV b+_3 = field (Get @"_3")++-- | Access the 4th element of an @STupleN@, @4 <= N <= 8@. Also see '^.'.+_4 :: HasField "_4" b a => SBV a -> SBV b+_4 = field (Get @"_4")++-- | Access the 5th element of an @STupleN@, @5 <= N <= 8@. Also see '^.'.+_5 :: HasField "_5" b a => SBV a -> SBV b+_5 = field (Get @"_5")++-- | Access the 6th element of an @STupleN@, @6 <= N <= 8@. Also see '^.'.+_6 :: HasField "_6" b a => SBV a -> SBV b+_6 = field (Get @"_6")++-- | Access the 7th element of an @STupleN@, @7 <= N <= 8@. Also see '^.'.+_7 :: HasField "_7" b a => SBV a -> SBV b+_7 = field (Get @"_7")++-- | Access the 8th element of an @STupleN@, @8 <= N <= 8@. Also see '^.'.+_8 :: HasField "_8" b a => SBV a -> SBV b+_8 = field (Get @"_8")++-- | Constructing a tuple from its parts and deconstructing back.+class Tuple tup a | a -> tup, tup -> a where+  -- | Deconstruct a tuple, getting its constituent parts apart. Forms an+  -- isomorphism pair with 'untuple':+  --+  -- >>> prove $ \p -> tuple @(Integer, Bool, (String, Char)) (untuple p) .== p+  -- Q.E.D.+  untuple :: SBV tup -> a++  -- | Constructing a tuple from its parts. Forms an isomorphism pair with 'tuple':+  --+  -- >>> prove $ \p -> untuple @(Integer, Bool, (String, Char)) (tuple p) .== p+  -- Q.E.D.+  tuple   :: a -> SBV tup++instance (SymVal a, SymVal b) => Tuple (a, b) (SBV a, SBV b) where+  untuple p = (p^._1, p^._2)++  tuple p@(sa, sb)+    | Just a <- unliteral sa, Just b <- unliteral sb+    = literal (a, b)+    | True+    = SBV $ SVal k $ Right $ cache res+    where k      = kindOf p+          res st = do asv <- sbvToSV st sa+                      bsv <- sbvToSV st sb+                      newExpr st k (SBVApp (TupleConstructor 2) [asv, bsv])++instance (SymVal a, SymVal b, SymVal c) => Tuple (a, b, c) (SBV a, SBV b, SBV c) where+  untuple p = (p^._1, p^._2, p^._3)++  tuple p@(sa, sb, sc)+    | Just a <- unliteral sa, Just b <- unliteral sb, Just c <- unliteral sc+    = literal (a, b, c)+    | True+    = SBV $ SVal k $ Right $ cache res+    where k      = kindOf p+          res st = do asv <- sbvToSV st sa+                      bsv <- sbvToSV st sb+                      csv <- sbvToSV st sc+                      newExpr st k (SBVApp (TupleConstructor 3) [asv, bsv, csv])++instance (SymVal a, SymVal b, SymVal c, SymVal d) => Tuple (a, b, c, d) (SBV a, SBV b, SBV c, SBV d) where+  untuple p = (p^._1, p^._2, p^._3, p^._4)++  tuple p@(sa, sb, sc, sd)+    | Just a <- unliteral sa, Just b <- unliteral sb, Just c <- unliteral sc, Just d <- unliteral sd+    = literal (a, b, c, d)+    | True+    = SBV $ SVal k $ Right $ cache res+    where k      = kindOf p+          res st = do asv <- sbvToSV st sa+                      bsv <- sbvToSV st sb+                      csv <- sbvToSV st sc+                      dsv <- sbvToSV st sd+                      newExpr st k (SBVApp (TupleConstructor 4) [asv, bsv, csv, dsv])++instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e) => Tuple (a, b, c, d, e) (SBV a, SBV b, SBV c, SBV d, SBV e) where+  untuple p = (p^._1, p^._2, p^._3, p^._4, p^._5)++  tuple p@(sa, sb, sc, sd, se)+    | Just a <- unliteral sa, Just b <- unliteral sb, Just c <- unliteral sc, Just d <- unliteral sd, Just e <- unliteral se+    = literal (a, b, c, d, e)+    | True+    = SBV $ SVal k $ Right $ cache res+    where k      = kindOf p+          res st = do asv <- sbvToSV st sa+                      bsv <- sbvToSV st sb+                      csv <- sbvToSV st sc+                      dsv <- sbvToSV st sd+                      esv <- sbvToSV st se+                      newExpr st k (SBVApp (TupleConstructor 5) [asv, bsv, csv, dsv, esv])++instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f) => Tuple (a, b, c, d, e, f) (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f) where+  untuple p = (p^._1, p^._2, p^._3, p^._4, p^._5, p^._6)++  tuple p@(sa, sb, sc, sd, se, sf)+    | Just a <- unliteral sa, Just b <- unliteral sb, Just c <- unliteral sc, Just d <- unliteral sd, Just e <- unliteral se, Just f <- unliteral sf+    = literal (a, b, c, d, e, f)+    | True+    = SBV $ SVal k $ Right $ cache res+    where k      = kindOf p+          res st = do asv <- sbvToSV st sa+                      bsv <- sbvToSV st sb+                      csv <- sbvToSV st sc+                      dsv <- sbvToSV st sd+                      esv <- sbvToSV st se+                      fsv <- sbvToSV st sf+                      newExpr st k (SBVApp (TupleConstructor 6) [asv, bsv, csv, dsv, esv, fsv])++instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g) => Tuple (a, b, c, d, e, f, g) (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g) where+  untuple p = (p^._1, p^._2, p^._3, p^._4, p^._5, p^._6, p^._7)++  tuple p@(sa, sb, sc, sd, se, sf, sg)+    | Just a <- unliteral sa, Just b <- unliteral sb, Just c <- unliteral sc, Just d <- unliteral sd, Just e <- unliteral se, Just f <- unliteral sf, Just g <- unliteral sg+    = literal (a, b, c, d, e, f, g)+    | True+    = SBV $ SVal k $ Right $ cache res+    where k      = kindOf p+          res st = do asv <- sbvToSV st sa+                      bsv <- sbvToSV st sb+                      csv <- sbvToSV st sc+                      dsv <- sbvToSV st sd+                      esv <- sbvToSV st se+                      fsv <- sbvToSV st sf+                      gsv <- sbvToSV st sg+                      newExpr st k (SBVApp (TupleConstructor 7) [asv, bsv, csv, dsv, esv, fsv, gsv])++instance (SymVal a, SymVal b, SymVal c, SymVal d, SymVal e, SymVal f, SymVal g, SymVal h) => Tuple (a, b, c, d, e, f, g, h) (SBV a, SBV b, SBV c, SBV d, SBV e, SBV f, SBV g, SBV h) where+  untuple p = (p^._1, p^._2, p^._3, p^._4, p^._5, p^._6, p^._7, p^._8)++  tuple p@(sa, sb, sc, sd, se, sf, sg, sh)+    | Just a <- unliteral sa, Just b <- unliteral sb, Just c <- unliteral sc, Just d <- unliteral sd, Just e <- unliteral se, Just f <- unliteral sf, Just g <- unliteral sg, Just h <- unliteral sh+    = literal (a, b, c, d, e, f, g, h)+    | True+    = SBV $ SVal k $ Right $ cache res+    where k      = kindOf p+          res st = do asv <- sbvToSV st sa+                      bsv <- sbvToSV st sb+                      csv <- sbvToSV st sc+                      dsv <- sbvToSV st sd+                      esv <- sbvToSV st se+                      fsv <- sbvToSV st sf+                      gsv <- sbvToSV st sg+                      hsv <- sbvToSV st sh+                      newExpr st k (SBVApp (TupleConstructor 8) [asv, bsv, csv, dsv, esv, fsv, gsv, hsv])++{-# ANN module ("HLint: ignore Reduce duplication" :: String) #-}
− Data/SBV/Utils/Boolean.hs 
@@ -1,81 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Utils.Boolean--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental------ Abstraction of booleans. Unfortunately, Haskell makes Bool's very hard to--- work with, by making it a fixed-data type. This is our workaround--------------------------------------------------------------------------------module Data.SBV.Utils.Boolean(Boolean(..), bAnd, bOr, bAny, bAll)  where--infixl 6 <+>       -- xor-infixr 3 &&&, ~&   -- and, nand-infixr 2 |||, ~|   -- or, nor-infixr 1 ==>, <=>  -- implies, iff---- | The 'Boolean' class: a generalization of Haskell's 'Bool' type--- Haskell 'Bool' and SBV's 'Data.SBV.SBool' are instances of this class, unifying the treatment of boolean values.------ Minimal complete definition: 'true', 'bnot', '&&&'--- However, it's advisable to define 'false', and '|||' as well (typically), for clarity.-class Boolean b where-  -- | logical true-  true   :: b-  -- | logical false-  false  :: b-  -- | complement-  bnot   :: b -> b-  -- | and-  (&&&)  :: b -> b -> b-  -- | or-  (|||)  :: b -> b -> b-  -- | nand-  (~&)   :: b -> b -> b-  -- | nor-  (~|)   :: b -> b -> b-  -- | xor-  (<+>)  :: b -> b -> b-  -- | implies-  (==>)  :: b -> b -> b-  -- | equivalence-  (<=>)  :: b -> b -> b-  -- | cast from Bool-  fromBool :: Bool -> b--  -- default definitions-  false   = bnot true-  a ||| b = bnot (bnot a &&& bnot b)-  a ~& b  = bnot (a &&& b)-  a ~| b  = bnot (a ||| b)-  a <+> b = (a &&& bnot b) ||| (bnot a &&& b)-  a <=> b = (a &&& b) ||| (bnot a &&& bnot b)-  a ==> b = bnot a ||| b-  fromBool True  = true-  fromBool False = false---- | Generalization of 'and'-bAnd :: Boolean b => [b] -> b-bAnd = foldr (&&&) true---- | Generalization of 'or'-bOr :: Boolean b => [b] -> b-bOr  = foldr (|||) false---- | Generalization of 'any'-bAny :: Boolean b => (a -> b) -> [a] -> b-bAny f = bOr  . map f---- | Generalization of 'all'-bAll :: Boolean b => (a -> b) -> [a] -> b-bAll f = bAnd . map f--instance Boolean Bool where-  true   = True-  false  = False-  bnot   = not-  (&&&)  = (&&)-  (|||)  = (||)
+ Data/SBV/Utils/ExtractIO.hs view
@@ -0,0 +1,49 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Data.SBV.Utils.ExtractIO+-- Author    : Brian Schroeder+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Helper typeclass for interoperation with APIs which take IO actions in+-- negative position.+-----------------------------------------------------------------------------++module Data.SBV.Utils.ExtractIO where++import Control.Monad.Except      (ExceptT(ExceptT), runExceptT)+import Control.Monad.IO.Class    (MonadIO)+import Control.Monad.Trans.Maybe (MaybeT(MaybeT), runMaybeT)++import qualified Control.Monad.Writer.Lazy   as LW+import qualified Control.Monad.Writer.Strict as SW++-- | Monads which support 'IO' operations and can extract all 'IO' behavior for+-- interoperation with functions like 'Control.Concurrent.catches', which takes+-- an 'IO' action in negative position. This function can not be implemented+-- for transformers like @ReaderT r@ or @StateT s@, whose resultant 'IO'+-- actions are a function of some environment or state.+class MonadIO m => ExtractIO m where+    -- | Law: the @m a@ yielded by 'IO' is pure with respect to 'IO'.+    extractIO :: m a -> IO (m a)++-- | Trivial IO extraction for 'IO'.+instance ExtractIO IO where+    extractIO = pure++-- | IO extraction for 'MaybeT'.+instance ExtractIO m => ExtractIO (MaybeT m) where+    extractIO = fmap MaybeT . extractIO . runMaybeT++-- | IO extraction for 'ExceptT'.+instance ExtractIO m => ExtractIO (ExceptT e m) where+    extractIO = fmap ExceptT . extractIO . runExceptT++-- | IO extraction for lazy 'LW.WriterT'.+instance (Monoid w, ExtractIO m) => ExtractIO (LW.WriterT w m) where+    extractIO = fmap LW.WriterT . extractIO . LW.runWriterT++-- | IO extraction for strict 'SW.WriterT'.+instance (Monoid w, ExtractIO m) => ExtractIO (SW.WriterT w m) where+    extractIO = fmap SW.WriterT . extractIO . SW.runWriterT
Data/SBV/Utils/Lib.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Utils.Lib--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Utils.Lib+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Misc helpers -----------------------------------------------------------------------------
Data/SBV/Utils/Numeric.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Utils.Numeric--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Utils.Numeric+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Various number related utilities -----------------------------------------------------------------------------
Data/SBV/Utils/PrettyNum.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Utils.PrettyNum--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Utils.PrettyNum+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Number representations in hex/bin -----------------------------------------------------------------------------@@ -16,7 +16,7 @@ module Data.SBV.Utils.PrettyNum (         PrettyNum(..), readBin, shex, chex, shexI, sbin, sbinI       , showCFloat, showCDouble, showHFloat, showHDouble-      , showSMTFloat, showSMTDouble, smtRoundingMode, cwToSMTLib, mkSkolemZero+      , showSMTFloat, showSMTDouble, smtRoundingMode, cvToSMTLib, mkSkolemZero       ) where  import Data.Char  (intToDigit, ord)@@ -36,8 +36,6 @@ import Data.SBV.Utils.Lib (stringToQFS)  -- | PrettyNum class captures printing of numbers in hex and binary formats; also supporting negative numbers.------ Minimal complete definition: 'hexS' and 'binS' class PrettyNum a where   -- | Show a number in hexadecimal (starting with @0x@ and type.)   hexS :: a -> String@@ -72,44 +70,44 @@ instance PrettyNum Integer where   {hexS = shexI True True; binS = sbinI True True; hex = shexI False False; bin = sbinI False False;} -instance PrettyNum CW where-  hexS cw | isUninterpreted cw = show cw ++ " :: " ++ show (kindOf cw)-          | isBoolean cw       = hexS (cwToBool cw) ++ " :: Bool"-          | isFloat cw         = let CWFloat   f = cwVal cw in show f ++ " :: Float\n"  ++ show (floatToFP f)-          | isDouble cw        = let CWDouble  d = cwVal cw in show d ++ " :: Double\n" ++ show (doubleToFP d)-          | isReal cw          = let CWAlgReal w = cwVal cw in show w ++ " :: Real"-          | isString cw        = let CWString  s = cwVal cw in show s ++ " :: String"-          | not (isBounded cw) = let CWInteger w = cwVal cw in shexI True True w-          | True               = let CWInteger w = cwVal cw in shex  True True (hasSign cw, intSizeOf cw) w+instance PrettyNum CV where+  hexS cv | isUninterpreted cv = show cv ++ " :: " ++ show (kindOf cv)+          | isBoolean       cv = hexS (cvToBool cv) ++ " :: Bool"+          | isFloat         cv = let CFloat   f = cvVal cv in show f ++ " :: Float\n"  ++ show (floatToFP f)+          | isDouble        cv = let CDouble  d = cvVal cv in show d ++ " :: Double\n" ++ show (doubleToFP d)+          | isReal          cv = let CAlgReal r = cvVal cv in show r ++ " :: Real"+          | isString        cv = let CString  s = cvVal cv in show s ++ " :: String"+          | not (isBounded cv) = let CInteger i = cvVal cv in shexI True True i+          | True               = let CInteger i = cvVal cv in shex  True True (hasSign cv, intSizeOf cv) i -  binS cw | isUninterpreted cw = show cw  ++ " :: " ++ show (kindOf cw)-          | isBoolean cw       = binS (cwToBool cw)  ++ " :: Bool"-          | isFloat cw         = let CWFloat   f = cwVal cw in show f ++ " :: Float\n"  ++ show (floatToFP f)-          | isDouble cw        = let CWDouble  d = cwVal cw in show d ++ " :: Double\n" ++ show (doubleToFP d)-          | isReal cw          = let CWAlgReal w = cwVal cw in show w ++ " :: Real"-          | isString cw        = let CWString  s = cwVal cw in show s ++ " :: String"-          | not (isBounded cw) = let CWInteger w = cwVal cw in sbinI True True w-          | True               = let CWInteger w = cwVal cw in sbin  True True (hasSign cw, intSizeOf cw) w+  binS cv | isUninterpreted cv = show cv  ++ " :: " ++ show (kindOf cv)+          | isBoolean       cv = binS (cvToBool cv)  ++ " :: Bool"+          | isFloat         cv = let CFloat   f = cvVal cv in show f ++ " :: Float\n"  ++ show (floatToFP f)+          | isDouble        cv = let CDouble  d = cvVal cv in show d ++ " :: Double\n" ++ show (doubleToFP d)+          | isReal          cv = let CAlgReal r = cvVal cv in show r ++ " :: Real"+          | isString        cv = let CString  s = cvVal cv in show s ++ " :: String"+          | not (isBounded cv) = let CInteger i = cvVal cv in sbinI True True i+          | True               = let CInteger i = cvVal cv in sbin  True True (hasSign cv, intSizeOf cv) i -  hex cw | isUninterpreted cw = show cw-         | isBoolean cw       = hexS (cwToBool cw) ++ " :: Bool"-         | isFloat cw         = let CWFloat   f = cwVal cw in show f-         | isDouble cw        = let CWDouble  d = cwVal cw in show d-         | isReal cw          = let CWAlgReal w = cwVal cw in show w-         | isString cw        = let CWString  s = cwVal cw in show s-         | not (isBounded cw) = let CWInteger w = cwVal cw in shexI False False w-         | True               = let CWInteger w = cwVal cw in shex  False False (hasSign cw, intSizeOf cw) w+  hex cv | isUninterpreted cv = show cv+         | isBoolean       cv = hexS (cvToBool cv) ++ " :: Bool"+         | isFloat         cv = let CFloat   f = cvVal cv in show f+         | isDouble        cv = let CDouble  d = cvVal cv in show d+         | isReal          cv = let CAlgReal r = cvVal cv in show r+         | isString        cv = let CString  s = cvVal cv in show s+         | not (isBounded cv) = let CInteger i = cvVal cv in shexI False False i+         | True               = let CInteger i = cvVal cv in shex  False False (hasSign cv, intSizeOf cv) i -  bin cw | isUninterpreted cw = show cw-         | isBoolean cw       = binS (cwToBool cw) ++ " :: Bool"-         | isFloat cw         = let CWFloat  f  = cwVal cw in show f-         | isDouble cw        = let CWDouble d  = cwVal cw in show d-         | isReal cw          = let CWAlgReal w = cwVal cw in show w-         | isString cw        = let CWString  s = cwVal cw in show s-         | not (isBounded cw) = let CWInteger w = cwVal cw in sbinI False False w-         | True               = let CWInteger w = cwVal cw in sbin  False False (hasSign cw, intSizeOf cw) w+  bin cv | isUninterpreted cv = show cv+         | isBoolean       cv = binS (cvToBool cv) ++ " :: Bool"+         | isFloat         cv = let CFloat   f = cvVal cv in show f+         | isDouble        cv = let CDouble  d = cvVal cv in show d+         | isReal          cv = let CAlgReal r = cvVal cv in show r+         | isString        cv = let CString  s = cvVal cv in show s+         | not (isBounded cv) = let CInteger i = cvVal cv in sbinI False False i+         | True               = let CInteger i = cvVal cv in sbin  False False (hasSign cv, intSizeOf cv) i -instance (SymWord a, PrettyNum a) => PrettyNum (SBV a) where+instance (SymVal a, PrettyNum a) => PrettyNum (SBV a) where   hexS s = maybe (show s) (hexS :: a -> String) $ unliteral s   binS s = maybe (show s) (binS :: a -> String) $ unliteral s   hex  s = maybe (show s) (hex  :: a -> String) $ unliteral s@@ -291,26 +289,28 @@ smtRoundingMode RoundTowardNegative    = "roundTowardNegative" smtRoundingMode RoundTowardZero        = "roundTowardZero" --- | Convert a CW to an SMTLib2 compliant value-cwToSMTLib :: RoundingMode -> CW -> String-cwToSMTLib rm x-  | isBoolean       x, CWInteger  w      <- cwVal x = if w == 0 then "false" else "true"-  | isUninterpreted x, CWUserSort (_, s) <- cwVal x = roundModeConvert s-  | isReal          x, CWAlgReal  r      <- cwVal x = algRealToSMTLib2 r-  | isFloat         x, CWFloat    f      <- cwVal x = showSMTFloat  rm f-  | isDouble        x, CWDouble   d      <- cwVal x = showSMTDouble rm d-  | not (isBounded x), CWInteger  w      <- cwVal x = if w >= 0 then show w else "(- " ++ show (abs w) ++ ")"-  | not (hasSign x)  , CWInteger  w      <- cwVal x = smtLibHex (intSizeOf x) w+-- | Convert a CV to an SMTLib2 compliant value+cvToSMTLib :: RoundingMode -> CV -> String+cvToSMTLib rm x+  | isBoolean       x, CInteger  w      <- cvVal x = if w == 0 then "false" else "true"+  | isUninterpreted x, CUserSort (_, s) <- cvVal x = roundModeConvert s+  | isReal          x, CAlgReal  r      <- cvVal x = algRealToSMTLib2 r+  | isFloat         x, CFloat    f      <- cvVal x = showSMTFloat  rm f+  | isDouble        x, CDouble   d      <- cvVal x = showSMTDouble rm d+  | not (isBounded x), CInteger  w      <- cvVal x = if w >= 0 then show w else "(- " ++ show (abs w) ++ ")"+  | not (hasSign x)  , CInteger  w      <- cvVal x = smtLibHex (intSizeOf x) w   -- signed numbers (with 2's complement representation) is problematic   -- since there's no way to put a bvneg over a positive number to get minBound..   -- Hence, we punt and use binary notation in that particular case-  | hasSign x        , CWInteger  w      <- cwVal x = if w == negate (2 ^ intSizeOf x)-                                                      then mkMinBound (intSizeOf x)-                                                      else negIf (w < 0) $ smtLibHex (intSizeOf x) (abs w)-  | isChar x         , CWChar c          <- cwVal x = smtLibHex 8 (fromIntegral (ord c))-  | isString x       , CWString s        <- cwVal x = '\"' : stringToQFS s ++ "\""-  | isList x         , CWList xs         <- cwVal x = smtLibSeq (kindOf x) xs-  | True = error $ "SBV.cvtCW: Impossible happened: Kind/Value disagreement on: " ++ show (kindOf x, x)+  | hasSign x        , CInteger  w      <- cvVal x = if w == negate (2 ^ intSizeOf x)+                                                     then mkMinBound (intSizeOf x)+                                                     else negIf (w < 0) $ smtLibHex (intSizeOf x) (abs w)+  | isChar x         , CChar c          <- cvVal x = smtLibHex 8 (fromIntegral (ord c))+  | isString x       , CString s        <- cvVal x = '\"' : stringToQFS s ++ "\""+  | isList x         , CList xs         <- cvVal x = smtLibSeq (kindOf x) xs+  | isTuple x        , CTuple xs        <- cvVal x = smtLibTup (kindOf x) xs++  | True = error $ "SBV.cvtCV: Impossible happened: Kind/Value disagreement on: " ++ show (kindOf x, x)   where roundModeConvert s = fromMaybe s (listToMaybe [smtRoundingMode m | m <- [minBound .. maxBound] :: [RoundingMode], show m == s])         -- Carefully code hex numbers, SMTLib is picky about lengths of hex constants. For the time         -- being, SBV only supports sizes that are multiples of 4, but the below code is more robust@@ -325,21 +325,26 @@         negIf True  a = "(bvneg " ++ a ++ ")"         negIf False a = a -        smtLibSeq :: Kind -> [CWVal] -> String+        smtLibSeq :: Kind -> [CVal] -> String         smtLibSeq k          [] = "(as seq.empty " ++ smtType k ++ ")"         smtLibSeq (KList ek) xs = let mkSeq  [e]   = e                                       mkSeq  es    = "(seq.++ " ++ unwords es ++ ")"                                       mkUnit inner = "(seq.unit " ++ inner ++ ")"-                                  in mkSeq (mkUnit . cwToSMTLib rm . CW ek <$> xs)-        smtLibSeq k _ = error "SBV.cwToSMTLib: Impossible case (smtLibSeq), received kind: " ++ show k+                                  in mkSeq (mkUnit . cvToSMTLib rm . CV ek <$> xs)+        smtLibSeq k _ = error "SBV.cvToSMTLib: Impossible case (smtLibSeq), received kind: " ++ show k -        -- anamoly at the 2's complement min value! Have to use binary notation here+        smtLibTup :: Kind -> [CVal] -> String+        smtLibTup (KTuple []) _  = "SBVTuple0"+        smtLibTup (KTuple ks) xs = "(mkSBVTuple" ++ show (length ks) ++ " " ++ unwords (zipWith (\ek e -> cvToSMTLib rm (CV ek e)) ks xs) ++ ")"+        smtLibTup k           _  = error $ "SBV.cvToSMTLib: Impossible case (smtLibTup), received kind: " ++ show k++        -- anomaly at the 2's complement min value! Have to use binary notation here         -- as there is no positive value we can provide to make the bvneg work.. (see above)         mkMinBound :: Int -> String         mkMinBound i = "#b1" ++ replicate (i-1) '0'  -- | Create a skolem 0 for the kind mkSkolemZero :: RoundingMode -> Kind -> String-mkSkolemZero _ (KUserSort _ (Right (f:_))) = f-mkSkolemZero _ (KUserSort s _)             = error $ "SBV.mkSkolemZero: Unexpected uninterpreted sort: " ++ s-mkSkolemZero rm k                          = cwToSMTLib rm (mkConstCW k (0::Integer))+mkSkolemZero _ (KUninterpreted _ (Right (f:_))) = f+mkSkolemZero _ (KUninterpreted s _)             = error $ "SBV.mkSkolemZero: Unexpected uninterpreted sort: " ++ s+mkSkolemZero rm k                               = cvToSMTLib rm (mkConstCV k (0::Integer))
Data/SBV/Utils/SExpr.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Utils.SExpr--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Utils.SExpr+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Parsing of S-expressions (mainly used for parsing SMT-Lib get-value output) -----------------------------------------------------------------------------
Data/SBV/Utils/TDiff.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Data.SBV.Utils.TDiff--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Data.SBV.Utils.TDiff+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Runs an IO computation printing the time it took to run it -----------------------------------------------------------------------------
Documentation/SBV/Examples/BitPrecise/BitTricks.hs view
@@ -1,15 +1,17 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.BitPrecise.BitTricks--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.BitPrecise.BitTricks+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Checks the correctness of a few tricks from the large collection found in: --      <http://graphics.stanford.edu/~seander/bithacks.html> ----------------------------------------------------------------------------- +{-# LANGUAGE FlexibleContexts #-}+ module Documentation.SBV.Examples.BitPrecise.BitTricks where  import Data.SBV@@ -29,7 +31,7 @@ -- | Formalizes <http://graphics.stanford.edu/~seander/bithacks.html#DetectOppositeSigns> oppositeSignsCorrect :: SInt32 -> SInt32 -> SBool oppositeSignsCorrect x y = r .== os-  where r  = (x .< 0 &&& y .>= 0) ||| (x .>= 0 &&& y .< 0)+  where r  = (x .< 0 .&& y .>= 0) .|| (x .>= 0 .&& y .< 0)         os = (x `xor` y) .< 0  -- | Formalizes <http://graphics.stanford.edu/~seander/bithacks.html#ConditionalSetOrClearBitsWithoutBranching>@@ -41,10 +43,10 @@ -- | Formalizes <http://graphics.stanford.edu/~seander/bithacks.html#DetermineIfPowerOf2> powerOfTwoCorrect :: SWord32 -> SBool powerOfTwoCorrect v = f .== s-  where f = (v ./= 0) &&& ((v .&. (v-1)) .== 0);+  where f = (v ./= 0) .&& ((v .&. (v-1)) .== 0);         powers :: [Word32]         powers = map ((2::Word32)^) [(0::Word32) .. 31]-        s = bAny (v .==) $ map literal powers+        s = sAny (v .==) $ map literal powers  -- | Collection of queries queries :: IO ()
Documentation/SBV/Examples/BitPrecise/BrokenSearch.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.BitPrecise.BrokenSearch--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.BitPrecise.BrokenSearch+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The classic "binary-searches are broken" example: --     <http://ai.googleblog.com/2006/06/extra-extra-read-all-about-it-nearly.html>@@ -20,13 +20,13 @@ -- -- >>> checkArithOverflow midPointBroken -- Documentation/SBV/Examples/BitPrecise/BrokenSearch.hs:33:28:+!: SInt32 addition overflows: Violated. Model:---   low  = 2147483647 :: Int32---   high = 2147483647 :: Int32+--   low  = 1073741824 :: Int32+--   high = 1073742336 :: Int32 -- -- Indeed: ----- >>> (2147483647 + 2147483647) `div` (2::Int32)--- -1+-- >>> (1073741824 + 1073742336) `div` (2::Int32)+-- -1073741568 -- -- giving us a negative mid-point value! midPointBroken :: SInt32 -> SInt32 -> SInt32
Documentation/SBV/Examples/BitPrecise/Legato.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.BitPrecise.Legato--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.BitPrecise.Legato+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- An encoding and correctness proof of Legato's multiplier in Haskell. Bill Legato came -- up with an interesting way to multiply two 8-bit numbers on Mostek, as described here:@@ -31,8 +31,8 @@ -- is indeed correct. ----------------------------------------------------------------------------- -{-# LANGUAGE DeriveGeneric  #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}  module Documentation.SBV.Examples.BitPrecise.Legato where @@ -125,7 +125,7 @@ -- by this function. Note that we verify the correctness of this check -- separately below in `checkOverflowCorrect`. checkOverflow :: SWord8 -> SWord8 -> SBool -> SBool-checkOverflow x y c = s .< x ||| s .< y ||| s' .< s+checkOverflow x y c = s .< x .|| s .< y .|| s' .< s   where s  = x + y         s' = s + ite c 1 0 @@ -159,7 +159,7 @@  -- | CLC: Clear the carry flag clc :: Instruction-clc k = k . setFlag FlagC false+clc k = k . setFlag FlagC sFalse  -- | ROR, memory version: Rotate the value at memory location @a@ -- to the right by 1 bit, using the carry flag as a transfer position.@@ -182,9 +182,9 @@         v' = setBitTo (v `rotateR` 1) 7 c         c' = sTestBit v 0 --- | BCC: branch to label @l@ if the carry flag is false+-- | BCC: branch to label @l@ if the carry flag is sFalse bcc :: Program -> Instruction-bcc l k m = ite (c .== false) (l m) (k m)+bcc l k m = ite (c .== sFalse) (l m) (k m)   where c = getFlag FlagC m  -- | ADC: Increment the value of register @A@ by the value of memory contents@@ -202,9 +202,9 @@ dex k m = k . setFlag FlagZ (x .== 0) . setReg RegX x $ m   where x = getReg RegX m - 1 --- | BNE: Branch if the zero-flag is false+-- | BNE: Branch if the zero-flag is sFalse bne :: Program -> Instruction-bne l k m = ite (z .== false) (l m) (k m)+bne l k m = ite (z .== sFalse) (l m) (k m)   where z = getFlag FlagZ m  -- | The 'end' combinator "stops" our program, providing the final continuation@@ -303,7 +303,7 @@ legatoInC = compileToC Nothing "runLegato" $ do                 x <- cgInput "x"                 y <- cgInput "y"-                let (hi, lo) = runLegato (initMachine (x, y, 0, 0, 0, false, false))+                let (hi, lo) = runLegato (initMachine (x, y, 0, 0, 0, sFalse, sFalse))                 cgOutput "hi" hi                 cgOutput "lo" lo
Documentation/SBV/Examples/BitPrecise/MergeSort.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.BitPrecise.MergeSort--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.BitPrecise.MergeSort+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Symbolic implementation of merge-sort and its correctness. -----------------------------------------------------------------------------@@ -50,23 +50,23 @@  -- | Check whether a given sequence is non-decreasing. nonDecreasing :: [E] -> SBool-nonDecreasing []       = true-nonDecreasing [_]      = true-nonDecreasing (a:b:xs) = a .<= b &&& nonDecreasing (b:xs)+nonDecreasing []       = sTrue+nonDecreasing [_]      = sTrue+nonDecreasing (a:b:xs) = a .<= b .&& nonDecreasing (b:xs)  -- | Check whether two given sequences are permutations. We simply check that each sequence -- is a subset of the other, when considered as a set. The check is slightly complicated -- for the need to account for possibly duplicated elements. isPermutationOf :: [E] -> [E] -> SBool-isPermutationOf as bs = go as (zip bs (repeat true)) &&& go bs (zip as (repeat true))-  where go []     _  = true-        go (x:xs) ys = let (found, ys') = mark x ys in found &&& go xs ys'+isPermutationOf as bs = go as (zip bs (repeat sTrue)) .&& go bs (zip as (repeat sTrue))+  where go []     _  = sTrue+        go (x:xs) ys = let (found, ys') = mark x ys in found .&& go xs ys'         -- Go and mark off an instance of 'x' in the list, if possible. We keep track         -- of unmarked elements by associating a boolean bit. Note that we have to         -- keep the lists equal size for the recursive result to merge properly.-        mark _ []         = (false, [])-        mark x ((y,v):ys) = ite (v &&& x .== y)-                                (true, (y, bnot v):ys)+        mark _ []         = (sFalse, [])+        mark x ((y,v):ys) = ite (v .&& x .== y)+                                (sTrue, (y, sNot v):ys)                                 (let (r, ys') = mark x ys in (r, (y,v):ys'))  -- | Asserting correctness of merge-sort for a list of the given size. Note that we can@@ -79,7 +79,7 @@ correctness :: Int -> IO ThmResult correctness n = prove $ do xs <- mkFreeVars n                            let ys = mergeSort xs-                           return $ nonDecreasing ys &&& isPermutationOf xs ys+                           return $ nonDecreasing ys .&& isPermutationOf xs ys  ----------------------------------------------------------------------------- -- * Generating C code
Documentation/SBV/Examples/BitPrecise/MultMask.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.BitPrecise.MultMask--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.BitPrecise.MultMask+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- An SBV solution to the bit-precise puzzle of shuffling the bits in a -- 64-bit word in a custom order. The idea is to take a 64-bit value:
Documentation/SBV/Examples/BitPrecise/PrefixSum.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.BitPrecise.PrefixSum--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.BitPrecise.PrefixSum+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The PrefixSum algorithm over power-lists and proof of -- the Ladner-Fischer implementation.
Documentation/SBV/Examples/CodeGeneration/AddSub.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.CodeGeneration.AddSub--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.CodeGeneration.AddSub+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Simple code generation example. -----------------------------------------------------------------------------
Documentation/SBV/Examples/CodeGeneration/CRC_USB5.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.CodeGeneration.CRC_USB5--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.CodeGeneration.CRC_USB5+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Computing the CRC symbolically, using the USB polynomial. We also -- generating C code for it as well. This example demonstrates the
Documentation/SBV/Examples/CodeGeneration/Fibonacci.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.CodeGeneration.Fibonacci--- Copyright   :  (c) Lee Pike, Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.CodeGeneration.Fibonacci+-- Author    : Lee Pike, Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Computing Fibonacci numbers and generating C code. Inspired by Lee Pike's -- original implementation, modified for inclusion in the package. It illustrates@@ -35,7 +35,7 @@ -- after a certain number of unrollings, but this would be quite expensive to -- implement, and would be impractical.) fib0 :: SWord64 -> SWord64-fib0 n = ite (n .== 0 ||| n .== 1)+fib0 n = ite (n .== 0 .|| n .== 1)              n              (fib0 (n-1) + fib0 (n-2)) @@ -64,7 +64,7 @@ fib1 :: SWord64 -> SWord64 -> SWord64 fib1 top n = fib' 0 1 0   where fib' :: SWord64 -> SWord64 -> SWord64 -> SWord64-        fib' prev' prev m = ite (m .== top ||| m .== n)          -- did we reach recursion depth, or the index we're looking for+        fib' prev' prev m = ite (m .== top .|| m .== n)          -- did we reach recursion depth, or the index we're looking for                                 prev'                            -- stop and return the result                                 (fib' prev (prev' + prev) (m+1)) -- otherwise recurse
Documentation/SBV/Examples/CodeGeneration/GCD.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.CodeGeneration.GCD--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.CodeGeneration.GCD+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Computing GCD symbolically, and generating C code for it. This example -- illustrates symbolic termination related issues when programming with@@ -33,7 +33,7 @@ sgcd :: SWord8 -> SWord8 -> SWord8 sgcd a b = go a b 12   where go :: SWord8 -> SWord8 -> SWord8 -> SWord8-        go x y c = ite (c .== 0 ||| y .== 0)   -- stop if y is 0, or if we reach the recursion depth+        go x y c = ite (c .== 0 .|| y .== 0)   -- stop if y is 0, or if we reach the recursion depth                        x                        (go y y' (c-1))           where (_, y') = x `sQuotRem` y@@ -55,10 +55,10 @@ sgcdIsCorrect :: SWord8 -> SWord8 -> SWord8 -> SBool sgcdIsCorrect x y k = ite (y  .== 0)                        -- if y is 0                           (k' .== x)                        -- then k' must be x, nothing else to prove by definition-                          (isCommonDivisor k'  &&&          -- otherwise, k' is a common divisor and-                          (isCommonDivisor k ==> k' .>= k)) -- if k is a common divisor as well, then k' is at least as large as k+                          (isCommonDivisor k'  .&&          -- otherwise, k' is a common divisor and+                          (isCommonDivisor k .=> k' .>= k)) -- if k is a common divisor as well, then k' is at least as large as k   where k' = sgcd x y-        isCommonDivisor a = z1 .== 0 &&& z2 .== 0+        isCommonDivisor a = z1 .== 0 .&& z2 .== 0            where (_, z1) = x `sQuotRem` a                  (_, z2) = y `sQuotRem` a
Documentation/SBV/Examples/CodeGeneration/PopulationCount.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.CodeGeneration.PopulationCount--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.CodeGeneration.PopulationCount+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Computing population-counts (number of set bits) and automatically -- generating C code.
Documentation/SBV/Examples/CodeGeneration/Uninterpreted.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.CodeGeneration.Uninterpreted--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.CodeGeneration.Uninterpreted+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates the use of uninterpreted functions for the purposes of -- code generation. This facility is important when we want to take
Documentation/SBV/Examples/Crypto/AES.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Crypto.AES--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Crypto.AES+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- An implementation of AES (Advanced Encryption Standard), using SBV. -- For details on AES, see <http://en.wikipedia.org/wiki/Advanced_Encryption_Standard>.@@ -66,7 +66,7 @@ -- turns out that raising to the 254 power gives us the multiplicative inverse. -- Of course, we can prove this using SBV: ----- >>> prove $ \x -> x ./= 0 ==> x `gf28Mult` gf28Inverse x .== 1+-- >>> prove $ \x -> x ./= 0 .=> x `gf28Mult` gf28Inverse x .== 1 -- Q.E.D. -- -- Note that we exclude @0@ in our theorem, as it does not have a@@ -207,7 +207,7 @@ -- Q.E.D. -- sboxInverseCorrect :: GF28 -> SBool-sboxInverseCorrect x = unSBox (sbox x) .== x &&& sbox (unSBox x) .== x+sboxInverseCorrect x = unSBox (sbox x) .== x .&& sbox (unSBox x) .== x  ----------------------------------------------------------------------------- -- ** AddRoundKey transformation@@ -585,7 +585,7 @@  -------------------------------------------------------------------------------------------- -- | For doctest purposes only-hex8 :: (SymWord a, Show a, Integral a) => SBV a -> String+hex8 :: (SymVal a, Show a, Integral a) => SBV a -> String hex8 v = replicate (8 - length s) '0' ++ s   where s = flip showHex "" . fromJust . unliteral $ v
Documentation/SBV/Examples/Crypto/RC4.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Crypto.RC4--- Copyright   :  (c) Austin Seipp--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Crypto.RC4+-- Author    : Austin Seipp+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- An implementation of RC4 (AKA Rivest Cipher 4 or Alleged RC4/ARC4), -- using SBV. For information on RC4, see: <http://en.wikipedia.org/wiki/RC4>.@@ -148,6 +148,6 @@  -------------------------------------------------------------------------------------------- -- | For doctest purposes only-hex2 :: (SymWord a, Show a, Integral a) => SBV a -> String+hex2 :: (SymVal a, Show a, Integral a) => SBV a -> String hex2 v = replicate (2 - length s) '0' ++ s   where s = flip showHex "" . fromJust . unliteral $ v
Documentation/SBV/Examples/Existentials/CRCPolynomial.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Existentials.CRCPolynomial--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Existentials.CRCPolynomial+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- This program demonstrates the use of the existentials and the QBVF (quantified -- bit-vector solver). We generate CRC polynomials of degree 16 that can be used@@ -38,7 +38,7 @@   where bits1   = blastBE h1 ++ blastBE l1 ++ crc1         bits2   = blastBE h2 ++ blastBE l2 ++ crc2         -- xor will give us a false if bits match, true if they differ-        xorBits = zipWith (<+>) bits1 bits2+        xorBits = zipWith (.<+>) bits1 bits2         count []     = 0         count (b:bs) = let r = count bs in ite b (1+r) r @@ -50,7 +50,7 @@ -- more than @hd@ bits. crcGood :: SWord8 -> SWord16 -> SWord48 -> SWord48 -> SBool crcGood hd poly sent received =-     sent ./= received ==> diffCount (sent, crcSent) (received, crcReceived) .>= hd+     sent ./= received .=> diffCount (sent, crcSent) (received, crcReceived) .>= hd    where crcSent     = crc_48_16 sent     poly          crcReceived = crc_48_16 received poly @@ -72,7 +72,7 @@                         -- the least significant bit must be set in the                         -- polynomial, as all CRC polynomials have the "+1"                         -- term in them set. This simplifies the query.-                        return $ sTestBit p 0 &&& crcGood hd p s r+                        return $ sTestBit p 0 .&& crcGood hd p s r                 cnt <- displayModels disp res                 putStrLn $ "Found: " ++ show cnt ++ " polynomail(s)."         where disp :: Int -> (Bool, Word16) -> IO ()
Documentation/SBV/Examples/Existentials/Diophantine.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Existentials.Diophantine--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Existentials.Diophantine+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Finding minimal natural number solutions to linear Diophantine equations, -- using explicit quantification.@@ -57,12 +57,13 @@                  -- Tell the solver to use this logic!                  setLogic AUFLIA -                 return $ ok as &&& (ok bs ==> as .== bs ||| bnot (bs `less` as))+                 return $ ok as .&& (ok bs .=> as .== bs .|| sNot (bs `less` as))         n = if null m then 0 else length (head m) -       ok xs = bAny (.> 0) xs &&& bAll (.>= 0) xs &&& bAnd [sum (zipWith (*) r xs) .== 0 | r <- m]-       as `less` bs = bAnd (zipWith (.<=) as bs) &&& bOr (zipWith (.<) as bs)+       ok xs = sAny (.> 0) xs .&& sAll (.>= 0) xs .&& sAnd [sum (zipWith (*) r xs) .== 0 | r <- m]++       as `less` bs = sAnd (zipWith (.<=) as bs) .&& sOr (zipWith (.<) as bs)  -------------------------------------------------------------------------------------------------- -- * Examples
Documentation/SBV/Examples/Lists/BoundedMutex.hs view
@@ -1,21 +1,21 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Lists.BoundedMutex--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Lists.BoundedMutex+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates use of bounded list utilities, proving a simple -- mutex algorithm correct up to given bounds. ----------------------------------------------------------------------------- -{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE DeriveAnyClass      #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}  module Documentation.SBV.Examples.Lists.BoundedMutex where @@ -23,8 +23,8 @@ import Data.SBV.Control  import Data.SBV.List ((.!!))-import qualified Data.SBV.List         as L-import qualified Data.SBV.List.Bounded as L+import qualified Data.SBV.List              as L+import qualified Data.SBV.Tools.BoundedList as L  -- | Each agent can be in one of the three states data State = Idle     -- ^ Regular work@@ -52,7 +52,7 @@ -- | A bounded mutex property holds for two sequences of state transitions, if they are not in -- their critical section at the same time up to that given bound. mutex :: Int -> SList State -> SList State -> SBool-mutex i p1s p2s = L.band i $ L.bzipWith i (\p1 p2 -> p1 ./= critical ||| p2 ./= critical) p1s p2s+mutex i p1s p2s = L.band i $ L.bzipWith i (\p1 p2 -> p1 ./= critical .|| p2 ./= critical) p1s p2s  -- | A sequence is valid upto a bound if it starts at 'Idle', and follows the mutex rules. That is: --@@ -62,32 +62,32 @@ -- -- The variable @me@ identifies the agent id. validSequence :: Int -> Integer -> SList Integer -> SList State -> SBool-validSequence b me pturns proc = bAnd [ L.length proc .== fromIntegral b+validSequence b me pturns proc = sAnd [ L.length proc .== fromIntegral b                                       , idle .== L.head proc                                       , check b pturns proc idle                                       ]-   where check 0 _  _  _    = true+   where check 0 _  _  _    = sTrue          check i ts ps prev = let (cur,  rest)  = L.uncons ps                                   (turn, turns) = L.uncons ts                                   ok   = ite (prev .== idle)                          (cur `sElem` [idle, ready])-                                       $ ite (prev .== ready &&& turn .== literal me) (cur `sElem` [critical])+                                       $ ite (prev .== ready .&& turn .== literal me) (cur `sElem` [critical])                                        $ ite (prev .== critical)                      (cur `sElem` [critical, idle])                                        $                                              (cur `sElem` [prev])-                              in ok &&& check (i-1) turns rest cur+                              in ok .&& check (i-1) turns rest cur  -- | The mutex algorithm, coded implicity as an assignment to turns. Turns start at @1@, and at each stage is either -- @1@ or @2@; giving preference to that process. The only condition is that if either process is in its critical -- section, then the turn value stays the same. Note that this is sufficient to satisfy safety (i.e., mutual -- exclusion), though it does not guarantee liveness. validTurns :: Int -> SList Integer -> SList State -> SList State -> SBool-validTurns b turns process1 process2 = bAnd [ L.length turns .== fromIntegral b+validTurns b turns process1 process2 = sAnd [ L.length turns .== fromIntegral b                                             , 1 .== L.head turns                                             , check b turns process1 process2 1                                             ]-   where check 0 _  _     _     _    = true+   where check 0 _  _     _     _    = sTrue          check i ts proc1 proc2 prev =   cur `sElem` [1, 2]-                                     &&& (p1 .== critical ||| p2 .== critical ==> cur .== prev)-                                     &&& check (i-1) rest p1s p2s cur+                                     .&& (p1 .== critical .|| p2 .== critical .=> cur .== prev)+                                     .&& check (i-1) rest p1s p2s cur             where (cur, rest) = L.uncons ts                   (p1,  p1s)  = L.uncons proc1                   (p2,  p2s)  = L.uncons proc2@@ -111,7 +111,7 @@                    -- Try to assert that mutex does not hold. If we get a                   -- counter example, we would've found a violation!-                  constrain $ bnot $ mutex b p1 p2+                  constrain $ sNot $ mutex b p1 p2                    query $ do cs <- checkSat                              case cs of@@ -158,7 +158,7 @@                          -- Find a trace where p2 never goes critical                         -- counter example, we would've found a violation!-                        constrain $ bnot $ L.belem b critical p2+                        constrain $ sNot $ L.belem b critical p2                          query $ do cs <- checkSat                                    case cs of
Documentation/SBV/Examples/Lists/Fibonacci.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Lists.Fibonacci--- Copyright   :  (c) Joel Burget--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Lists.Fibonacci+-- Author    : Joel Burget+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Define the fibonacci sequence as an SBV symbolic list. -----------------------------------------------------------------------------
Documentation/SBV/Examples/Lists/Nested.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Lists.Nested--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Lists.Nested+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates nested lists -----------------------------------------------------------------------------
Documentation/SBV/Examples/Misc/Auxiliary.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Misc.Auxiliary--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Misc.Auxiliary+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates model construction with auxiliary variables. Sometimes we -- need to introduce a variable in our problem as an existential variable,
Documentation/SBV/Examples/Misc/Enumerate.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Misc.Enumerate--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Misc.Enumerate+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates how enumerations can be translated to their SMT-Lib -- counterparts, without losing any information content. Also see@@ -12,11 +12,11 @@ -- example involving enumerations. ----------------------------------------------------------------------------- -{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE DeriveAnyClass      #-}+{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}  module Documentation.SBV.Examples.Misc.Enumerate where
Documentation/SBV/Examples/Misc/Floating.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Misc.Floating--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Misc.Floating+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Several examples involving IEEE-754 floating point numbers, i.e., single -- precision 'Float' ('SFloat') and double precision 'Double' ('SDouble') types.
Documentation/SBV/Examples/Misc/ModelExtract.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Misc.ModelExtract--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Misc.ModelExtract+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates use of programmatic model extraction. When programming with -- SBV, we typically use `sat`/`allSat` calls to compute models automatically.
Documentation/SBV/Examples/Misc/NoDiv0.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Misc.NoDiv0--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Misc.NoDiv0+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates SBV's assertion checking facilities -----------------------------------------------------------------------------
Documentation/SBV/Examples/Misc/Polynomials.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Misc.Polynomials--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Misc.Polynomials+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Simple usage of polynomials over GF(2^n), using Rijndael's -- finite field: <http://en.wikipedia.org/wiki/Finite_field_arithmetic#Rijndael.27s_finite_field>
Documentation/SBV/Examples/Misc/SoftConstrain.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Misc.SoftConstrain--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Misc.SoftConstrain+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates soft-constraints, i.e., those that the solver -- is free to leave unsatisfied. Solvers will try to satisfy@@ -42,4 +42,4 @@                    softConstrain $ x .== "default-x-value"                    softConstrain $ y .== "default-y-value" -                   return (true :: SBool)+                   return sTrue
+ Documentation/SBV/Examples/Misc/Tuple.hs view
@@ -0,0 +1,75 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Documentation.SBV.Examples.Misc.Tuple+-- Author    : Joel Burget, Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- A basic tuple use case, also demonstrating regular expressions,+-- strings, etc. This is a basic template for getting SBV to produce+-- valid data for applications that require inputs that satisfy+-- arbitrary criteria.+-----------------------------------------------------------------------------++{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Documentation.SBV.Examples.Misc.Tuple where++import Data.SBV+import Data.SBV.Tuple+import Data.SBV.Control++import Data.SBV.List   ((.!!))+import Data.SBV.RegExp++import qualified Data.SBV.String as S+import qualified Data.SBV.List   as L++-- | A dictionary is a list of lookup values. Note that we+-- store the type @[(a, b)]@ as a symbolic value here, mixing+-- sequences and tuples.+type Dict a b = SBV [(a, b)]++-- | Create a dictionary of length 5, such that each element+-- has an string key and each value is the length of the key.+-- We impose a few more constraints to make the output interesting. +-- For instance, you might get:+--+-- @ ghci> example+-- [("nt_",3),("dHAk",4),("kzkk0",5),("mZxs9s",6),("c32'dPM",7)]+-- @+--+-- Depending on your version of z3, a different answer might be provided.+-- Here, we check that it satisfies our length conditions:+--+-- >>> import Data.List (genericLength)+-- >>> example >>= \ex -> return (length ex == 5 && all (\(l, i) -> genericLength l == i) ex)+-- True+example :: IO [(String, Integer)]+example = runSMT $ do dict :: Dict String Integer <- free "dict"++                      -- require precisely 5 elements+                      let len   = 5 :: Int+                          range = [0 .. len - 1]++                      constrain $ L.length dict .== fromIntegral len++                      -- require each key to be at of length 3 more than the index it occupies+                      -- and look like an identifier+                      let goodKey i s = let l = S.length s+                                            r = asciiLower * KStar (asciiLetter + digit + "_" + "'")+                                      in l .== fromIntegral i+3 .&& s `match` r++                          restrict i = case untuple (dict .!! fromIntegral i) of+                                         (k, v) -> constrain $ goodKey i k .&& v .== S.length k++                      mapM_ restrict range++                      -- require distinct keys:+                      let keys = [(dict .!! fromIntegral i)^._1 | i <- range]+                      constrain $ distinct keys++                      query $ do ensureSat+                                 getValue dict
Documentation/SBV/Examples/Misc/Word4.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Misc.Enumerate--- Copyright   :  (c) Brian Huffman--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Misc.Word4+-- Author    : Brian Huffman+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates how new sizes of word/int types can be defined and -- used with SBV.@@ -109,11 +109,11 @@ -- | SWord4 type synonym type SWord4 = SBV Word4 --- | SymWord instance, allowing this type to be used in proofs/sat etc.-instance SymWord Word4 where-  mkSymWord  = genMkSymVar (KBounded False 4)-  literal    = genLiteral  (KBounded False 4)-  fromCW     = genFromCW+-- | SymVal instance, allowing this type to be used in proofs/sat etc.+instance SymVal Word4 where+  mkSymVal = genMkSymVar (KBounded False 4)+  literal  = genLiteral  (KBounded False 4)+  fromCV   = genFromCV  -- | HasKind instance; simply returning the underlying kind for the type instance HasKind Word4 where@@ -121,7 +121,7 @@  -- | SatModel instance, merely uses the generic parsing method. instance SatModel Word4 where-  parseCWs = genParse (KBounded False 4)+  parseCVs = genParse (KBounded False 4)  -- | SDvisible instance, using 0-extension instance SDivisible Word4 where
Documentation/SBV/Examples/Optimization/ExtField.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Optimization.ExtField--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Optimization.ExtField+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates the extension field (@oo@/@epsilon@) optimization results. -----------------------------------------------------------------------------@@ -39,7 +39,7 @@               maximize "one-x" $ 1 - x -             constrain $ y .> 0 &&& z .> 5+             constrain $ y .> 0 .&& z .> 5              minimize "min_y" $ 2+y+z               minimize "min_z" z
Documentation/SBV/Examples/Optimization/LinearOpt.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Optimization.LinearOpt--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Optimization.LinearOpt+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Simple linear optimization example, as found in operations research texts. -----------------------------------------------------------------------------
Documentation/SBV/Examples/Optimization/Production.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Optimization.Production--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Optimization.Production+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Solves a simple linear optimization problem -----------------------------------------------------------------------------
Documentation/SBV/Examples/Optimization/VM.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Optimization.VM--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Optimization.VM+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Solves a VM allocation problem using optimization features -----------------------------------------------------------------------------@@ -67,9 +67,9 @@     constrain $ capacity3 .<= 200      -- compute #of servers running:-    let y1 = bOr [x11, x21, x31]-        y2 = bOr [x12, x22, x32]-        y3 = bOr [x13, x23, x33]+    let y1 = sOr [x11, x21, x31]+        y2 = sOr [x12, x22, x32]+        y3 = sOr [x13, x23, x33]          b2n b = ite b 1 0
+ Documentation/SBV/Examples/ProofTools/BMC.hs view
@@ -0,0 +1,118 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Documentation.SBV.Examples.ProofTools.BMC+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- A BMC example, showing how traditional state-transition reachability+-- problems can be coded using SBV, using bounded model checking.+--+-- We imagine a system with two integer variables, @x@ and @y@. At each+-- iteration, we can either increment @x@ by @2@, or decrement @y@ by @4@.+--+-- Can we reach a state where @x@ and @y@ are the same starting from @x=0@+-- and @y=10@?+--+-- What if @y@ starts at @11@?+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}++module Documentation.SBV.Examples.ProofTools.BMC where++import Data.SBV+import Data.SBV.Tools.BMC+import Data.SBV.Control++-- * System state++-- | System state, containing the two integers.+data S a = S { x :: a, y :: a }++-- | Show the state as a pair+instance Show a => Show (S a) where+  show S{x, y} = show (x, y)++-- | Symbolic equality for @S@.+instance EqSymbolic a => EqSymbolic (S a) where+   S {x = x1, y = y1} .== S {x = x2, y = y2} = x1 .== x2 .&& y1 .== y2++-- | Queriable instance for our state+instance Queriable IO (S SInteger) (S Integer) where+  fresh           = S <$> freshVar_  <*> freshVar_+  extract S{x, y} = S <$> getValue x <*> getValue y++-- * Encoding the problem++-- | We parameterize over the initial state for different variations.+problem :: Int -> (S SInteger -> SBool) -> IO (Either String (Int, [S Integer]))+problem lim initial = bmc (Just lim) True setup initial trans goal+  where+        -- This is where we would put solver options, typically via+        -- calls to 'Data.SBV.setOption'. We do not need any for this problem,+        -- so we simply do nothing.+        setup :: Symbolic ()+        setup = return ()++        -- Transition relation: At each step we either+        -- get to increase @x@ by 2, or decrement @y@ by 4:+        trans :: S SInteger -> [S SInteger]+        trans S{x, y} = [ S { x = x + 2, y = y     }+                        , S { x = x,     y = y - 4 }+                        ]++        -- Goal state is when @x@ equals @y@:+        goal :: S SInteger -> SBool+        goal S{x, y} = x .== y++-- * Examples++-- | Example 1: We start from @x=0@, @y=10@, and search up to depth @10@. We have:+--+-- >>> ex1+-- BMC: Iteration: 0+-- BMC: Iteration: 1+-- BMC: Iteration: 2+-- BMC: Iteration: 3+-- BMC: Solution found at iteration 3+-- Right (3,[(0,10),(0,6),(0,2),(2,2)])+--+-- As expected, there's a solution in this case. Furthermore, since the BMC engine+-- found a solution at depth @3@, we also know that there is no solution at+-- depths @0@, @1@, or @2@; i.e., this is "a" shortest solution. (That is,+-- it may not be unique, but there isn't a shorter sequence to get us to+-- our goal.)+ex1 :: IO (Either String (Int, [S Integer]))+ex1 = problem 10 isInitial+  where isInitial :: S SInteger -> SBool+        isInitial S{x, y} = x .== 0 .&& y .== 10++-- | Example 2: We start from @x=0@, @y=11@, and search up to depth @10@. We have:+--+-- >>> ex2+-- BMC: Iteration: 0+-- BMC: Iteration: 1+-- BMC: Iteration: 2+-- BMC: Iteration: 3+-- BMC: Iteration: 4+-- BMC: Iteration: 5+-- BMC: Iteration: 6+-- BMC: Iteration: 7+-- BMC: Iteration: 8+-- BMC: Iteration: 9+-- Left "BMC limit of 10 reached"+--+-- As expected, there's no solution in this case. While SBV (and BMC) cannot establish+-- that there is no solution at a larger depth, you can see that this will never be the+-- case: In each step we do not change the parity of either variable. That is, @x@+-- will remain even, and @y@ will remain odd. So, there will never be a solution at+-- any depth. This isn't the only way to see this result of course, but the point+-- remains that BMC is just not capable of establishing inductive facts.+ex2 :: IO (Either String (Int, [S Integer]))+ex2 = problem 10 isInitial+  where isInitial :: S SInteger -> SBool+        isInitial S{x, y} = x .== 0 .&& y .== 11
+ Documentation/SBV/Examples/ProofTools/Fibonacci.hs view
@@ -0,0 +1,111 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Documentation.SBV.Examples.ProofTools.Fibonacci+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Example inductive proof to show partial correctness of the for-loop+-- based fibonacci algorithm:+--+-- @+--     i = 0+--     k = 1+--     m = 0+--     while i < n:+--        m, k = k, m + k+--        i+++-- @+--+-- We do the proof against an axiomatized fibonacci implementation using an+-- uninterpreted function.+-----------------------------------------------------------------------------++{-# LANGUAGE DeriveAnyClass        #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}++module Documentation.SBV.Examples.ProofTools.Fibonacci where++import Data.SBV+import Data.SBV.Tools.Induction+import Data.SBV.Control++import GHC.Generics hiding (S)++-- * System state++-- | System state. We simply have two components, parameterized+-- over the type so we can put in both concrete and symbolic values.+data S a = S { i :: a, k :: a, m :: a, n :: a }+         deriving (Show, Mergeable, Generic)++-- | Make our state queriable+instance Queriable IO (S SInteger) (S Integer) where+   fresh = S <$> freshVar_ <*> freshVar_ <*> freshVar_ <*> freshVar_+   extract S{i, k, m, n} = S <$> getValue i <*> getValue k <*> getValue m <*> getValue n++-- | Encoding partial correctness of the sum algorithm. We have:+--+-- >>> fibCorrect+-- Q.E.D.+--+-- NB. In my experiments, I found that this proof is quite fragile due+-- to the use of quantifiers: If you make a mistake in your algorithm+-- or the coding, z3 pretty much spins forever without finding a counter-example.+-- However, with the correct coding, the proof is almost instantaneous!+fibCorrect :: IO (InductionResult (S Integer))+fibCorrect = induct chatty setup initial trans strengthenings inv goal+  where -- Set this to True for SBV to print steps as it proceeds+        -- through the inductive proof+        chatty :: Bool+        chatty = False++        -- Declare fib as un uninterpreted function:+        fib :: SInteger -> SInteger+        fib = uninterpret "fib"++        -- We setup to axiomatize the textbook definition of fib in SMT-Lib+        setup :: Symbolic ()+        setup = do constrain $ fib 0 .== 0+                   constrain $ fib 1 .== 1++                   -- This is unfortunate; but SBV currently does not support+                   -- adding quantified constraints in the query mode. So we+                   -- have to write this axiom in SMT-Lib. Note also how carefully+                   -- we've chosen this axiom to work with our proof!+                   addAxiom "fib_n" [ "(assert (forall ((x Int))"+                                    , "                (= (fib (+ x 2)) (+ (fib (+ x 1)) (fib x)))))"+                                    ]++        -- Initialize variables+        initial :: S SInteger -> SBool+        initial S{i, k, m, n} = i .== 0 .&& k .== 1 .&& m .== 0 .&& n .>= 0++        -- We code the algorithm almost literally in SBV notation:+        trans :: S SInteger -> [S SInteger]+        trans st@S{i, k, m, n} = [ite (i .< n)+                                      st { i = i + 1, k = m + k, m = k }+                                      st+                                 ]++        -- No strengthenings needed for this problem!+        strengthenings :: [(String, S SInteger -> SBool)]+        strengthenings = []++        -- Loop invariant: @i@ remains at most @n@, @k@ is @fib (i+1)@+        -- and @m@ is fib(i)@:+        inv :: S SInteger -> SBool+        inv S{i, k, m, n} =    i .<= n+                           .&& k .== fib (i+1)+                           .&& m .== fib i++        -- Final goal. When the termination condition holds, the value @m@+        -- holds the @n@th fibonacc number. Note that SBV does not prove the+        -- termination condition; it simply is the indication that the loop+        -- has ended as specified by the user.+        goal :: S SInteger -> (SBool, SBool)+        goal S{i, m, n} = (i .== n, m .== fib n)
+ Documentation/SBV/Examples/ProofTools/Strengthen.hs view
@@ -0,0 +1,161 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Documentation.SBV.Examples.ProofTools.Strengthen+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- An example showing how traditional state-transition invariance problems+-- can be coded using SBV, using induction. We also demonstrate the use of+-- invariant strengthening.+--+-- This example comes from Bradley's [Understanding IC3](http://theory.stanford.edu/~arbrad/papers/Understanding_IC3.pdf) paper,+-- which considers the following two programs:+--+-- @+--      x, y := 1, 1                    x, y := 1, 1+--      while *:                        while *:+--        x, y := x+1, y+x                x, y := x+y, y+x+-- @+--+-- Where @*@ stands for non-deterministic choice. For each program we try to prove that @y >= 1@ is an invariant.+--+-- It turns out that the property @y >= 1@ is indeed an invariant, but is+-- not inductive for either program. We proceed to strengten the invariant+-- and establish it for the first case. We then note that the same strengthening+-- doesn't work for the second program, and find a further strengthening to+-- establish that case as well. This example follows the introductory example+-- in Bradley's paper quite closely.+-----------------------------------------------------------------------------++{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}++module Documentation.SBV.Examples.ProofTools.Strengthen where++import Data.SBV+import Data.SBV.Tools.Induction+import Data.SBV.Control++-- * System state++-- | System state. We simply have two components, parameterized+-- over the type so we can put in both concrete and symbolic values.+data S a = S { x :: a, y :: a } deriving Show++-- | Make our state queriable+instance Queriable IO (S SInteger) (S Integer) where+  fresh = S <$> freshVar_ <*> freshVar_+  extract S{x, y} = S <$> getValue x <*> getValue y++-- * Encoding the problem++-- | We parameterize over the transition relation and the strengthenings to+-- investigate various combinations.+problem :: (S SInteger -> [S SInteger]) -> [(String, S SInteger -> SBool)] -> IO (InductionResult (S Integer))+problem trans strengthenings = induct chatty setup initial trans strengthenings inv goal+  where -- Set this to True for SBV to print steps as it proceeds+        -- through the inductive proof+        chatty :: Bool+        chatty = False++        -- This is where we would put solver options, typically via+        -- calls to 'Data.SBV.setOption'. We do not need any for this problem,+        -- so we simply do nothing.+        setup :: Symbolic ()+        setup = return ()++        -- Initially, @x@ and @y@ are both @1@+        initial :: S SInteger -> SBool+        initial S{x, y} = x .== 1 .&& y .== 1++        -- Invariant to prove:+        inv :: S SInteger -> SBool+        inv S{y} = y .>= 1++        -- We're not interested in termination/goal for this problem, so just pass trivial values+        goal :: S SInteger -> (SBool, SBool)+        goal _ = (sTrue, sTrue)++-- | The first program, coded as a transition relation:+pgm1 :: S SInteger -> [S SInteger]+pgm1 S{x, y} = [S{x = x+1, y = y+x}]++-- | The second program, coded as a transition relation:+pgm2 :: S SInteger -> [S SInteger]+pgm2 S{x, y} = [S{x = x+y, y = y+x}]++-- * Examples++-- | Example 1: First program, with no strengthenings. We have:+--+-- >>> ex1+-- Failed while establishing consecution.+-- Counter-example to inductiveness:+--   S {x = -1, y = 1}+ex1 :: IO (InductionResult (S Integer))+ex1 = problem pgm1 strengthenings+  where strengthenings :: [(String, S SInteger -> SBool)]+        strengthenings = []++-- | Example 2: First program, strengthened with @x >= 0@. We have:+--+-- >>> ex2+-- Q.E.D.+ex2 :: IO (InductionResult (S Integer))+ex2 = problem pgm1 strengthenings+  where strengthenings :: [(String, S SInteger -> SBool)]+        strengthenings = [("x >= 0", \S{x} -> x .>= 0)]++-- | Example 3: Second program, with no strengthenings. We have:+--+-- >>> ex3+-- Failed while establishing consecution.+-- Counter-example to inductiveness:+--   S {x = -1, y = 1}+ex3 :: IO (InductionResult (S Integer))+ex3 = problem pgm2 strengthenings+  where strengthenings :: [(String, S SInteger -> SBool)]+        strengthenings = []++-- | Example 4: Second program, strengthened with @x >= 0@. We have:+--+-- >>> ex4+-- Failed while establishing consecution for strengthening "x >= 0".+-- Counter-example to inductiveness:+--   S {x = 0, y = -1}+ex4 :: IO (InductionResult (S Integer))+ex4 = problem pgm2 strengthenings+  where strengthenings :: [(String, S SInteger -> SBool)]+        strengthenings = [("x >= 0", \S{x} -> x .>= 0)]++-- | Example 5: Second program, strengthened with @x >= 0@ and @y >= 1@ separately. We have:+--+-- >>> ex5+-- Failed while establishing consecution for strengthening "x >= 0".+-- Counter-example to inductiveness:+--   S {x = 0, y = -1}+--+-- Note how this was sufficient in 'ex2' to establish the invariant for the first+-- program, but fails for the second.+ex5 :: IO (InductionResult (S Integer))+ex5 = problem pgm2 strengthenings+  where strengthenings :: [(String, S SInteger -> SBool)]+        strengthenings = [ ("x >= 0", \S{x} -> x .>= 0)+                         , ("y >= 1", \S{y} -> y .>= 1)+                         ]++-- | Example 6: Second program, strengthened with @x >= 0 \/\\ y >= 1@ simultaneously. We have:+--+-- >>> ex6+-- Q.E.D.+--+-- Compare this to 'ex5'. As pointed out by Bradley, this shows that+-- /a conjunction of assertions can be inductive when none of its components, on its own, is inductive./+-- It remains an art to find proper loop invariants, though the science is improving!+ex6 :: IO (InductionResult (S Integer))+ex6 = problem pgm2 strengthenings+  where strengthenings :: [(String, S SInteger -> SBool)]+        strengthenings = [("x >= 0 /\\ y >= 1", \S{x, y} -> x .>= 0 .&& y .>= 1)]
+ Documentation/SBV/Examples/ProofTools/Sum.hs view
@@ -0,0 +1,92 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Documentation.SBV.Examples.ProofTools.Sum+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Example inductive proof to show partial correctness of the traditional+-- for-loop sum algorithm:+--+-- @+--     s = 0+--     i = 0+--     while i <= n:+--        s += i+--        i+++-- @+--+-- We prove the loop invariant and establish partial correctness that+-- @s@ is the sum of all numbers up to and including @n@ upon termination.+-----------------------------------------------------------------------------++{-# LANGUAGE DeriveAnyClass        #-}+{-# LANGUAGE DeriveGeneric         #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns        #-}++module Documentation.SBV.Examples.ProofTools.Sum where++import Data.SBV+import Data.SBV.Tools.Induction+import Data.SBV.Control++import GHC.Generics hiding (S)++-- * System state++-- | System state. We simply have two components, parameterized+-- over the type so we can put in both concrete and symbolic values.+data S a = S { s :: a, i :: a, n :: a } deriving (Show, Mergeable, Generic)++-- | Queriable instance for our state+instance Queriable IO (S SInteger) (S Integer) where+  fresh              = S <$> freshVar_  <*> freshVar_  <*> freshVar_+  extract S{s, i, n} = S <$> getValue s <*> getValue i <*> getValue n++-- | Encoding partial correctness of the sum algorithm. We have:+--+-- >>> sumCorrect+-- Q.E.D.+sumCorrect :: IO (InductionResult (S Integer))+sumCorrect = induct chatty setup initial trans strengthenings inv goal+  where -- Set this to True for SBV to print steps as it proceeds+        -- through the inductive proof+        chatty :: Bool+        chatty = False++        -- This is where we would put solver options, typically via+        -- calls to 'Data.SBV.setOption'. We do not need any for this problem,+        -- so we simply do nothing.+        setup :: Symbolic ()+        setup = return ()++        -- Initially, @s@ and @i@ are both @0@. We also require @n@ to be at least @0@.+        initial :: S SInteger -> SBool+        initial S{s, i, n} = s .== 0 .&& i .== 0 .&& n .>= 0++        -- We code the algorithm almost literally in SBV notation:+        trans :: S SInteger -> [S SInteger]+        trans st@S{s, i, n} = [ite (i .<= n)+                                   st { s = s+i, i = i+1 }+                                   st+                              ]++        -- No strengthenings needed for this problem!+        strengthenings :: [(String, S SInteger -> SBool)]+        strengthenings = []++        -- Loop invariant: @i@ remains at most @n+1@ and @s@ the sum of+        -- all the numbers up-to @i-1@.+        inv :: S SInteger -> SBool+        inv S{s, i, n} =    i .<= n+1+                        .&& s .== (i * (i - 1)) `sDiv` 2++        -- Final goal. When the termination condition holds, the sum is+        -- equal to all the numbers up to and including @n@. Note that+        -- SBV does not prove the termination condition; it simply is+        -- the indication that the loop has ended as specified by the user.+        goal :: S SInteger -> (SBool, SBool)+        goal S{s, i, n} = (i .== n+1, s .== (n * (n+1)) `sDiv` 2)
Documentation/SBV/Examples/Puzzles/Birthday.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.Birthday--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.Birthday+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- This is a formalization of the Cheryl's birthday problem, which went viral in April 2015. -- (See <http://www.nytimes.com/2015/04/15/science/a-math-problem-from-singapore-goes-viral-when-is-cheryls-birthday.html>.)@@ -70,19 +70,19 @@  -- | Assert that the given function holds for one of the possible days. existsDay :: (Day -> SBool) -> SBool-existsDay f = bAny (f . literal) [14 .. 19]+existsDay f = sAny (f . literal) [14 .. 19]  -- | Assert that the given function holds for all of the possible days. forallDay :: (Day -> SBool) -> SBool-forallDay f = bAll (f . literal) [14 .. 19]+forallDay f = sAll (f . literal) [14 .. 19]  -- | Assert that the given function holds for one of the possible months. existsMonth :: (Month -> SBool) -> SBool-existsMonth f = bAny f [may .. august]+existsMonth f = sAny f [may .. august]  -- | Assert that the given function holds for all of the possible months. forallMonth :: (Month -> SBool) -> SBool-forallMonth f = bAll f [may .. august]+forallMonth f = sAll f [may .. august]  ----------------------------------------------------------------------------------------------- -- * The puzzle@@ -103,26 +103,26 @@              -- Albert: I do not know             let a1 m = existsDay $ \d1 -> existsDay $ \d2 ->-                           d1 ./= d2 &&& valid m d1 &&& valid m d2+                           d1 ./= d2 .&& valid m d1 .&& valid m d2              -- Albert: I know that Bernard doesn't know-            let a2 m = forallDay $ \d -> valid m d ==>+            let a2 m = forallDay $ \d -> valid m d .=>                           existsMonth (\m1 -> existsMonth $ \m2 ->-                                m1 ./= m2 &&& valid m1 d &&& valid m2 d)+                                m1 ./= m2 .&& valid m1 d .&& valid m2 d)              -- Bernard: I did not know             let b1 d = existsMonth $ \m1 -> existsMonth $ \m2 ->-                           m1 ./= m2 &&& valid m1 d &&& valid m2 d+                           m1 ./= m2 .&& valid m1 d .&& valid m2 d              -- Bernard: But now I know-            let b2p m d = valid m d &&& a1 m &&& a2 m+            let b2p m d = valid m d .&& a1 m .&& a2 m                 b2  d   = forallMonth $ \m1 -> forallMonth $ \m2 ->-                                (b2p m1 d &&& b2p m2 d) ==> m1 .== m2+                                (b2p m1 d .&& b2p m2 d) .=> m1 .== m2              -- Albert: Now I know too-            let a3p m d = valid m d &&& a1 m &&& a2 m &&& b1 d &&& b2 d+            let a3p m d = valid m d .&& a1 m .&& a2 m .&& b1 d .&& b2 d                 a3 m    = forallDay $ \d1 -> forallDay $ \d2 ->-                                (a3p m d1 &&& a3p m d2) ==> d1 .== d2+                                (a3p m d1 .&& a3p m d2) .=> d1 .== d2              -- Assert all the statements made:             constrain $ a1 birthMonth
Documentation/SBV/Examples/Puzzles/Coins.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.Coins--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.Coins+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Solves the following puzzle: --@@ -41,7 +41,7 @@ -- we constrain the value to be one of the valid U.S. coin values as we create it. mkCoin :: Int -> Symbolic Coin mkCoin i = do c <- exists $ 'c' : show i-              constrain $ bAny (.== c) [1, 5, 10, 25, 50, 100]+              constrain $ sAny (.== c) [1, 5, 10, 25, 50, 100]               return c  -- | Return all combinations of a sequence of values.@@ -98,6 +98,6 @@         -- the following constraint is not necessary for solving the puzzle         -- however, it makes sure that the solution comes in decreasing value of coins,         -- thus allowing the above test to succeed regardless of the solver used.-        constrain $ bAnd $ zipWith (.>=) cs (tail cs)+        constrain $ sAnd $ zipWith (.>=) cs (tail cs)         -- assert that the sum must be 115 cents.         return $ sum cs .== 115
Documentation/SBV/Examples/Puzzles/Counts.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.Counts--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.Counts+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Consider the sentence: --
Documentation/SBV/Examples/Puzzles/DogCatMouse.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.DogCatMouse--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.DogCatMouse+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Puzzle: --   Spend exactly 100 dollars and buy exactly 100 animals.
Documentation/SBV/Examples/Puzzles/Euler185.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.Euler185--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.Euler185+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A solution to Project Euler problem #185: <http://projecteuler.net/index.php?section=problems&id=185> -----------------------------------------------------------------------------@@ -32,9 +32,9 @@ -- number of matching digits match what's given in the problem statement. euler185 :: Symbolic SBool euler185 = do soln <- mkExistVars 16-              return $ bAll digit soln &&& bAnd (map (genConstr soln) guesses)+              return $ sAll digit soln .&& sAnd (map (genConstr soln) guesses)   where genConstr a (b, c) = sum (zipWith eq a b) .== (c :: SWord8)-        digit x = (x :: SWord8) .>= 0 &&& x .<= 9+        digit x = (x :: SWord8) .>= 0 .&& x .<= 9         eq x y =  ite (x .== fromIntegral (ord y - ord '0')) 1 0  -- | Print out the solution nicely. We have:
Documentation/SBV/Examples/Puzzles/Fish.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.Fish--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.Fish+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Solves the following logic puzzle: --@@ -27,11 +27,11 @@ -- Who owns the fish? ------------------------------------------------------------------------------ -{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE DeriveAnyClass      #-}+{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}  module Documentation.SBV.Examples.Puzzles.Fish where @@ -88,35 +88,35 @@               p = uninterpret "pet"               s = uninterpret "sport" -          let i `neighbor` j = i .== j+1 ||| j .== i+1+          let i `neighbor` j = i .== j+1 .|| j .== i+1               a `is`       v = a .== literal v            let fact0   = constrain               fact1 f = do i <- free_-                           constrain $ 1 .<= i &&& i .<= (5 :: SInteger)+                           constrain $ 1 .<= i .&& i .<= (5 :: SInteger)                            constrain $ f i               fact2 f = do i <- free_                            j <- free_-                           constrain $ 1 .<= i &&& i .<= (5 :: SInteger)-                           constrain $ 1 .<= j &&& j .<= 5+                           constrain $ 1 .<= i .&& i .<= (5 :: SInteger)+                           constrain $ 1 .<= j .&& j .<= 5                            constrain $ i ./= j                            constrain $ f i j -          fact1 $ \i   -> n i `is` Briton     &&& c i `is` Red-          fact1 $ \i   -> n i `is` Swede      &&& p i `is` Dog-          fact1 $ \i   -> n i `is` Dane       &&& b i `is` Tea-          fact2 $ \i j -> c i `is` Green      &&& c j `is` White    &&& i .== j-1-          fact1 $ \i   -> c i `is` Green      &&& b i `is` Coffee-          fact1 $ \i   -> s i `is` Football   &&& p i `is` Bird-          fact1 $ \i   -> c i `is` Yellow     &&& s i `is` Baseball+          fact1 $ \i   -> n i `is` Briton     .&& c i `is` Red+          fact1 $ \i   -> n i `is` Swede      .&& p i `is` Dog+          fact1 $ \i   -> n i `is` Dane       .&& b i `is` Tea+          fact2 $ \i j -> c i `is` Green      .&& c j `is` White    .&& i .== j-1+          fact1 $ \i   -> c i `is` Green      .&& b i `is` Coffee+          fact1 $ \i   -> s i `is` Football   .&& p i `is` Bird+          fact1 $ \i   -> c i `is` Yellow     .&& s i `is` Baseball           fact0 $         b 3 `is` Milk           fact0 $         n 1 `is` Norwegian-          fact2 $ \i j -> s i `is` Volleyball &&& p j `is` Cat      &&& i `neighbor` j-          fact2 $ \i j -> p i `is` Horse      &&& s j `is` Baseball &&& i `neighbor` j-          fact1 $ \i   -> s i `is` Tennis     &&& b i `is` Beer-          fact1 $ \i   -> n i `is` German     &&& s i `is` Hockey-          fact2 $ \i j -> n i `is` Norwegian  &&& c j `is` Blue     &&& i `neighbor` j-          fact2 $ \i j -> s i `is` Volleyball &&& b j `is` Water    &&& i `neighbor` j+          fact2 $ \i j -> s i `is` Volleyball .&& p j `is` Cat      .&& i `neighbor` j+          fact2 $ \i j -> p i `is` Horse      .&& s j `is` Baseball .&& i `neighbor` j+          fact1 $ \i   -> s i `is` Tennis     .&& b i `is` Beer+          fact1 $ \i   -> n i `is` German     .&& s i `is` Hockey+          fact2 $ \i j -> n i `is` Norwegian  .&& c j `is` Blue     .&& i `neighbor` j+          fact2 $ \i j -> s i `is` Volleyball .&& b j `is` Water    .&& i `neighbor` j            ownsFish <- free "fishOwner"-          fact1 $ \i -> n i .== ownsFish &&& p i `is` Fish+          fact1 $ \i -> n i .== ownsFish .&& p i `is` Fish
Documentation/SBV/Examples/Puzzles/Garden.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.Garden--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.Garden+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The origin of this puzzle is Raymond Smullyan's "The Flower Garden" riddle: --@@ -28,10 +28,10 @@ -- case, the second student would be right. ------------------------------------------------------------------------------ -{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE DeriveAnyClass      #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}  module Documentation.SBV.Examples.Puzzles.Garden where @@ -55,7 +55,7 @@ -- we have @n@ flowers to start with. Essentially the numbers should -- be within bounds and distinct. validPick :: SInteger -> Flower -> Flower -> Flower -> SBool-validPick n i j k = distinct [i, j, k] &&& bAll ok [i, j, k]+validPick n i j k = distinct [i, j, k] .&& sAll ok [i, j, k]   where ok x = inRange x (1, n)  -- | Count the number of flowers that occur in a given set of flowers.@@ -88,13 +88,13 @@             constrain $ map col [ef1, ef2, ef3] .== map literal [Red, Yellow, Blue]              -- Pick any three, at least one is Red-            constrain $ valid af1 af2 af3 ==> count Red    [af1, af2, af3] .>= 1+            constrain $ valid af1 af2 af3 .=> count Red    [af1, af2, af3] .>= 1              -- Pick any three, at least one is Yellow-            constrain $ valid af1 af2 af3 ==> count Yellow [af1, af2, af3] .>= 1+            constrain $ valid af1 af2 af3 .=> count Yellow [af1, af2, af3] .>= 1              -- Pick any three, at least one is Blue-            constrain $ valid af1 af2 af3 ==> count Blue   [af1, af2, af3] .>= 1+            constrain $ valid af1 af2 af3 .=> count Blue   [af1, af2, af3] .>= 1  -- | Solve the puzzle. We have: --
Documentation/SBV/Examples/Puzzles/HexPuzzle.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.HexPuzzle--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.HexPuzzle+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A solution to the hexagon solver puzzle: <http://www5.cadence.com/2018ClubVQuiz_LP.html> -- In case the above URL goes dead, here's an ASCII rendering of the problem.@@ -39,11 +39,11 @@ -- to the final one. ----------------------------------------------------------------------------- -{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE DeriveAnyClass      #-}+{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}  module Documentation.SBV.Examples.Puzzles.HexPuzzle where @@ -112,7 +112,7 @@                                           findOthers sofar vs          findOthers vs = go-                where go curVals = do constrain $ bOr $ zipWith (\v c -> v ./= literal c) vs curVals+                where go curVals = do constrain $ sOr $ zipWith (\v c -> v ./= literal c) vs curVals                                       cs <- checkSat                                       case cs of                                        Unk   -> error "Unknown!"
Documentation/SBV/Examples/Puzzles/LadyAndTigers.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.LadyAndTigers--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.LadyAndTigers+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Puzzle: --@@ -48,13 +48,13 @@     [tiger1, tiger2, tiger3] <- mapM sBool ["tiger1", "tiger2", "tiger3"]      -- Room 1 sign: A Tiger is in this room-    constrain $ sign1 <=> tiger1+    constrain $ sign1 .<=> tiger1      -- Room 2 sign: A Lady is in this room-    constrain $ sign2 <=> bnot tiger2+    constrain $ sign2 .<=> sNot tiger2      -- Room 3 sign: A Tiger is in room 2-    constrain $ sign3 <=> tiger2+    constrain $ sign3 .<=> tiger2      -- At most one sign is true     constrain $ [sign1, sign2, sign3] `pbAtMost` 1
Documentation/SBV/Examples/Puzzles/MagicSquare.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.MagicSquare--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.MagicSquare+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Solves the magic-square puzzle. An NxN magic square is one where all entries -- are filled with numbers from 1 to NxN such that sums of all rows, columns@@ -28,7 +28,7 @@  -- | Checks that all elements in a list are within bounds check :: Elem -> Elem -> [Elem] -> SBool-check low high = bAll $ \x -> x .>= low &&& x .<= high+check low high = sAll $ \x -> x .>= low .&& x .<= high  -- | Get the diagonal of a square matrix diag :: [[a]] -> [a]@@ -37,7 +37,7 @@  -- | Test if a given board is a magic square isMagic :: Board -> SBool-isMagic rows = bAnd $ fromBool isSquare : allEqual (map sum items) : distinct (concat rows) : map chk items+isMagic rows = sAnd $ fromBool isSquare : allEqual (map sum items) : distinct (concat rows) : map chk items   where items = d1 : d2 : rows ++ columns         n = genericLength rows         isSquare = all (\r -> genericLength r == n) rows
Documentation/SBV/Examples/Puzzles/NQueens.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.NQueens--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.NQueens+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Solves the NQueens puzzle: <http://en.wikipedia.org/wiki/Eight_queens_puzzle> -----------------------------------------------------------------------------@@ -19,8 +19,8 @@ -- | Checks that a given solution of @n@-queens is valid, i.e., no queen -- captures any other. isValid :: Int -> Solution -> SBool-isValid n s = bAll rangeFine s &&& distinct s &&& bAll checkDiag ijs-  where rangeFine x = x .>= 1 &&& x .<= fromIntegral n+isValid n s = sAll rangeFine s .&& distinct s .&& sAll checkDiag ijs+  where rangeFine x = x .>= 1 .&& x .<= fromIntegral n         ijs = [(i, j) | i <- [1..n], j <- [i+1..n]]         checkDiag (i, j) = diffR ./= diffC            where qi = s !! (i-1)
Documentation/SBV/Examples/Puzzles/SendMoreMoney.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.SendMoreMoney--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.SendMoreMoney+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Solves the classic @send + more = money@ puzzle. -----------------------------------------------------------------------------@@ -34,12 +34,12 @@ sendMoreMoney :: IO AllSatResult sendMoreMoney = allSat $ do         ds@[s,e,n,d,m,o,r,y] <- mapM sInteger ["s", "e", "n", "d", "m", "o", "r", "y"]-        let isDigit x = x .>= 0 &&& x .<= 9+        let isDigit x = x .>= 0 .&& x .<= 9             val xs    = sum $ zipWith (*) (reverse xs) (iterate (*10) 1)             send      = val [s,e,n,d]             more      = val [m,o,r,e]             money     = val [m,o,n,e,y]-        constrain $ bAll isDigit ds+        constrain $ sAll isDigit ds         constrain $ distinct ds-        constrain $ s ./= 0 &&& m ./= 0+        constrain $ s ./= 0 .&& m ./= 0         solve [send + more .== money]
Documentation/SBV/Examples/Puzzles/Sudoku.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.Sudoku--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.Sudoku+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The Sudoku solver, quintessential SMT solver example! -----------------------------------------------------------------------------@@ -28,12 +28,12 @@ -- | Given a series of elements, make sure they are all different -- and they all are numbers between 1 and 9 check :: [SWord8] -> SBool-check grp = bAnd $ distinct grp : map rangeFine grp-  where rangeFine x = x .> 0 &&& x .<= 9+check grp = sAnd $ distinct grp : map rangeFine grp+  where rangeFine x = x .> 0 .&& x .<= 9  -- | Given a full Sudoku board, check that it is valid valid :: Board -> SBool-valid rows = bAnd $ literal sizesOK : map check (rows ++ columns ++ squares)+valid rows = sAnd $ literal sizesOK : map check (rows ++ columns ++ squares)   where sizesOK = length rows == 9 && all (\r -> length r == 9) rows         columns = transpose rows         regions = transpose [chunk 3 row | row <- rows]
Documentation/SBV/Examples/Puzzles/U2Bridge.hs view
@@ -1,21 +1,21 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.U2Bridge--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Puzzles.U2Bridge+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- The famous U2 bridge crossing puzzle: <http://www.braingle.com/brainteasers/515/u2.html> ----------------------------------------------------------------------------- -{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE TemplateHaskell      #-}-{-# LANGUAGE StandaloneDeriving   #-} {-# LANGUAGE DeriveAnyClass       #-} {-# LANGUAGE DeriveDataTypeable   #-} {-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE StandaloneDeriving   #-}+{-# LANGUAGE TemplateHaskell      #-}+{-# LANGUAGE TypeSynonymInstances #-}  module Documentation.SBV.Examples.Puzzles.U2Bridge where @@ -181,7 +181,7 @@                  l1 <- whereIs p1                  l2 <- whereIs p2                  -- only do the move if both people and the flash are at the same side-                 whenS (f .== l1 &&& f .== l2) $ do bumpTime2 p1 p2+                 whenS (f .== l1 .&& f .== l2) $ do bumpTime2 p1 p2                                                     xferFlash                                                     xferPerson p1                                                     xferPerson p2@@ -208,12 +208,12 @@ -- | Check if a given sequence of actions is valid, i.e., they must all -- cross the bridge according to the rules and in less than 17 seconds isValid :: Actions -> SBool-isValid as = time end .<= 17 &&& bAll check as &&& zigZag (cycle [there, here]) (map flash states) &&& bAll (.== there) [lBono end, lEdge end, lAdam end, lLarry end]-  where check (s, p1, p2) =   (bnot s ==> p1 .> p2)      -- for two person moves, ensure first person is "larger"-                          &&& (s      ==> p2 .== bono)   -- for one person moves, ensure second person is always "bono"+isValid as = time end .<= 17 .&& sAll check as .&& zigZag (cycle [there, here]) (map flash states) .&& sAll (.== there) [lBono end, lEdge end, lAdam end, lLarry end]+  where check (s, p1, p2) =   (sNot s .=> p1 .> p2)      -- for two person moves, ensure first person is "larger"+                          .&& (s      .=> p2 .== bono)   -- for one person moves, ensure second person is always "bono"         states = evalState (run as) start         end = last states-        zigZag reqs locs = bAnd $ zipWith (.==) locs reqs+        zigZag reqs locs = sAnd $ zipWith (.==) locs reqs  ------------------------------------------------------------- -- * Solving the puzzle
Documentation/SBV/Examples/Queries/AllSat.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Queries.AllSat--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Queries.AllSat+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- When we would like to find all solutions to a problem, we can query the -- solver repeatedly, telling it to give us a new model each time. SBV already@@ -52,7 +52,7 @@                                   -- Note that we do *not* put these separately, as we do want                                   -- to allow repetition on one value if the other is different!                                   constrain $   x ./= literal xv-                                            ||| y ./= literal yv+                                            .|| y ./= literal yv                                    -- Also request @x@ to be twice as large, for demo purposes:                                   constrain $ x .>= 2 * literal xv
Documentation/SBV/Examples/Queries/CaseSplit.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Queries.CaseSplit--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Queries.CaseSplit+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A couple of demonstrations for the 'caseSplit' function. -----------------------------------------------------------------------------
Documentation/SBV/Examples/Queries/Enums.hs view
@@ -1,19 +1,19 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Queries.Enums--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Queries.Enums+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates the use of enumeration values during queries. ----------------------------------------------------------------------------- -{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE DeriveAnyClass      #-}+{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}  module Documentation.SBV.Examples.Queries.Enums where
Documentation/SBV/Examples/Queries/FourFours.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Queries.FourFours--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Queries.FourFours+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A query based solution to the four-fours puzzle. -- Inspired by <http://www.gigamonkeys.com/trees/>@@ -19,12 +19,12 @@ -- and ask the SMT solver to find the appropriate fillings. ----------------------------------------------------------------------------- -{-# LANGUAGE FlexibleInstances  #-}-{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE DeriveAnyClass      #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE FlexibleInstances  #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}  module Documentation.SBV.Examples.Queries.FourFours where @@ -100,7 +100,7 @@  -- | Minor helper for writing "symbolic" case statements. Simply walks down a list -- of values to match against a symbolic version of the key.-sCase :: (SymWord a, Mergeable v) => SBV a -> [(a, v)] -> v+sCase :: (SymVal a, Mergeable v) => SBV a -> [(a, v)] -> v sCase k = walk   where walk []              = error "sCase: Expected a non-empty list of cases!"         walk [(_, v)]        = v@@ -117,8 +117,8 @@               F       -> return 4    where binOp :: SBinOp -> SInteger -> SInteger -> Symbolic SInteger-        binOp o l r = do constrain $ o .== literal Divide ==> r .== 4 ||| r .== 2-                         constrain $ o .== literal Expt   ==> r .== 0+        binOp o l r = do constrain $ o .== literal Divide .=> r .== 4 .|| r .== 2+                         constrain $ o .== literal Expt   .=> r .== 0                          return $ sCase o                                     [ (Plus,    l+r)                                     , (Minus,   l-r)@@ -128,8 +128,8 @@                                     ]          uOp :: SUnOp -> SInteger -> Symbolic SInteger-        uOp o v = do constrain $ o .== literal Sqrt      ==> v .== 4-                     constrain $ o .== literal Factorial ==> v .== 4+        uOp o v = do constrain $ o .== literal Sqrt      .=> v .== 4+                     constrain $ o .== literal Factorial .=> v .== 4                      return $ sCase o                                 [ (Negate,    -v)                                 , (Sqrt,       2)  -- argument is restricted to 4, so the value is 2
Documentation/SBV/Examples/Queries/GuessNumber.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Queries.GuessNumber--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Queries.GuessNumber+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A simple number-guessing game implementation via queries. Clearly an -- SMT solver is hardly needed for this problem, but it is a nice demo
Documentation/SBV/Examples/Queries/Interpolants.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Queries.Interpolants--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Queries.Interpolants+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates extraction of interpolants via queries. --@@ -31,7 +31,7 @@ -- satisfies the second. However, there's no triple @(x, y, z)@ that satisfies all -- these four formulas together. We can use SBV to check this fact: ----- >>> sat $ \x y z -> bAnd [x - 3*y .>= -1, x + y .>= 0, z - 2*x .>= 3, 2 * z .<= (1::SInteger)]+-- >>> sat $ \x y z -> sAnd [x - 3*y .>= -1, x + y .>= 0, z - 2*x .>= 3, 2 * z .<= (1::SInteger)] -- Unsatisfiable -- -- An interpolant for these sets would only talk about the variable @x@ that is common@@ -45,12 +45,12 @@ -- is entailed by the first set of formulas, and is inconsistent with the second. Let's use SBV -- to indeed show that this is the case: ----- >>> prove $ \x y -> (x - 3*y .>= -1 &&& x + y .>= 0) ==> (x .>= (0::SInteger))+-- >>> prove $ \x y -> (x - 3*y .>= -1 .&& x + y .>= 0) .=> (x .>= (0::SInteger)) -- Q.E.D. -- -- And: ----- >>> prove $ \x z -> (z - 2*x .>= 3 &&& 2 * z .<= 1) ==> bnot (x .>= (0::SInteger))+-- >>> prove $ \x z -> (z - 2*x .>= 3 .&& 2 * z .<= 1) .=> sNot (x .>= (0::SInteger)) -- Q.E.D. -- -- This establishes that we indeed have an interpolant!
Documentation/SBV/Examples/Queries/UnsatCore.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Queries.UnsatCore--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Queries.UnsatCore+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates extraction of unsat-cores via queries. -----------------------------------------------------------------------------
Documentation/SBV/Examples/Strings/RegexCrossword.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.RegexCrossword--- Copyright   :  (c) Joel Burget--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Strings.RegexCrossword+-- Author    : Joel Burget+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- This example solves regex crosswords from <http://regexcrossword.com> -----------------------------------------------------------------------------@@ -48,7 +48,7 @@         let rowss =           [[r .!! literal i | i <- [0..numCols-1]] | r <- rows]         let colss = transpose [[c .!! literal i | i <- [0..numRows-1]] | c <- cols] -        constrain $ bAnd $ zipWith (.==) (concat rowss) (concat colss)+        constrain $ sAnd $ zipWith (.==) (concat rowss) (concat colss)          -- Now query to extract the solution         query $ do cs <- checkSat
Documentation/SBV/Examples/Strings/SQLInjection.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Puzzles.SQLInjection--- Copyright   :  (c) Joel Burget--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Strings.SQLInjection+-- Author    : Joel Burget+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Implement the symbolic evaluation of a language which operates on -- strings in a way similar to bash. It's possible to do different analyses,@@ -106,16 +106,23 @@ --   query ("SELECT msg FROM msgs WHERE topicid='" ++ my_topicid ++ "'") -- @ ----- We have:+-- Depending on your z3 version, you might see an output of the form: ----- >>> findInjection exampleProgram--- "  f'; DROP TABLE 'users"+-- @+--   ghci> findInjection exampleProgram+--   "kg'; DROP TABLE 'users"+-- @ ----- Indeed, if we substitute the suggested string, we get the program:+-- though the topic might change obviously. Indeed, if we substitute the suggested string, we get the program: ----- > query ("SELECT msg FROM msgs WHERE topicid='  f'; DROP TABLE 'users'")+-- > query ("SELECT msg FROM msgs WHERE topicid='kg'; DROP TABLE 'users'") ----- which would query for topic @'  f'@ and then delete the users table!+-- which would query for topic @kg@ and then delete the users table!+--+-- Here, we make sure that the injection ends with the malicious string:+--+-- >>> ("'; DROP TABLE 'users" `Data.List.isSuffixOf`) <$> findInjection exampleProgram+-- True findInjection :: SQLExpr -> IO String findInjection expr = runSMT $ do @@ -135,7 +142,7 @@     (_, queries) <- runWriterT (evalStateT (eval expr) env)      -- For all the queries thus generated, ask that one of them be "explotiable"-    constrain $ bAny (`R.match` exploitRe) queries+    constrain $ sAny (`R.match` exploitRe) queries      query $ do cs <- checkSat                case cs of
+ Documentation/SBV/Examples/Transformers/SymbolicEval.hs view
@@ -0,0 +1,206 @@+-----------------------------------------------------------------------------+-- |+-- Module    : Documentation.SBV.Examples.Transformers.SymbolicEval+-- Author    : Brian Schroeder+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- A demonstration of the use of the 'SymbolicT' and 'QueryT' transformers in+-- the setting of symbolic program evaluation.+--+-- In this example, we perform symbolic evaluation across three steps:+--+-- 1. allocate free variables, so we can extract a model after evaluation+-- 2. perform symbolic evaluation of a program and an associated property+-- 3. querying the solver for whether it's possible to find a set of program+--    inputs that falsify the property. if there is, we extract a model.+--+-- To simplify the example, our programs always have exactly two integer inputs+-- named @x@ and @y@.+-----------------------------------------------------------------------------++{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE GADTs                      #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures             #-}++module Documentation.SBV.Examples.Transformers.SymbolicEval where++import Control.Monad.Except   (Except, ExceptT, MonadError, mapExceptT, runExceptT, throwError)+import Control.Monad.Identity (Identity(runIdentity))+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader   (MonadReader(ask, reader), ReaderT, runReaderT)+import Control.Monad.Trans    (lift)++import Data.SBV.Dynamic   (SVal)+import Data.SBV.Internals (SBV(SBV), unSBV)+import Data.SBV.Trans+import Data.SBV.Trans.Control++-- * Allocation of symbolic variables, so we can extract a model later.++-- | Monad for allocating free variables.+newtype Alloc a = Alloc { runAlloc :: SymbolicT (ExceptT String IO) a }+    deriving (Functor, Applicative, Monad, MonadIO,+              MonadError String, MonadSymbolic)++-- | Environment holding allocated variables.+data Env = Env { envX   :: SBV Integer+               , envY   :: SBV Integer+               , result :: Maybe SVal -- could be integer or bool. during+                                      -- program evaluation, this is Nothing.+                                      -- we only have a value during property+                                      -- evaluation.+               }+    deriving (Eq, Show)++-- | Allocate an integer variable with the provided name.+alloc :: String -> Alloc (SBV Integer)+alloc "" = throwError "tried to allocate unnamed value"+alloc nm = free nm++-- | Allocate an 'Env' holding all input variables for the program.+allocEnv :: Alloc Env+allocEnv = do+    x <- alloc "x"+    y <- alloc "y"+    pure $ Env x y Nothing++-- * Symbolic term evaluation++-- | The term language we use to express programs and properties.+data Term :: * -> * where+    Var         :: String                       -> Term r+    Lit         :: Integer                      -> Term Integer+    Plus        :: Term Integer -> Term Integer -> Term Integer+    LessThan    :: Term Integer -> Term Integer -> Term Bool+    GreaterThan :: Term Integer -> Term Integer -> Term Bool+    Equals      :: Term Integer -> Term Integer -> Term Bool+    Not         :: Term Bool                    -> Term Bool+    Or          :: Term Bool    -> Term Bool    -> Term Bool+    And         :: Term Bool    -> Term Bool    -> Term Bool+    Implies     :: Term Bool    -> Term Bool    -> Term Bool++-- | Monad for performing symbolic evaluation.+newtype Eval a = Eval { unEval :: ReaderT Env (Except String) a }+    deriving (Functor, Applicative, Monad, MonadReader Env, MonadError String)++-- | Unsafe cast for symbolic values. In production code, we would check types instead.+unsafeCastSBV :: SBV a -> SBV b+unsafeCastSBV = SBV . unSBV++-- | Symbolic evaluation function for 'Term'.+eval :: Term r -> Eval (SBV r)+eval (Var "x")           = unsafeCastSBV . envX <$> ask+eval (Var "y")           = unsafeCastSBV . envY <$> ask+eval (Var "result")      = do mRes <- reader result+                              case mRes of+                                Nothing -> throwError "unknown variable"+                                Just sv -> pure $ SBV sv+eval (Var _)             = throwError "unknown variable"+eval (Lit i)             = pure $ literal i+eval (Plus        t1 t2) = (+)   <$> eval t1 <*> eval t2+eval (LessThan    t1 t2) = (.<)  <$> eval t1 <*> eval t2+eval (GreaterThan t1 t2) = (.>)  <$> eval t1 <*> eval t2+eval (Equals      t1 t2) = (.==) <$> eval t1 <*> eval t2+eval (Not         t)     = sNot  <$> eval t+eval (Or          t1 t2) = (.||) <$> eval t1 <*> eval t2+eval (And         t1 t2) = (.&&) <$> eval t1 <*> eval t2+eval (Implies     t1 t2) = (.=>) <$> eval t1 <*> eval t2++-- | Runs symbolic evaluation, sending a 'Term' to a symbolic value (or+-- failing). Used for symbolic evaluation of programs and properties.+runEval :: Env -> Term a -> Except String (SBV a)+runEval env term = runReaderT (unEval $ eval term) env++-- | A program that can reference two input variables, @x@ and @y@.+newtype Program a = Program (Term a)++-- | A symbolic value representing the result of running a program -- its+-- output.+newtype Result = Result SVal++-- | Makes a 'Result' from a symbolic value.+mkResult :: SBV a -> Result+mkResult = Result . unSBV++-- | Performs symbolic evaluation of a 'Program'.+runProgramEval :: Env -> Program a -> Except String Result+runProgramEval env (Program term) = mkResult <$> runEval env term++-- * Property evaluation++-- | A property describes a quality of a 'Program'. It is a 'Term' yields a+-- boolean value.+newtype Property = Property (Term Bool)++-- | Performs symbolic evaluation of a 'Property.+runPropertyEval :: Result -> Env -> Property -> Except String (SBV Bool)+runPropertyEval (Result res) env (Property term) =+    runEval (env { result = Just res }) term++-- * Checking whether a program satisfies a property++-- | The result of 'check'ing the combination of a 'Program' and a 'Property'.+data CheckResult = Proved | Counterexample Integer Integer+    deriving (Eq, Show)++-- | Sends an 'Identity' computation to an arbitrary monadic computation.+generalize :: Monad m => Identity a -> m a+generalize = pure . runIdentity++-- | Monad for querying a solver.+newtype Q a = Q { runQ :: QueryT (ExceptT String IO) a }+    deriving (Functor, Applicative, Monad, MonadIO, MonadError String, MonadQuery)++-- | Creates a computation that queries a solver and yields a 'CheckResult'.+mkQuery :: Env -> Q CheckResult+mkQuery env = do+    satResult <- checkSat+    case satResult of+        Sat   -> Counterexample <$> getValue (envX env)+                                <*> getValue (envY env)+        Unsat -> pure Proved+        Unk   -> throwError "unknown"++-- | Checks a 'Property' of a 'Program' (or fails).+check :: Program a -> Property -> IO (Either String CheckResult)+check program prop = runExceptT $ runSMTWith z3 $ do+    env <- runAlloc allocEnv+    test <- lift $ mapExceptT generalize $ do+        res <- runProgramEval env program+        runPropertyEval res env prop+    constrain $ sNot test+    query $ runQ $ mkQuery env++-- * Some examples++-- | Check that @x+y+1@ generates a counter-example for the property that the+-- result is less than @10@ when @x+y@ is at least @9@. We have:+--+-- >>> ex1+-- Right (Counterexample 0 9)+ex1 :: IO (Either String CheckResult)+ex1 = check (Program  $ Var "x" `Plus` Lit 1 `Plus` Var "y")+            (Property $ Var "result" `LessThan` Lit 10)++-- | Check that the program @x+y@ correctly produces a result greater than @1@ when+-- both @x@ and @y@ are at least @1@. We have:+--+-- >>> ex2+-- Right Proved+ex2 :: IO (Either String CheckResult)+ex2 = check (Program  $ Var "x" `Plus` Var "y")+            (Property $ (positive (Var "x") `And` positive (Var "y"))+                `Implies` (Var "result" `GreaterThan` Lit 1))+  where positive t = t `GreaterThan` Lit 0++-- | Check that we catch the cases properly through the monad stack when there is a+-- syntax error, like an undefined variable. We have:+--+-- >>> ex3+-- Left "unknown variable"+ex3 :: IO (Either String CheckResult)+ex3 = check (Program  $ Var "notAValidVar")+            (Property $ Var "result" `LessThan` Lit 10)
Documentation/SBV/Examples/Uninterpreted/AUF.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Uninterpreted.AUF--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Uninterpreted.AUF+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Formalizes and proves the following theorem, about arithmetic, -- uninterpreted functions, and arrays. (For reference, see <http://research.microsoft.com/en-us/um/redmond/projects/z3/fmcad06-slides.pdf>@@ -45,7 +45,7 @@ -- the given array @a@. Note that we're being generic in the type of -- array we're expecting. thm :: SymArray a => SWord32 -> SWord32 -> a Word32 Word32 -> SBool-thm x y a = lhs ==> rhs+thm x y a = lhs .=> rhs   where lhs = x + 2 .== y         rhs =     f (readArray (writeArray a x 3) (y - 2))               .== f (y - x + 1)
Documentation/SBV/Examples/Uninterpreted/Deduce.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Uninterpreted.Deduce--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Uninterpreted.Deduce+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates uninterpreted sorts and how they can be used for deduction. -- This example is inspired by the discussion at <http://stackoverflow.com/questions/10635783/using-axioms-for-deductions-in-z3>,@@ -29,7 +29,7 @@  -- | The uninterpreted sort 'B', corresponding to the carrier. -- To prevent SBV from translating it to an enumerated type, we simply attach an unused field-newtype B = B () deriving (Eq, Ord, Show, Read, Data, SymWord, HasKind)+newtype B = B () deriving (Eq, Ord, Show, Read, Data, SymVal, HasKind)  -- | Handy shortcut for the type of symbolic values over 'B' type SB = SBV B
Documentation/SBV/Examples/Uninterpreted/Function.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Uninterpreted.Function--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Uninterpreted.Function+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates function counter-examples -----------------------------------------------------------------------------@@ -22,4 +22,4 @@ -- >>> prove thmGood -- Q.E.D. thmGood :: SWord8 -> SWord8 -> SWord8 -> SBool-thmGood x y z = x .== y+2 ==> f x z .== f (y + 2) z+thmGood x y z = x .== y+2 .=> f x z .== f (y + 2) z
Documentation/SBV/Examples/Uninterpreted/Shannon.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Uninterpreted.Shannon--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Uninterpreted.Shannon+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Proves (instances of) Shannon's expansion theorem and other relevant -- facts.  See: <http://en.wikipedia.org/wiki/Shannon's_expansion>@@ -31,12 +31,12 @@ -- | Positive Shannon cofactor of a boolean function, with -- respect to its first argument pos :: (SBool -> a) -> a-pos f = f true+pos f = f sTrue  -- | Negative Shannon cofactor of a boolean function, with -- respect to its first argument neg :: (SBool -> a) -> a-neg f = f false+neg f = f sFalse  ----------------------------------------------------------------------------- -- * Shannon expansion theorem@@ -47,7 +47,7 @@ -- >>> shannon -- Q.E.D. shannon :: IO ThmResult-shannon = prove $ \x y z -> f x y z .== (x &&& pos f y z ||| bnot x &&& neg f y z)+shannon = prove $ \x y z -> f x y z .== (x .&& pos f y z .|| sNot x .&& neg f y z)  where f :: Ternary        f = uninterpret "f" @@ -56,7 +56,7 @@ -- >>> shannon2 -- Q.E.D. shannon2 :: IO ThmResult-shannon2 = prove $ \x y z -> f x y z .== ((x ||| neg f y z) &&& (bnot x ||| pos f y z))+shannon2 = prove $ \x y z -> f x y z .== ((x .|| neg f y z) .&& (sNot x .|| pos f y z))  where f :: Ternary        f = uninterpret "f" @@ -68,7 +68,7 @@ -- Defined as exclusive-or of Shannon cofactors with respect to that -- variable. derivative :: Ternary -> Binary-derivative f y z = pos f y z <+> neg f y z+derivative f y z = pos f y z .<+> neg f y z  -- | The no-wiggle theorem: If the derivative of a function with respect to -- a variable is constant False, then that variable does not "wiggle" the@@ -79,7 +79,7 @@ -- >>> noWiggle -- Q.E.D. noWiggle :: IO ThmResult-noWiggle = prove $ \y z -> bnot (f' y z) <=> pos f y z .== neg f y z+noWiggle = prove $ \y z -> sNot (f' y z) .<=> pos f y z .== neg f y z   where f :: Ternary         f  = uninterpret "f"         f' = derivative f@@ -91,7 +91,7 @@ -- | Universal quantification of a boolean function with respect to a variable. -- Simply defined as the conjunction of the Shannon cofactors. universal :: Ternary -> Binary-universal f y z = pos f y z &&& neg f y z+universal f y z = pos f y z .&& neg f y z  -- | Show that universal quantification is really meaningful: That is, if the universal -- quantification with respect to a variable is True, then both cofactors are true for@@ -101,7 +101,7 @@ -- >>> univOK -- Q.E.D. univOK :: IO ThmResult-univOK = prove $ \y z -> f' y z ==> pos f y z &&& neg f y z+univOK = prove $ \y z -> f' y z .=> pos f y z .&& neg f y z   where f :: Ternary         f  = uninterpret "f"         f' = universal f@@ -113,7 +113,7 @@ -- | Existential quantification of a boolean function with respect to a variable. -- Simply defined as the conjunction of the Shannon cofactors. existential :: Ternary -> Binary-existential f y z = pos f y z ||| neg f y z+existential f y z = pos f y z .|| neg f y z  -- | Show that existential quantification is really meaningful: That is, if the existential -- quantification with respect to a variable is True, then one of the cofactors must be true for@@ -123,7 +123,7 @@ -- >>> existsOK -- Q.E.D. existsOK :: IO ThmResult-existsOK = prove $ \y z -> f' y z ==> pos f y z ||| neg f y z+existsOK = prove $ \y z -> f' y z .=> pos f y z .|| neg f y z   where f :: Ternary         f  = uninterpret "f"         f' = existential f
Documentation/SBV/Examples/Uninterpreted/Sort.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Uninterpreted.Sort--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Uninterpreted.Sort+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates uninterpreted sorts, together with axioms. -----------------------------------------------------------------------------@@ -21,7 +21,7 @@ -- in the backend SMT solver. Note the custom @deriving@ clause, which -- takes care of most of the boilerplate. The () field is needed so -- SBV will not translate it to an enumerated data-type-newtype Q = Q () deriving (Eq, Ord, Data, Read, Show, SymWord, HasKind)+newtype Q = Q () deriving (Eq, Ord, Data, Read, Show, SymVal, HasKind)  -- | Declare an uninterpreted function that works over Q's f :: SBV Q -> SBV Q
Documentation/SBV/Examples/Uninterpreted/UISortAllSat.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Documentation.SBV.Examples.Uninterpreted.UISortAllSat--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Documentation.SBV.Examples.Uninterpreted.UISortAllSat+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Demonstrates uninterpreted sorts and how all-sat behaves for them. -- Thanks to Eric Seidel for the idea.@@ -27,8 +27,8 @@        deriving (Eq, Ord, Show, Read, Data)  -- | Declare instances to make 'L' a usable uninterpreted sort. First we need the--- 'SymWord' instance, with the default definition sufficing.-instance SymWord L+-- 'SymVal' instance, with the default definition sufficing.+instance SymVal L  -- | Similarly, 'HasKind's default implementation is sufficient. instance HasKind L@@ -72,4 +72,4 @@                     constrain $ classify l0 .== 0                     constrain $ classify l1 .== 1                     constrain $ classify l2 .== 2-                    return $ l .== l0 ||| l .== l1 ||| l .== l2+                    return $ l .== l0 .|| l .== l1 .|| l .== l2
LICENSE view
@@ -1,6 +1,6 @@ SBV: SMT Based Verification in Haskell -Copyright (c) 2010-2018, Levent Erkok (erkokl@gmail.com)+Copyright (c) 2010-2019, Levent Erkok (erkokl@gmail.com) All rights reserved.  Redistribution and use in source and binary forms, with or without
README.md view
@@ -10,9 +10,9 @@      - GHC 8.2.2 [![Build1][3]][1]      - GHC 8.4.3 [![Build1][4]][1]  - Mac OSX:-     - GHC 8.4.3 [![Build1][5]][1]+     - GHC 8.4.4 [![Build1][5]][1]  - Windows:-     - GHC 8.4.3 [![Build5][6]][2]+     - GHC 8.6.2 [![Build5][6]][2]  [1]: https://travis-ci.org/LeventErkok/sbv [2]: https://ci.appveyor.com/project/LeventErkok/sbv
SBVTestSuite/GoldFiles/auf-0.gold view
@@ -2,8 +2,6 @@   s0 :: SWord32, existential, aliasing "x"   s1 :: SWord32, existential, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s2 = 2 :: Word32   s6 = 3 :: Word32   s13 = 1 :: Word32
SBVTestSuite/GoldFiles/auf-1.gold view
@@ -2,8 +2,6 @@   s0 :: SWord32, existential, aliasing "x"   s1 :: SWord32, existential, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s2 = 2 :: Word32   s6 = 3 :: Word32   s11 = 1 :: Word32
SBVTestSuite/GoldFiles/basic-2_1.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s1 = 3 :: Word8 TABLES ARRAYS
SBVTestSuite/GoldFiles/basic-2_2.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s1 = 9 :: Word8 TABLES ARRAYS
SBVTestSuite/GoldFiles/basic-2_3.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s1 = 3 :: Word8 TABLES ARRAYS
SBVTestSuite/GoldFiles/basic-2_4.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s1 = 3 :: Word8 TABLES ARRAYS
SBVTestSuite/GoldFiles/basic-3_1.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-3_2.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-3_3.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-3_4.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-3_5.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "y" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s2 = 1 :: Word8 TABLES ARRAYS
SBVTestSuite/GoldFiles/basic-4_1.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "x" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-4_2.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "x" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-4_3.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "x" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-4_4.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "x" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-4_5.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "x" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s1 = 1 :: Word8 TABLES ARRAYS
SBVTestSuite/GoldFiles/basic-5_1.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "q" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-5_2.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "q" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-5_3.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "q" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-5_4.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "q" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/basic-5_5.gold view
@@ -2,8 +2,6 @@   s0 :: SWord8, aliasing "x"   s1 :: SWord8, aliasing "q" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s2 = 1 :: Word8 TABLES ARRAYS
SBVTestSuite/GoldFiles/ccitt.gold view
@@ -4,8 +4,6 @@   s2 :: SWord32   s3 :: SWord16 CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s13 = 0 :: Word1   s1686 = 0 :: Word8   s1687 = 1 :: Word8
SBVTestSuite/GoldFiles/coins.gold view
@@ -6,8 +6,6 @@   s54 :: SWord16, existential, aliasing "c5"   s66 :: SWord16, existential, aliasing "c6" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s1 = 1 :: Word16   s3 = 5 :: Word16   s5 = 10 :: Word16
SBVTestSuite/GoldFiles/concreteFoldl.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/concreteFoldr.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/concreteReverse.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/concreteSort.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/counts.gold view
@@ -10,8 +10,6 @@   s8 :: SWord8   s9 :: SWord8 CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s10 = 10 :: Word8   s12 = 0 :: Word8   s32 = 2 :: Word8
SBVTestSuite/GoldFiles/crcPolyExist.gold view
@@ -5,8 +5,6 @@   s3 :: SWord32, aliasing "rh"   s4 :: SWord16, aliasing "rl" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s6 = 0 :: Word1   s18 = 1 :: Word8   s3340 = 0 :: Word8@@ -1558,7 +1556,7 @@   s1545 :: SBool = if s1483 then s1544 else s1543   s1546 :: SBool = s255 ^ s1545   s1547 :: SBool = if s1515 then s1546 else s1545-  s1548 :: SBool = if s1067 then s7 else s_2+  s1548 :: SBool = s7 & s1067   s1549 :: SBool = s493 ^ s1548   s1550 :: SBool = if s1099 then s1549 else s1548   s1551 :: SBool = s463 ^ s1550@@ -2853,7 +2851,7 @@   s2840 :: SBool = if s2778 then s2839 else s2838   s2841 :: SBool = s255 ^ s2840   s2842 :: SBool = if s2810 then s2841 else s2840-  s2843 :: SBool = if s2362 then s7 else s_2+  s2843 :: SBool = s7 & s2362   s2844 :: SBool = s493 ^ s2843   s2845 :: SBool = if s2394 then s2844 else s2843   s2846 :: SBool = s463 ^ s2845@@ -2885,7 +2883,7 @@   s2872 :: SBool = s255 ^ s2871   s2873 :: SBool = if s2842 then s2872 else s2871   s2874 :: SBool = s1578 ^ s2873-  s2875 :: SBool = if s1099 then s7 else s_2+  s2875 :: SBool = s7 & s1099   s2876 :: SBool = s493 ^ s2875   s2877 :: SBool = if s1131 then s2876 else s2875   s2878 :: SBool = s463 ^ s2877@@ -2914,7 +2912,7 @@   s2901 :: SBool = if s1515 then s2900 else s2899   s2902 :: SBool = s259 ^ s2901   s2903 :: SBool = if s1547 then s2902 else s2901-  s2904 :: SBool = if s2394 then s7 else s_2+  s2904 :: SBool = s7 & s2394   s2905 :: SBool = s493 ^ s2904   s2906 :: SBool = if s2426 then s2905 else s2904   s2907 :: SBool = s463 ^ s2906@@ -2944,7 +2942,7 @@   s2931 :: SBool = s259 ^ s2930   s2932 :: SBool = if s2842 then s2931 else s2930   s2933 :: SBool = s2903 ^ s2932-  s2934 :: SBool = if s1131 then s7 else s_2+  s2934 :: SBool = s7 & s1131   s2935 :: SBool = s493 ^ s2934   s2936 :: SBool = if s1163 then s2935 else s2934   s2937 :: SBool = s463 ^ s2936@@ -2971,7 +2969,7 @@   s2958 :: SBool = if s1515 then s2957 else s2956   s2959 :: SBool = s265 ^ s2958   s2960 :: SBool = if s1547 then s2959 else s2958-  s2961 :: SBool = if s2426 then s7 else s_2+  s2961 :: SBool = s7 & s2426   s2962 :: SBool = s493 ^ s2961   s2963 :: SBool = if s2458 then s2962 else s2961   s2964 :: SBool = s463 ^ s2963@@ -2999,7 +2997,7 @@   s2986 :: SBool = s265 ^ s2985   s2987 :: SBool = if s2842 then s2986 else s2985   s2988 :: SBool = s2960 ^ s2987-  s2989 :: SBool = if s1163 then s7 else s_2+  s2989 :: SBool = s7 & s1163   s2990 :: SBool = s493 ^ s2989   s2991 :: SBool = if s1195 then s2990 else s2989   s2992 :: SBool = s463 ^ s2991@@ -3024,7 +3022,7 @@   s3011 :: SBool = if s1515 then s3010 else s3009   s3012 :: SBool = s273 ^ s3011   s3013 :: SBool = if s1547 then s3012 else s3011-  s3014 :: SBool = if s2458 then s7 else s_2+  s3014 :: SBool = s7 & s2458   s3015 :: SBool = s493 ^ s3014   s3016 :: SBool = if s2490 then s3015 else s3014   s3017 :: SBool = s463 ^ s3016@@ -3050,7 +3048,7 @@   s3037 :: SBool = s273 ^ s3036   s3038 :: SBool = if s2842 then s3037 else s3036   s3039 :: SBool = s3013 ^ s3038-  s3040 :: SBool = if s1195 then s7 else s_2+  s3040 :: SBool = s7 & s1195   s3041 :: SBool = s493 ^ s3040   s3042 :: SBool = if s1227 then s3041 else s3040   s3043 :: SBool = s463 ^ s3042@@ -3073,7 +3071,7 @@   s3060 :: SBool = if s1515 then s3059 else s3058   s3061 :: SBool = s283 ^ s3060   s3062 :: SBool = if s1547 then s3061 else s3060-  s3063 :: SBool = if s2490 then s7 else s_2+  s3063 :: SBool = s7 & s2490   s3064 :: SBool = s493 ^ s3063   s3065 :: SBool = if s2522 then s3064 else s3063   s3066 :: SBool = s463 ^ s3065@@ -3097,7 +3095,7 @@   s3084 :: SBool = s283 ^ s3083   s3085 :: SBool = if s2842 then s3084 else s3083   s3086 :: SBool = s3062 ^ s3085-  s3087 :: SBool = if s1227 then s7 else s_2+  s3087 :: SBool = s7 & s1227   s3088 :: SBool = s493 ^ s3087   s3089 :: SBool = if s1259 then s3088 else s3087   s3090 :: SBool = s463 ^ s3089@@ -3118,7 +3116,7 @@   s3105 :: SBool = if s1515 then s3104 else s3103   s3106 :: SBool = s295 ^ s3105   s3107 :: SBool = if s1547 then s3106 else s3105-  s3108 :: SBool = if s2522 then s7 else s_2+  s3108 :: SBool = s7 & s2522   s3109 :: SBool = s493 ^ s3108   s3110 :: SBool = if s2554 then s3109 else s3108   s3111 :: SBool = s463 ^ s3110@@ -3140,7 +3138,7 @@   s3127 :: SBool = s295 ^ s3126   s3128 :: SBool = if s2842 then s3127 else s3126   s3129 :: SBool = s3107 ^ s3128-  s3130 :: SBool = if s1259 then s7 else s_2+  s3130 :: SBool = s7 & s1259   s3131 :: SBool = s493 ^ s3130   s3132 :: SBool = if s1291 then s3131 else s3130   s3133 :: SBool = s463 ^ s3132@@ -3159,7 +3157,7 @@   s3146 :: SBool = if s1515 then s3145 else s3144   s3147 :: SBool = s309 ^ s3146   s3148 :: SBool = if s1547 then s3147 else s3146-  s3149 :: SBool = if s2554 then s7 else s_2+  s3149 :: SBool = s7 & s2554   s3150 :: SBool = s493 ^ s3149   s3151 :: SBool = if s2586 then s3150 else s3149   s3152 :: SBool = s463 ^ s3151@@ -3179,7 +3177,7 @@   s3166 :: SBool = s309 ^ s3165   s3167 :: SBool = if s2842 then s3166 else s3165   s3168 :: SBool = s3148 ^ s3167-  s3169 :: SBool = if s1291 then s7 else s_2+  s3169 :: SBool = s7 & s1291   s3170 :: SBool = s493 ^ s3169   s3171 :: SBool = if s1323 then s3170 else s3169   s3172 :: SBool = s463 ^ s3171@@ -3196,7 +3194,7 @@   s3183 :: SBool = if s1515 then s3182 else s3181   s3184 :: SBool = s325 ^ s3183   s3185 :: SBool = if s1547 then s3184 else s3183-  s3186 :: SBool = if s2586 then s7 else s_2+  s3186 :: SBool = s7 & s2586   s3187 :: SBool = s493 ^ s3186   s3188 :: SBool = if s2618 then s3187 else s3186   s3189 :: SBool = s463 ^ s3188@@ -3214,7 +3212,7 @@   s3201 :: SBool = s325 ^ s3200   s3202 :: SBool = if s2842 then s3201 else s3200   s3203 :: SBool = s3185 ^ s3202-  s3204 :: SBool = if s1323 then s7 else s_2+  s3204 :: SBool = s7 & s1323   s3205 :: SBool = s493 ^ s3204   s3206 :: SBool = if s1355 then s3205 else s3204   s3207 :: SBool = s463 ^ s3206@@ -3229,7 +3227,7 @@   s3216 :: SBool = if s1515 then s3215 else s3214   s3217 :: SBool = s343 ^ s3216   s3218 :: SBool = if s1547 then s3217 else s3216-  s3219 :: SBool = if s2618 then s7 else s_2+  s3219 :: SBool = s7 & s2618   s3220 :: SBool = s493 ^ s3219   s3221 :: SBool = if s2650 then s3220 else s3219   s3222 :: SBool = s463 ^ s3221@@ -3245,7 +3243,7 @@   s3232 :: SBool = s343 ^ s3231   s3233 :: SBool = if s2842 then s3232 else s3231   s3234 :: SBool = s3218 ^ s3233-  s3235 :: SBool = if s1355 then s7 else s_2+  s3235 :: SBool = s7 & s1355   s3236 :: SBool = s493 ^ s3235   s3237 :: SBool = if s1387 then s3236 else s3235   s3238 :: SBool = s463 ^ s3237@@ -3258,7 +3256,7 @@   s3245 :: SBool = if s1515 then s3244 else s3243   s3246 :: SBool = s363 ^ s3245   s3247 :: SBool = if s1547 then s3246 else s3245-  s3248 :: SBool = if s2650 then s7 else s_2+  s3248 :: SBool = s7 & s2650   s3249 :: SBool = s493 ^ s3248   s3250 :: SBool = if s2682 then s3249 else s3248   s3251 :: SBool = s463 ^ s3250@@ -3272,7 +3270,7 @@   s3259 :: SBool = s363 ^ s3258   s3260 :: SBool = if s2842 then s3259 else s3258   s3261 :: SBool = s3247 ^ s3260-  s3262 :: SBool = if s1387 then s7 else s_2+  s3262 :: SBool = s7 & s1387   s3263 :: SBool = s493 ^ s3262   s3264 :: SBool = if s1419 then s3263 else s3262   s3265 :: SBool = s463 ^ s3264@@ -3283,7 +3281,7 @@   s3270 :: SBool = if s1515 then s3269 else s3268   s3271 :: SBool = s385 ^ s3270   s3272 :: SBool = if s1547 then s3271 else s3270-  s3273 :: SBool = if s2682 then s7 else s_2+  s3273 :: SBool = s7 & s2682   s3274 :: SBool = s493 ^ s3273   s3275 :: SBool = if s2714 then s3274 else s3273   s3276 :: SBool = s463 ^ s3275@@ -3295,7 +3293,7 @@   s3282 :: SBool = s385 ^ s3281   s3283 :: SBool = if s2842 then s3282 else s3281   s3284 :: SBool = s3272 ^ s3283-  s3285 :: SBool = if s1419 then s7 else s_2+  s3285 :: SBool = s7 & s1419   s3286 :: SBool = s493 ^ s3285   s3287 :: SBool = if s1451 then s3286 else s3285   s3288 :: SBool = s463 ^ s3287@@ -3304,7 +3302,7 @@   s3291 :: SBool = if s1515 then s3290 else s3289   s3292 :: SBool = s409 ^ s3291   s3293 :: SBool = if s1547 then s3292 else s3291-  s3294 :: SBool = if s2714 then s7 else s_2+  s3294 :: SBool = s7 & s2714   s3295 :: SBool = s493 ^ s3294   s3296 :: SBool = if s2746 then s3295 else s3294   s3297 :: SBool = s463 ^ s3296@@ -3314,14 +3312,14 @@   s3301 :: SBool = s409 ^ s3300   s3302 :: SBool = if s2842 then s3301 else s3300   s3303 :: SBool = s3293 ^ s3302-  s3304 :: SBool = if s1451 then s7 else s_2+  s3304 :: SBool = s7 & s1451   s3305 :: SBool = s493 ^ s3304   s3306 :: SBool = if s1483 then s3305 else s3304   s3307 :: SBool = s463 ^ s3306   s3308 :: SBool = if s1515 then s3307 else s3306   s3309 :: SBool = s435 ^ s3308   s3310 :: SBool = if s1547 then s3309 else s3308-  s3311 :: SBool = if s2746 then s7 else s_2+  s3311 :: SBool = s7 & s2746   s3312 :: SBool = s493 ^ s3311   s3313 :: SBool = if s2778 then s3312 else s3311   s3314 :: SBool = s463 ^ s3313@@ -3329,26 +3327,26 @@   s3316 :: SBool = s435 ^ s3315   s3317 :: SBool = if s2842 then s3316 else s3315   s3318 :: SBool = s3310 ^ s3317-  s3319 :: SBool = if s1483 then s7 else s_2+  s3319 :: SBool = s7 & s1483   s3320 :: SBool = s493 ^ s3319   s3321 :: SBool = if s1515 then s3320 else s3319   s3322 :: SBool = s463 ^ s3321   s3323 :: SBool = if s1547 then s3322 else s3321-  s3324 :: SBool = if s2778 then s7 else s_2+  s3324 :: SBool = s7 & s2778   s3325 :: SBool = s493 ^ s3324   s3326 :: SBool = if s2810 then s3325 else s3324   s3327 :: SBool = s463 ^ s3326   s3328 :: SBool = if s2842 then s3327 else s3326   s3329 :: SBool = s3323 ^ s3328-  s3330 :: SBool = if s1515 then s7 else s_2+  s3330 :: SBool = s7 & s1515   s3331 :: SBool = s493 ^ s3330   s3332 :: SBool = if s1547 then s3331 else s3330-  s3333 :: SBool = if s2810 then s7 else s_2+  s3333 :: SBool = s7 & s2810   s3334 :: SBool = s493 ^ s3333   s3335 :: SBool = if s2842 then s3334 else s3333   s3336 :: SBool = s3332 ^ s3335-  s3337 :: SBool = if s1547 then s7 else s_2-  s3338 :: SBool = if s2842 then s7 else s_2+  s3337 :: SBool = s7 & s1547+  s3338 :: SBool = s7 & s2842   s3339 :: SBool = s3337 ^ s3338   s3341 :: SWord8 = if s3339 then s18 else s3340   s3342 :: SWord8 = s18 + s3341
SBVTestSuite/GoldFiles/exceptionLocal1.gold view
@@ -4,11 +4,10 @@ ** Backend solver Yices does not support global decls. ** Some incremental calls, such as pop, will be limited. [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 1) #b0) [GOOD] (define-fun s68 () (_ BitVec 32) #x00000001) [GOOD] ; --- skolem constants ---@@ -58,7 +57,7 @@ *** ***    Sent      : (define-fun s35 () (_ BitVec 32) (bvmul s34 s34)) ***    Expected  : success-***    Received  : (error "at line 42, column 35: in bvmul: maximal polynomial degree exceeded")+***    Received  : (error "at line 40, column 35: in bvmul: maximal polynomial degree exceeded") *** ***    Exit code : ExitSuccess ***    Executable: /usr/local/bin/yices-smt2
SBVTestSuite/GoldFiles/exceptionLocal2.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_LIA) ; NB. User specified. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s1 () Real (/ 2.0 1.0)) [GOOD] ; --- skolem constants --- [FAIL] (declare-fun s0 () Real) ; tracks user variable "x"@@ -18,7 +17,7 @@ *** ***    Sent      : (declare-fun s0 () Real) ; tracks user variable "x" ***    Expected  : success-***    Received  : (error "line 10 column 23: logic does not support reals")+***    Received  : (error "line 8 column 23: logic does not support reals") *** ***    Exit code : ExitFailure (-15) ***    Executable: /usr/local/bin/z3
SBVTestSuite/GoldFiles/foldlABC1.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () Int 0) [GOOD] (define-fun s19 () Int 1) [GOOD] (define-fun s12 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/foldlABC2.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () Int 0) [GOOD] (define-fun s19 () Int 1) [GOOD] (define-fun s12 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/foldlABC3.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () Int 0) [GOOD] (define-fun s19 () Int 1) [GOOD] (define-fun s12 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/foldrAB1.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () Int 0) [GOOD] (define-fun s15 () Int 1) [GOOD] (define-fun s8 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/foldrAB2.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () Int 0) [GOOD] (define-fun s15 () Int 1) [GOOD] (define-fun s8 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/foldrAB3.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () Int 0) [GOOD] (define-fun s15 () Int 1) [GOOD] (define-fun s8 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/freshVars.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s1 () Int 0) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () Int) ; tracks user variable "a"@@ -210,8 +209,8 @@   mustBe42 =                   42 :: Integer   mustBeX  =                  'X' :: Char   vString  =              "hello" :: String-  vList1   =            [1,2,3,4] :: [SInteger]-  vList2   =  [[1,2,3],[4,5,6,7]] :: [[SInteger]]-  vList3   =                [1,2] :: [SWord8]-  vList4   = [[1,2,3],[],[4,5,6]] :: [[SWord16]]+  vList1   =            [1,2,3,4] :: [Integer]+  vList2   =  [[1,2,3],[4,5,6,7]] :: [[Integer]]+  vList3   =                [1,2] :: [Word8]+  vList4   = [[1,2,3],[],[4,5,6]] :: [[Word16]] DONE!
SBVTestSuite/GoldFiles/genBenchMark1.gold view
@@ -3,9 +3,8 @@ (set-option :produce-models true) (set-logic QF_BV) ; --- uninterpreted sorts ---+; --- tuples --- ; --- literal constants ----(define-fun s_2 () Bool false)-(define-fun s_1 () Bool true) (define-fun s1 () (_ BitVec 8) #x01) ; --- skolem constants --- (declare-fun s0 () (_ BitVec 8))
SBVTestSuite/GoldFiles/genBenchMark2.gold view
@@ -3,9 +3,8 @@ (set-option :produce-models true) (set-logic QF_BV) ; --- uninterpreted sorts ---+; --- tuples --- ; --- literal constants ----(define-fun s_2 () Bool false)-(define-fun s_1 () Bool true) (define-fun s1 () (_ BitVec 8) #x01) ; --- skolem constants --- (declare-fun s0 () (_ BitVec 8))
SBVTestSuite/GoldFiles/iteTest1.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "x" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/iteTest2.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "x" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/iteTest3.gold view
@@ -1,8 +1,6 @@ INPUTS   s0 :: SWord8, aliasing "x" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool TABLES ARRAYS UNINTERPRETED CONSTANTS
SBVTestSuite/GoldFiles/legato.gold view
@@ -7,8 +7,6 @@   s5 :: SBool, existential, aliasing "flagC"   s6 :: SBool, existential, aliasing "flagZ" CONSTANTS-  s_2 = False :: Bool-  s_1 = True :: Bool   s10 = 0 :: Word1   s8 = 0 :: Word8   s14 = 128 :: Word8@@ -22,14 +20,14 @@ DEFINE   s9 :: SWord1 = choose [0:0] s0   s11 :: SBool = s9 /= s10-  s12 :: SBool = s_2 == s11+  s12 :: SBool = false == s11   s13 :: SWord8 = s0 >>> 1   s15 :: SWord8 = s13 | s14   s17 :: SWord8 = s13 & s16   s18 :: SWord8 = if s5 then s15 else s17   s19 :: SWord1 = choose [0:0] s18   s20 :: SBool = s10 /= s19-  s21 :: SBool = s_2 == s20+  s21 :: SBool = false == s20   s22 :: SWord1 = choose [0:0] s2   s23 :: SBool = s10 /= s22   s24 :: SWord8 = s18 >>> 1@@ -38,7 +36,7 @@   s27 :: SWord8 = if s23 then s25 else s26   s28 :: SWord1 = choose [0:0] s27   s29 :: SBool = s10 /= s28-  s30 :: SBool = s_2 == s29+  s30 :: SBool = false == s29   s31 :: SWord8 = s2 >>> 1   s32 :: SWord8 = s16 & s31   s33 :: SWord1 = choose [0:0] s32@@ -49,7 +47,7 @@   s38 :: SWord8 = if s34 then s36 else s37   s39 :: SWord1 = choose [0:0] s38   s40 :: SBool = s10 /= s39-  s41 :: SBool = s_2 == s40+  s41 :: SBool = false == s40   s42 :: SWord8 = if s11 then s14 else s8   s43 :: SWord1 = choose [0:0] s42   s44 :: SBool = s10 /= s43@@ -65,7 +63,7 @@   s54 :: SWord8 = if s50 then s52 else s53   s55 :: SWord1 = choose [0:0] s54   s56 :: SBool = s10 /= s55-  s57 :: SBool = s_2 == s56+  s57 :: SBool = false == s56   s58 :: SWord8 = s42 >>> 1   s59 :: SWord8 = s14 | s58   s60 :: SWord8 = s16 & s58@@ -84,7 +82,7 @@   s73 :: SWord8 = if s69 then s71 else s72   s74 :: SWord1 = choose [0:0] s73   s75 :: SBool = s10 /= s74-  s76 :: SBool = s_2 == s75+  s76 :: SBool = false == s75   s77 :: SWord8 = s61 >>> 1   s78 :: SWord8 = s14 | s77   s79 :: SWord8 = s16 & s77@@ -103,7 +101,7 @@   s92 :: SWord8 = if s88 then s90 else s91   s93 :: SWord1 = choose [0:0] s92   s94 :: SBool = s10 /= s93-  s95 :: SBool = s_2 == s94+  s95 :: SBool = false == s94   s96 :: SWord8 = s80 >>> 1   s97 :: SWord8 = s14 | s96   s98 :: SWord8 = s16 & s96@@ -122,7 +120,7 @@   s111 :: SWord8 = if s107 then s109 else s110   s112 :: SWord1 = choose [0:0] s111   s113 :: SBool = s10 /= s112-  s114 :: SBool = s_2 == s113+  s114 :: SBool = false == s113   s115 :: SWord8 = s99 >>> 1   s116 :: SWord8 = s14 | s115   s117 :: SWord8 = s16 & s115@@ -227,7 +225,7 @@   s216 :: SWord8 = if s215 then s109 else s110   s217 :: SWord1 = choose [0:0] s216   s218 :: SBool = s10 /= s217-  s219 :: SBool = s_2 == s218+  s219 :: SBool = false == s218   s220 :: SBool = s210 < s1   s221 :: SBool = s210 < s99   s222 :: SBool = s220 | s221@@ -336,7 +334,7 @@   s325 :: SWord8 = if s324 then s90 else s91   s326 :: SWord1 = choose [0:0] s325   s327 :: SBool = s10 /= s326-  s328 :: SBool = s_2 == s327+  s328 :: SBool = false == s327   s329 :: SBool = s319 < s1   s330 :: SBool = s319 < s80   s331 :: SBool = s329 | s330@@ -358,7 +356,7 @@   s347 :: SWord8 = if s343 then s345 else s346   s348 :: SWord1 = choose [0:0] s347   s349 :: SBool = s10 /= s348-  s350 :: SBool = s_2 == s349+  s350 :: SBool = false == s349   s351 :: SWord8 = s335 >>> 1   s352 :: SWord8 = s14 | s351   s353 :: SWord8 = s16 & s351@@ -463,7 +461,7 @@   s452 :: SWord8 = if s451 then s345 else s346   s453 :: SWord1 = choose [0:0] s452   s454 :: SBool = s10 /= s453-  s455 :: SBool = s_2 == s454+  s455 :: SBool = false == s454   s456 :: SBool = s446 < s1   s457 :: SBool = s446 < s335   s458 :: SBool = s456 | s457@@ -573,7 +571,7 @@   s562 :: SWord8 = if s561 then s71 else s72   s563 :: SWord1 = choose [0:0] s562   s564 :: SBool = s10 /= s563-  s565 :: SBool = s_2 == s564+  s565 :: SBool = false == s564   s566 :: SBool = s556 < s1   s567 :: SBool = s556 < s61   s568 :: SBool = s566 | s567@@ -595,7 +593,7 @@   s584 :: SWord8 = if s580 then s582 else s583   s585 :: SWord1 = choose [0:0] s584   s586 :: SBool = s10 /= s585-  s587 :: SBool = s_2 == s586+  s587 :: SBool = false == s586   s588 :: SWord8 = s572 >>> 1   s589 :: SWord8 = s14 | s588   s590 :: SWord8 = s16 & s588@@ -614,7 +612,7 @@   s603 :: SWord8 = if s599 then s601 else s602   s604 :: SWord1 = choose [0:0] s603   s605 :: SBool = s10 /= s604-  s606 :: SBool = s_2 == s605+  s606 :: SBool = false == s605   s607 :: SWord8 = s591 >>> 1   s608 :: SWord8 = s14 | s607   s609 :: SWord8 = s16 & s607@@ -719,7 +717,7 @@   s708 :: SWord8 = if s707 then s601 else s602   s709 :: SWord1 = choose [0:0] s708   s710 :: SBool = s10 /= s709-  s711 :: SBool = s_2 == s710+  s711 :: SBool = false == s710   s712 :: SBool = s702 < s1   s713 :: SBool = s702 < s591   s714 :: SBool = s712 | s713@@ -828,7 +826,7 @@   s817 :: SWord8 = if s816 then s582 else s583   s818 :: SWord1 = choose [0:0] s817   s819 :: SBool = s10 /= s818-  s820 :: SBool = s_2 == s819+  s820 :: SBool = false == s819   s821 :: SBool = s811 < s1   s822 :: SBool = s811 < s572   s823 :: SBool = s821 | s822@@ -850,7 +848,7 @@   s839 :: SWord8 = if s835 then s837 else s838   s840 :: SWord1 = choose [0:0] s839   s841 :: SBool = s10 /= s840-  s842 :: SBool = s_2 == s841+  s842 :: SBool = false == s841   s843 :: SWord8 = s827 >>> 1   s844 :: SWord8 = s14 | s843   s845 :: SWord8 = s16 & s843@@ -955,7 +953,7 @@   s944 :: SWord8 = if s943 then s837 else s838   s945 :: SWord1 = choose [0:0] s944   s946 :: SBool = s10 /= s945-  s947 :: SBool = s_2 == s946+  s947 :: SBool = false == s946   s948 :: SBool = s938 < s1   s949 :: SBool = s938 < s827   s950 :: SBool = s948 | s949@@ -1066,7 +1064,7 @@   s1055 :: SWord8 = if s1054 then s52 else s53   s1056 :: SWord1 = choose [0:0] s1055   s1057 :: SBool = s10 /= s1056-  s1058 :: SBool = s_2 == s1057+  s1058 :: SBool = false == s1057   s1059 :: SBool = s1049 < s1   s1060 :: SBool = s1049 < s42   s1061 :: SBool = s1059 | s1060@@ -1088,7 +1086,7 @@   s1077 :: SWord8 = if s1073 then s1075 else s1076   s1078 :: SWord1 = choose [0:0] s1077   s1079 :: SBool = s10 /= s1078-  s1080 :: SBool = s_2 == s1079+  s1080 :: SBool = false == s1079   s1081 :: SWord8 = s1065 >>> 1   s1082 :: SWord8 = s14 | s1081   s1083 :: SWord8 = s16 & s1081@@ -1107,7 +1105,7 @@   s1096 :: SWord8 = if s1092 then s1094 else s1095   s1097 :: SWord1 = choose [0:0] s1096   s1098 :: SBool = s10 /= s1097-  s1099 :: SBool = s_2 == s1098+  s1099 :: SBool = false == s1098   s1100 :: SWord8 = s1084 >>> 1   s1101 :: SWord8 = s14 | s1100   s1102 :: SWord8 = s16 & s1100@@ -1126,7 +1124,7 @@   s1115 :: SWord8 = if s1111 then s1113 else s1114   s1116 :: SWord1 = choose [0:0] s1115   s1117 :: SBool = s10 /= s1116-  s1118 :: SBool = s_2 == s1117+  s1118 :: SBool = false == s1117   s1119 :: SWord8 = s1103 >>> 1   s1120 :: SWord8 = s14 | s1119   s1121 :: SWord8 = s16 & s1119@@ -1231,7 +1229,7 @@   s1220 :: SWord8 = if s1219 then s1113 else s1114   s1221 :: SWord1 = choose [0:0] s1220   s1222 :: SBool = s10 /= s1221-  s1223 :: SBool = s_2 == s1222+  s1223 :: SBool = false == s1222   s1224 :: SBool = s1214 < s1   s1225 :: SBool = s1214 < s1103   s1226 :: SBool = s1224 | s1225@@ -1340,7 +1338,7 @@   s1329 :: SWord8 = if s1328 then s1094 else s1095   s1330 :: SWord1 = choose [0:0] s1329   s1331 :: SBool = s10 /= s1330-  s1332 :: SBool = s_2 == s1331+  s1332 :: SBool = false == s1331   s1333 :: SBool = s1323 < s1   s1334 :: SBool = s1323 < s1084   s1335 :: SBool = s1333 | s1334@@ -1362,7 +1360,7 @@   s1351 :: SWord8 = if s1347 then s1349 else s1350   s1352 :: SWord1 = choose [0:0] s1351   s1353 :: SBool = s10 /= s1352-  s1354 :: SBool = s_2 == s1353+  s1354 :: SBool = false == s1353   s1355 :: SWord8 = s1339 >>> 1   s1356 :: SWord8 = s14 | s1355   s1357 :: SWord8 = s16 & s1355@@ -1467,7 +1465,7 @@   s1456 :: SWord8 = if s1455 then s1349 else s1350   s1457 :: SWord1 = choose [0:0] s1456   s1458 :: SBool = s10 /= s1457-  s1459 :: SBool = s_2 == s1458+  s1459 :: SBool = false == s1458   s1460 :: SBool = s1450 < s1   s1461 :: SBool = s1450 < s1339   s1462 :: SBool = s1460 | s1461@@ -1577,7 +1575,7 @@   s1566 :: SWord8 = if s1565 then s1075 else s1076   s1567 :: SWord1 = choose [0:0] s1566   s1568 :: SBool = s10 /= s1567-  s1569 :: SBool = s_2 == s1568+  s1569 :: SBool = false == s1568   s1570 :: SBool = s1560 < s1   s1571 :: SBool = s1560 < s1065   s1572 :: SBool = s1570 | s1571@@ -1599,7 +1597,7 @@   s1588 :: SWord8 = if s1584 then s1586 else s1587   s1589 :: SWord1 = choose [0:0] s1588   s1590 :: SBool = s10 /= s1589-  s1591 :: SBool = s_2 == s1590+  s1591 :: SBool = false == s1590   s1592 :: SWord8 = s1576 >>> 1   s1593 :: SWord8 = s14 | s1592   s1594 :: SWord8 = s16 & s1592@@ -1618,7 +1616,7 @@   s1607 :: SWord8 = if s1603 then s1605 else s1606   s1608 :: SWord1 = choose [0:0] s1607   s1609 :: SBool = s10 /= s1608-  s1610 :: SBool = s_2 == s1609+  s1610 :: SBool = false == s1609   s1611 :: SWord8 = s1595 >>> 1   s1612 :: SWord8 = s14 | s1611   s1613 :: SWord8 = s16 & s1611@@ -1723,7 +1721,7 @@   s1712 :: SWord8 = if s1711 then s1605 else s1606   s1713 :: SWord1 = choose [0:0] s1712   s1714 :: SBool = s10 /= s1713-  s1715 :: SBool = s_2 == s1714+  s1715 :: SBool = false == s1714   s1716 :: SBool = s1706 < s1   s1717 :: SBool = s1706 < s1595   s1718 :: SBool = s1716 | s1717@@ -1832,7 +1830,7 @@   s1821 :: SWord8 = if s1820 then s1586 else s1587   s1822 :: SWord1 = choose [0:0] s1821   s1823 :: SBool = s10 /= s1822-  s1824 :: SBool = s_2 == s1823+  s1824 :: SBool = false == s1823   s1825 :: SBool = s1815 < s1   s1826 :: SBool = s1815 < s1576   s1827 :: SBool = s1825 | s1826@@ -1854,7 +1852,7 @@   s1843 :: SWord8 = if s1839 then s1841 else s1842   s1844 :: SWord1 = choose [0:0] s1843   s1845 :: SBool = s10 /= s1844-  s1846 :: SBool = s_2 == s1845+  s1846 :: SBool = false == s1845   s1847 :: SWord8 = s1831 >>> 1   s1848 :: SWord8 = s14 | s1847   s1849 :: SWord8 = s16 & s1847@@ -1959,7 +1957,7 @@   s1948 :: SWord8 = if s1947 then s1841 else s1842   s1949 :: SWord1 = choose [0:0] s1948   s1950 :: SBool = s10 /= s1949-  s1951 :: SBool = s_2 == s1950+  s1951 :: SBool = false == s1950   s1952 :: SBool = s1942 < s1   s1953 :: SBool = s1942 < s1831   s1954 :: SBool = s1952 | s1953@@ -2071,7 +2069,7 @@   s2060 :: SWord8 = if s2059 then s36 else s37   s2061 :: SWord1 = choose [0:0] s2060   s2062 :: SBool = s10 /= s2061-  s2063 :: SBool = s_2 == s2062+  s2063 :: SBool = false == s2062   s2064 :: SWord8 = s1 >>> 1   s2065 :: SWord8 = s16 & s2064   s2066 :: SWord1 = choose [0:0] s2065@@ -2088,7 +2086,7 @@   s2077 :: SWord8 = if s2073 then s2075 else s2076   s2078 :: SWord1 = choose [0:0] s2077   s2079 :: SBool = s10 /= s2078-  s2080 :: SBool = s_2 == s2079+  s2080 :: SBool = false == s2079   s2081 :: SWord8 = s2065 >>> 1   s2082 :: SWord8 = s14 | s2081   s2083 :: SWord8 = s16 & s2081@@ -2107,7 +2105,7 @@   s2096 :: SWord8 = if s2092 then s2094 else s2095   s2097 :: SWord1 = choose [0:0] s2096   s2098 :: SBool = s10 /= s2097-  s2099 :: SBool = s_2 == s2098+  s2099 :: SBool = false == s2098   s2100 :: SWord8 = s2084 >>> 1   s2101 :: SWord8 = s14 | s2100   s2102 :: SWord8 = s16 & s2100@@ -2126,7 +2124,7 @@   s2115 :: SWord8 = if s2111 then s2113 else s2114   s2116 :: SWord1 = choose [0:0] s2115   s2117 :: SBool = s10 /= s2116-  s2118 :: SBool = s_2 == s2117+  s2118 :: SBool = false == s2117   s2119 :: SWord8 = s2103 >>> 1   s2120 :: SWord8 = s14 | s2119   s2121 :: SWord8 = s16 & s2119@@ -2145,7 +2143,7 @@   s2134 :: SWord8 = if s2130 then s2132 else s2133   s2135 :: SWord1 = choose [0:0] s2134   s2136 :: SBool = s10 /= s2135-  s2137 :: SBool = s_2 == s2136+  s2137 :: SBool = false == s2136   s2138 :: SWord8 = s2122 >>> 1   s2139 :: SWord8 = s14 | s2138   s2140 :: SWord8 = s16 & s2138@@ -2250,7 +2248,7 @@   s2239 :: SWord8 = if s2238 then s2132 else s2133   s2240 :: SWord1 = choose [0:0] s2239   s2241 :: SBool = s10 /= s2240-  s2242 :: SBool = s_2 == s2241+  s2242 :: SBool = false == s2241   s2243 :: SBool = s2233 < s1   s2244 :: SBool = s2233 < s2122   s2245 :: SBool = s2243 | s2244@@ -2359,7 +2357,7 @@   s2348 :: SWord8 = if s2347 then s2113 else s2114   s2349 :: SWord1 = choose [0:0] s2348   s2350 :: SBool = s10 /= s2349-  s2351 :: SBool = s_2 == s2350+  s2351 :: SBool = false == s2350   s2352 :: SBool = s2342 < s1   s2353 :: SBool = s2342 < s2103   s2354 :: SBool = s2352 | s2353@@ -2381,7 +2379,7 @@   s2370 :: SWord8 = if s2366 then s2368 else s2369   s2371 :: SWord1 = choose [0:0] s2370   s2372 :: SBool = s10 /= s2371-  s2373 :: SBool = s_2 == s2372+  s2373 :: SBool = false == s2372   s2374 :: SWord8 = s2358 >>> 1   s2375 :: SWord8 = s14 | s2374   s2376 :: SWord8 = s16 & s2374@@ -2486,7 +2484,7 @@   s2475 :: SWord8 = if s2474 then s2368 else s2369   s2476 :: SWord1 = choose [0:0] s2475   s2477 :: SBool = s10 /= s2476-  s2478 :: SBool = s_2 == s2477+  s2478 :: SBool = false == s2477   s2479 :: SBool = s2469 < s1   s2480 :: SBool = s2469 < s2358   s2481 :: SBool = s2479 | s2480@@ -2596,7 +2594,7 @@   s2585 :: SWord8 = if s2584 then s2094 else s2095   s2586 :: SWord1 = choose [0:0] s2585   s2587 :: SBool = s10 /= s2586-  s2588 :: SBool = s_2 == s2587+  s2588 :: SBool = false == s2587   s2589 :: SBool = s2579 < s1   s2590 :: SBool = s2579 < s2084   s2591 :: SBool = s2589 | s2590@@ -2618,7 +2616,7 @@   s2607 :: SWord8 = if s2603 then s2605 else s2606   s2608 :: SWord1 = choose [0:0] s2607   s2609 :: SBool = s10 /= s2608-  s2610 :: SBool = s_2 == s2609+  s2610 :: SBool = false == s2609   s2611 :: SWord8 = s2595 >>> 1   s2612 :: SWord8 = s14 | s2611   s2613 :: SWord8 = s16 & s2611@@ -2637,7 +2635,7 @@   s2626 :: SWord8 = if s2622 then s2624 else s2625   s2627 :: SWord1 = choose [0:0] s2626   s2628 :: SBool = s10 /= s2627-  s2629 :: SBool = s_2 == s2628+  s2629 :: SBool = false == s2628   s2630 :: SWord8 = s2614 >>> 1   s2631 :: SWord8 = s14 | s2630   s2632 :: SWord8 = s16 & s2630@@ -2742,7 +2740,7 @@   s2731 :: SWord8 = if s2730 then s2624 else s2625   s2732 :: SWord1 = choose [0:0] s2731   s2733 :: SBool = s10 /= s2732-  s2734 :: SBool = s_2 == s2733+  s2734 :: SBool = false == s2733   s2735 :: SBool = s2725 < s1   s2736 :: SBool = s2725 < s2614   s2737 :: SBool = s2735 | s2736@@ -2851,7 +2849,7 @@   s2840 :: SWord8 = if s2839 then s2605 else s2606   s2841 :: SWord1 = choose [0:0] s2840   s2842 :: SBool = s10 /= s2841-  s2843 :: SBool = s_2 == s2842+  s2843 :: SBool = false == s2842   s2844 :: SBool = s2834 < s1   s2845 :: SBool = s2834 < s2595   s2846 :: SBool = s2844 | s2845@@ -2873,7 +2871,7 @@   s2862 :: SWord8 = if s2858 then s2860 else s2861   s2863 :: SWord1 = choose [0:0] s2862   s2864 :: SBool = s10 /= s2863-  s2865 :: SBool = s_2 == s2864+  s2865 :: SBool = false == s2864   s2866 :: SWord8 = s2850 >>> 1   s2867 :: SWord8 = s14 | s2866   s2868 :: SWord8 = s16 & s2866@@ -2978,7 +2976,7 @@   s2967 :: SWord8 = if s2966 then s2860 else s2861   s2968 :: SWord1 = choose [0:0] s2967   s2969 :: SBool = s10 /= s2968-  s2970 :: SBool = s_2 == s2969+  s2970 :: SBool = false == s2969   s2971 :: SBool = s2961 < s1   s2972 :: SBool = s2961 < s2850   s2973 :: SBool = s2971 | s2972@@ -3089,7 +3087,7 @@   s3078 :: SWord8 = if s3077 then s2075 else s2076   s3079 :: SWord1 = choose [0:0] s3078   s3080 :: SBool = s10 /= s3079-  s3081 :: SBool = s_2 == s3080+  s3081 :: SBool = false == s3080   s3082 :: SBool = s3072 < s1   s3083 :: SBool = s3072 < s2065   s3084 :: SBool = s3082 | s3083@@ -3111,7 +3109,7 @@   s3100 :: SWord8 = if s3096 then s3098 else s3099   s3101 :: SWord1 = choose [0:0] s3100   s3102 :: SBool = s10 /= s3101-  s3103 :: SBool = s_2 == s3102+  s3103 :: SBool = false == s3102   s3104 :: SWord8 = s3088 >>> 1   s3105 :: SWord8 = s14 | s3104   s3106 :: SWord8 = s16 & s3104@@ -3130,7 +3128,7 @@   s3119 :: SWord8 = if s3115 then s3117 else s3118   s3120 :: SWord1 = choose [0:0] s3119   s3121 :: SBool = s10 /= s3120-  s3122 :: SBool = s_2 == s3121+  s3122 :: SBool = false == s3121   s3123 :: SWord8 = s3107 >>> 1   s3124 :: SWord8 = s14 | s3123   s3125 :: SWord8 = s16 & s3123@@ -3149,7 +3147,7 @@   s3138 :: SWord8 = if s3134 then s3136 else s3137   s3139 :: SWord1 = choose [0:0] s3138   s3140 :: SBool = s10 /= s3139-  s3141 :: SBool = s_2 == s3140+  s3141 :: SBool = false == s3140   s3142 :: SWord8 = s3126 >>> 1   s3143 :: SWord8 = s14 | s3142   s3144 :: SWord8 = s16 & s3142@@ -3254,7 +3252,7 @@   s3243 :: SWord8 = if s3242 then s3136 else s3137   s3244 :: SWord1 = choose [0:0] s3243   s3245 :: SBool = s10 /= s3244-  s3246 :: SBool = s_2 == s3245+  s3246 :: SBool = false == s3245   s3247 :: SBool = s3237 < s1   s3248 :: SBool = s3237 < s3126   s3249 :: SBool = s3247 | s3248@@ -3363,7 +3361,7 @@   s3352 :: SWord8 = if s3351 then s3117 else s3118   s3353 :: SWord1 = choose [0:0] s3352   s3354 :: SBool = s10 /= s3353-  s3355 :: SBool = s_2 == s3354+  s3355 :: SBool = false == s3354   s3356 :: SBool = s3346 < s1   s3357 :: SBool = s3346 < s3107   s3358 :: SBool = s3356 | s3357@@ -3385,7 +3383,7 @@   s3374 :: SWord8 = if s3370 then s3372 else s3373   s3375 :: SWord1 = choose [0:0] s3374   s3376 :: SBool = s10 /= s3375-  s3377 :: SBool = s_2 == s3376+  s3377 :: SBool = false == s3376   s3378 :: SWord8 = s3362 >>> 1   s3379 :: SWord8 = s14 | s3378   s3380 :: SWord8 = s16 & s3378@@ -3490,7 +3488,7 @@   s3479 :: SWord8 = if s3478 then s3372 else s3373   s3480 :: SWord1 = choose [0:0] s3479   s3481 :: SBool = s10 /= s3480-  s3482 :: SBool = s_2 == s3481+  s3482 :: SBool = false == s3481   s3483 :: SBool = s3473 < s1   s3484 :: SBool = s3473 < s3362   s3485 :: SBool = s3483 | s3484@@ -3600,7 +3598,7 @@   s3589 :: SWord8 = if s3588 then s3098 else s3099   s3590 :: SWord1 = choose [0:0] s3589   s3591 :: SBool = s10 /= s3590-  s3592 :: SBool = s_2 == s3591+  s3592 :: SBool = false == s3591   s3593 :: SBool = s3583 < s1   s3594 :: SBool = s3583 < s3088   s3595 :: SBool = s3593 | s3594@@ -3622,7 +3620,7 @@   s3611 :: SWord8 = if s3607 then s3609 else s3610   s3612 :: SWord1 = choose [0:0] s3611   s3613 :: SBool = s10 /= s3612-  s3614 :: SBool = s_2 == s3613+  s3614 :: SBool = false == s3613   s3615 :: SWord8 = s3599 >>> 1   s3616 :: SWord8 = s14 | s3615   s3617 :: SWord8 = s16 & s3615@@ -3641,7 +3639,7 @@   s3630 :: SWord8 = if s3626 then s3628 else s3629   s3631 :: SWord1 = choose [0:0] s3630   s3632 :: SBool = s10 /= s3631-  s3633 :: SBool = s_2 == s3632+  s3633 :: SBool = false == s3632   s3634 :: SWord8 = s3618 >>> 1   s3635 :: SWord8 = s14 | s3634   s3636 :: SWord8 = s16 & s3634@@ -3746,7 +3744,7 @@   s3735 :: SWord8 = if s3734 then s3628 else s3629   s3736 :: SWord1 = choose [0:0] s3735   s3737 :: SBool = s10 /= s3736-  s3738 :: SBool = s_2 == s3737+  s3738 :: SBool = false == s3737   s3739 :: SBool = s3729 < s1   s3740 :: SBool = s3729 < s3618   s3741 :: SBool = s3739 | s3740@@ -3855,7 +3853,7 @@   s3844 :: SWord8 = if s3843 then s3609 else s3610   s3845 :: SWord1 = choose [0:0] s3844   s3846 :: SBool = s10 /= s3845-  s3847 :: SBool = s_2 == s3846+  s3847 :: SBool = false == s3846   s3848 :: SBool = s3838 < s1   s3849 :: SBool = s3838 < s3599   s3850 :: SBool = s3848 | s3849@@ -3877,7 +3875,7 @@   s3866 :: SWord8 = if s3862 then s3864 else s3865   s3867 :: SWord1 = choose [0:0] s3866   s3868 :: SBool = s10 /= s3867-  s3869 :: SBool = s_2 == s3868+  s3869 :: SBool = false == s3868   s3870 :: SWord8 = s3854 >>> 1   s3871 :: SWord8 = s14 | s3870   s3872 :: SWord8 = s16 & s3870@@ -3982,7 +3980,7 @@   s3971 :: SWord8 = if s3970 then s3864 else s3865   s3972 :: SWord1 = choose [0:0] s3971   s3973 :: SBool = s10 /= s3972-  s3974 :: SBool = s_2 == s3973+  s3974 :: SBool = false == s3973   s3975 :: SBool = s3965 < s1   s3976 :: SBool = s3965 < s3854   s3977 :: SBool = s3975 | s3976
+ SBVTestSuite/GoldFiles/makePair.gold view
@@ -0,0 +1,34 @@+** Calling: z3 -nw -in -smt2+[GOOD] ; Automatically generated by SBV. Do not edit.+[GOOD] (set-option :print-success true)+[GOOD] (set-option :global-declarations true)+[GOOD] (set-option :smtlib2_compliant true)+[GOOD] (set-option :diagnostic-output-channel "stdout")+[GOOD] (set-option :produce-models true)+[GOOD] (set-logic ALL) ; has unbounded values, using catch-all.+[GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples ---+[GOOD] (declare-datatypes (T1 T2) ((tup-2 (mk-tup-2 (proj-1 T1) (proj-2 T2)))))+[GOOD] ; --- literal constants ---+[GOOD] (define-fun s_2 () Bool false)+[GOOD] (define-fun s_1 () Bool true)+[GOOD] (define-fun s6 () Int 0)+[GOOD] ; --- skolem constants ---+[GOOD] (declare-fun s0 () Int) ; tracks user variable "x"+[GOOD] (declare-fun s1 () Int) ; tracks user variable "y"+[GOOD] ; --- constant tables ---+[GOOD] ; --- skolemized tables ---+[GOOD] ; --- arrays ---+[GOOD] ; --- uninterpreted constants ---+[GOOD] ; --- user given axioms ---+[GOOD] ; --- formula ---+[GOOD] (define-fun s2 () (tup-2 Int Int) (mk-tup-2 s0 s1))+[GOOD] (define-fun s3 () Int (proj-1 s2))+[GOOD] (define-fun s4 () Int (proj-2 s2))+[GOOD] (define-fun s5 () Int (+ s3 s4))+[GOOD] (define-fun s7 () Bool (= s5 s6))+[GOOD] (assert s7)+[SEND] (check-sat)+[RECV] sat+*** Solver   : Z3+*** Exit code: ExitSuccess
SBVTestSuite/GoldFiles/mapNoFailure.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s5 () Int 6) [GOOD] (define-fun s7 () Int 0) [GOOD] (define-fun s20 () Int 1)@@ -22,15 +21,15 @@ [GOOD] (declare-fun s1 () Int) ; tracks user variable "b" [GOOD] (declare-fun s2 () Int) ; tracks user variable "c" [GOOD] (declare-fun s57 () Int) ; tracks user variable "__internal_sbv_s57"-[GOOD] (declare-fun s70 () Int) ; tracks user variable "__internal_sbv_s70"-[GOOD] (declare-fun s82 () Int) ; tracks user variable "__internal_sbv_s82"-[GOOD] (declare-fun s94 () Int) ; tracks user variable "__internal_sbv_s94"-[GOOD] (declare-fun s106 () Int) ; tracks user variable "__internal_sbv_s106"-[GOOD] (declare-fun s118 () Int) ; tracks user variable "__internal_sbv_s118"-[GOOD] (declare-fun s130 () Int) ; tracks user variable "__internal_sbv_s130"-[GOOD] (declare-fun s142 () Int) ; tracks user variable "__internal_sbv_s142"-[GOOD] (declare-fun s154 () Int) ; tracks user variable "__internal_sbv_s154"-[GOOD] (declare-fun s166 () Int) ; tracks user variable "__internal_sbv_s166"+[GOOD] (declare-fun s71 () Int) ; tracks user variable "__internal_sbv_s71"+[GOOD] (declare-fun s84 () Int) ; tracks user variable "__internal_sbv_s84"+[GOOD] (declare-fun s97 () Int) ; tracks user variable "__internal_sbv_s97"+[GOOD] (declare-fun s110 () Int) ; tracks user variable "__internal_sbv_s110"+[GOOD] (declare-fun s123 () Int) ; tracks user variable "__internal_sbv_s123"+[GOOD] (declare-fun s136 () Int) ; tracks user variable "__internal_sbv_s136"+[GOOD] (declare-fun s149 () Int) ; tracks user variable "__internal_sbv_s149"+[GOOD] (declare-fun s162 () Int) ; tracks user variable "__internal_sbv_s162"+[GOOD] (declare-fun s175 () Int) ; tracks user variable "__internal_sbv_s175" [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables --- [GOOD] ; --- arrays ---@@ -97,119 +96,129 @@ [GOOD] (define-fun s65 () Bool (< s57 s7)) [GOOD] (define-fun s67 () Bool (> s57 s66)) [GOOD] (define-fun s68 () Bool (or s65 s67))-[GOOD] (define-fun s69 () Bool (ite s56 s_2 s68))-[GOOD] (define-fun s71 () (Seq Int) (seq.unit s70))-[GOOD] (define-fun s72 () Bool (> s53 s7))-[GOOD] (define-fun s73 () Bool (not s72))-[GOOD] (define-fun s74 () (Seq Int) (seq.extract s51 s7 s20))-[GOOD] (define-fun s75 () Bool (= s71 s74))-[GOOD] (define-fun s76 () Bool (or s73 s75))-[GOOD] (define-fun s77 () Bool (< s70 s7))-[GOOD] (define-fun s78 () Bool (> s70 s66))-[GOOD] (define-fun s79 () Bool (or s77 s78))-[GOOD] (define-fun s80 () Bool (or s69 s79))-[GOOD] (define-fun s81 () Bool (ite s52 s_2 s80))-[GOOD] (define-fun s83 () (Seq Int) (seq.unit s82))-[GOOD] (define-fun s84 () Bool (> s49 s7))-[GOOD] (define-fun s85 () Bool (not s84))-[GOOD] (define-fun s86 () (Seq Int) (seq.extract s47 s7 s20))-[GOOD] (define-fun s87 () Bool (= s83 s86))-[GOOD] (define-fun s88 () Bool (or s85 s87))-[GOOD] (define-fun s89 () Bool (< s82 s7))-[GOOD] (define-fun s90 () Bool (> s82 s66))-[GOOD] (define-fun s91 () Bool (or s89 s90))-[GOOD] (define-fun s92 () Bool (or s81 s91))-[GOOD] (define-fun s93 () Bool (ite s48 s_2 s92))-[GOOD] (define-fun s95 () (Seq Int) (seq.unit s94))-[GOOD] (define-fun s96 () Bool (> s45 s7))-[GOOD] (define-fun s97 () Bool (not s96))-[GOOD] (define-fun s98 () (Seq Int) (seq.extract s43 s7 s20))-[GOOD] (define-fun s99 () Bool (= s95 s98))-[GOOD] (define-fun s100 () Bool (or s97 s99))-[GOOD] (define-fun s101 () Bool (< s94 s7))-[GOOD] (define-fun s102 () Bool (> s94 s66))-[GOOD] (define-fun s103 () Bool (or s101 s102))-[GOOD] (define-fun s104 () Bool (or s93 s103))-[GOOD] (define-fun s105 () Bool (ite s44 s_2 s104))-[GOOD] (define-fun s107 () (Seq Int) (seq.unit s106))-[GOOD] (define-fun s108 () Bool (> s41 s7))-[GOOD] (define-fun s109 () Bool (not s108))-[GOOD] (define-fun s110 () (Seq Int) (seq.extract s39 s7 s20))-[GOOD] (define-fun s111 () Bool (= s107 s110))-[GOOD] (define-fun s112 () Bool (or s109 s111))-[GOOD] (define-fun s113 () Bool (< s106 s7))-[GOOD] (define-fun s114 () Bool (> s106 s66))-[GOOD] (define-fun s115 () Bool (or s113 s114))-[GOOD] (define-fun s116 () Bool (or s105 s115))-[GOOD] (define-fun s117 () Bool (ite s40 s_2 s116))-[GOOD] (define-fun s119 () (Seq Int) (seq.unit s118))-[GOOD] (define-fun s120 () Bool (> s37 s7))-[GOOD] (define-fun s121 () Bool (not s120))-[GOOD] (define-fun s122 () (Seq Int) (seq.extract s35 s7 s20))-[GOOD] (define-fun s123 () Bool (= s119 s122))-[GOOD] (define-fun s124 () Bool (or s121 s123))-[GOOD] (define-fun s125 () Bool (< s118 s7))-[GOOD] (define-fun s126 () Bool (> s118 s66))-[GOOD] (define-fun s127 () Bool (or s125 s126))-[GOOD] (define-fun s128 () Bool (or s117 s127))-[GOOD] (define-fun s129 () Bool (ite s36 s_2 s128))-[GOOD] (define-fun s131 () (Seq Int) (seq.unit s130))-[GOOD] (define-fun s132 () Bool (> s33 s7))-[GOOD] (define-fun s133 () Bool (not s132))-[GOOD] (define-fun s134 () (Seq Int) (seq.extract s31 s7 s20))-[GOOD] (define-fun s135 () Bool (= s131 s134))-[GOOD] (define-fun s136 () Bool (or s133 s135))-[GOOD] (define-fun s137 () Bool (< s130 s7))-[GOOD] (define-fun s138 () Bool (> s130 s66))-[GOOD] (define-fun s139 () Bool (or s137 s138))-[GOOD] (define-fun s140 () Bool (or s129 s139))-[GOOD] (define-fun s141 () Bool (ite s32 s_2 s140))-[GOOD] (define-fun s143 () (Seq Int) (seq.unit s142))-[GOOD] (define-fun s144 () Bool (> s29 s7))-[GOOD] (define-fun s145 () Bool (not s144))-[GOOD] (define-fun s146 () (Seq Int) (seq.extract s27 s7 s20))-[GOOD] (define-fun s147 () Bool (= s143 s146))-[GOOD] (define-fun s148 () Bool (or s145 s147))-[GOOD] (define-fun s149 () Bool (< s142 s7))-[GOOD] (define-fun s150 () Bool (> s142 s66))-[GOOD] (define-fun s151 () Bool (or s149 s150))-[GOOD] (define-fun s152 () Bool (or s141 s151))-[GOOD] (define-fun s153 () Bool (ite s28 s_2 s152))-[GOOD] (define-fun s155 () (Seq Int) (seq.unit s154))-[GOOD] (define-fun s156 () Bool (> s25 s7))-[GOOD] (define-fun s157 () Bool (not s156))-[GOOD] (define-fun s158 () (Seq Int) (seq.extract s23 s7 s20))-[GOOD] (define-fun s159 () Bool (= s155 s158))-[GOOD] (define-fun s160 () Bool (or s157 s159))-[GOOD] (define-fun s161 () Bool (< s154 s7))-[GOOD] (define-fun s162 () Bool (> s154 s66))-[GOOD] (define-fun s163 () Bool (or s161 s162))-[GOOD] (define-fun s164 () Bool (or s153 s163))-[GOOD] (define-fun s165 () Bool (ite s24 s_2 s164))-[GOOD] (define-fun s167 () (Seq Int) (seq.unit s166))-[GOOD] (define-fun s168 () Bool (> s21 s7))-[GOOD] (define-fun s169 () Bool (not s168))-[GOOD] (define-fun s170 () (Seq Int) (seq.extract s17 s7 s20))-[GOOD] (define-fun s171 () Bool (= s167 s170))-[GOOD] (define-fun s172 () Bool (or s169 s171))-[GOOD] (define-fun s173 () Bool (< s166 s7))-[GOOD] (define-fun s174 () Bool (> s166 s66))-[GOOD] (define-fun s175 () Bool (or s173 s174))-[GOOD] (define-fun s176 () Bool (or s165 s175))-[GOOD] (define-fun s177 () Bool (ite s19 s_2 s176))+[GOOD] (define-fun s69 () Bool (not s56))+[GOOD] (define-fun s70 () Bool (and s68 s69))+[GOOD] (define-fun s72 () (Seq Int) (seq.unit s71))+[GOOD] (define-fun s73 () Bool (> s53 s7))+[GOOD] (define-fun s74 () Bool (not s73))+[GOOD] (define-fun s75 () (Seq Int) (seq.extract s51 s7 s20))+[GOOD] (define-fun s76 () Bool (= s72 s75))+[GOOD] (define-fun s77 () Bool (or s74 s76))+[GOOD] (define-fun s78 () Bool (< s71 s7))+[GOOD] (define-fun s79 () Bool (> s71 s66))+[GOOD] (define-fun s80 () Bool (or s78 s79))+[GOOD] (define-fun s81 () Bool (or s70 s80))+[GOOD] (define-fun s82 () Bool (not s52))+[GOOD] (define-fun s83 () Bool (and s81 s82))+[GOOD] (define-fun s85 () (Seq Int) (seq.unit s84))+[GOOD] (define-fun s86 () Bool (> s49 s7))+[GOOD] (define-fun s87 () Bool (not s86))+[GOOD] (define-fun s88 () (Seq Int) (seq.extract s47 s7 s20))+[GOOD] (define-fun s89 () Bool (= s85 s88))+[GOOD] (define-fun s90 () Bool (or s87 s89))+[GOOD] (define-fun s91 () Bool (< s84 s7))+[GOOD] (define-fun s92 () Bool (> s84 s66))+[GOOD] (define-fun s93 () Bool (or s91 s92))+[GOOD] (define-fun s94 () Bool (or s83 s93))+[GOOD] (define-fun s95 () Bool (not s48))+[GOOD] (define-fun s96 () Bool (and s94 s95))+[GOOD] (define-fun s98 () (Seq Int) (seq.unit s97))+[GOOD] (define-fun s99 () Bool (> s45 s7))+[GOOD] (define-fun s100 () Bool (not s99))+[GOOD] (define-fun s101 () (Seq Int) (seq.extract s43 s7 s20))+[GOOD] (define-fun s102 () Bool (= s98 s101))+[GOOD] (define-fun s103 () Bool (or s100 s102))+[GOOD] (define-fun s104 () Bool (< s97 s7))+[GOOD] (define-fun s105 () Bool (> s97 s66))+[GOOD] (define-fun s106 () Bool (or s104 s105))+[GOOD] (define-fun s107 () Bool (or s96 s106))+[GOOD] (define-fun s108 () Bool (not s44))+[GOOD] (define-fun s109 () Bool (and s107 s108))+[GOOD] (define-fun s111 () (Seq Int) (seq.unit s110))+[GOOD] (define-fun s112 () Bool (> s41 s7))+[GOOD] (define-fun s113 () Bool (not s112))+[GOOD] (define-fun s114 () (Seq Int) (seq.extract s39 s7 s20))+[GOOD] (define-fun s115 () Bool (= s111 s114))+[GOOD] (define-fun s116 () Bool (or s113 s115))+[GOOD] (define-fun s117 () Bool (< s110 s7))+[GOOD] (define-fun s118 () Bool (> s110 s66))+[GOOD] (define-fun s119 () Bool (or s117 s118))+[GOOD] (define-fun s120 () Bool (or s109 s119))+[GOOD] (define-fun s121 () Bool (not s40))+[GOOD] (define-fun s122 () Bool (and s120 s121))+[GOOD] (define-fun s124 () (Seq Int) (seq.unit s123))+[GOOD] (define-fun s125 () Bool (> s37 s7))+[GOOD] (define-fun s126 () Bool (not s125))+[GOOD] (define-fun s127 () (Seq Int) (seq.extract s35 s7 s20))+[GOOD] (define-fun s128 () Bool (= s124 s127))+[GOOD] (define-fun s129 () Bool (or s126 s128))+[GOOD] (define-fun s130 () Bool (< s123 s7))+[GOOD] (define-fun s131 () Bool (> s123 s66))+[GOOD] (define-fun s132 () Bool (or s130 s131))+[GOOD] (define-fun s133 () Bool (or s122 s132))+[GOOD] (define-fun s134 () Bool (not s36))+[GOOD] (define-fun s135 () Bool (and s133 s134))+[GOOD] (define-fun s137 () (Seq Int) (seq.unit s136))+[GOOD] (define-fun s138 () Bool (> s33 s7))+[GOOD] (define-fun s139 () Bool (not s138))+[GOOD] (define-fun s140 () (Seq Int) (seq.extract s31 s7 s20))+[GOOD] (define-fun s141 () Bool (= s137 s140))+[GOOD] (define-fun s142 () Bool (or s139 s141))+[GOOD] (define-fun s143 () Bool (< s136 s7))+[GOOD] (define-fun s144 () Bool (> s136 s66))+[GOOD] (define-fun s145 () Bool (or s143 s144))+[GOOD] (define-fun s146 () Bool (or s135 s145))+[GOOD] (define-fun s147 () Bool (not s32))+[GOOD] (define-fun s148 () Bool (and s146 s147))+[GOOD] (define-fun s150 () (Seq Int) (seq.unit s149))+[GOOD] (define-fun s151 () Bool (> s29 s7))+[GOOD] (define-fun s152 () Bool (not s151))+[GOOD] (define-fun s153 () (Seq Int) (seq.extract s27 s7 s20))+[GOOD] (define-fun s154 () Bool (= s150 s153))+[GOOD] (define-fun s155 () Bool (or s152 s154))+[GOOD] (define-fun s156 () Bool (< s149 s7))+[GOOD] (define-fun s157 () Bool (> s149 s66))+[GOOD] (define-fun s158 () Bool (or s156 s157))+[GOOD] (define-fun s159 () Bool (or s148 s158))+[GOOD] (define-fun s160 () Bool (not s28))+[GOOD] (define-fun s161 () Bool (and s159 s160))+[GOOD] (define-fun s163 () (Seq Int) (seq.unit s162))+[GOOD] (define-fun s164 () Bool (> s25 s7))+[GOOD] (define-fun s165 () Bool (not s164))+[GOOD] (define-fun s166 () (Seq Int) (seq.extract s23 s7 s20))+[GOOD] (define-fun s167 () Bool (= s163 s166))+[GOOD] (define-fun s168 () Bool (or s165 s167))+[GOOD] (define-fun s169 () Bool (< s162 s7))+[GOOD] (define-fun s170 () Bool (> s162 s66))+[GOOD] (define-fun s171 () Bool (or s169 s170))+[GOOD] (define-fun s172 () Bool (or s161 s171))+[GOOD] (define-fun s173 () Bool (not s24))+[GOOD] (define-fun s174 () Bool (and s172 s173))+[GOOD] (define-fun s176 () (Seq Int) (seq.unit s175))+[GOOD] (define-fun s177 () Bool (> s21 s7))+[GOOD] (define-fun s178 () Bool (not s177))+[GOOD] (define-fun s179 () (Seq Int) (seq.extract s17 s7 s20))+[GOOD] (define-fun s180 () Bool (= s176 s179))+[GOOD] (define-fun s181 () Bool (or s178 s180))+[GOOD] (define-fun s182 () Bool (< s175 s7))+[GOOD] (define-fun s183 () Bool (> s175 s66))+[GOOD] (define-fun s184 () Bool (or s182 s183))+[GOOD] (define-fun s185 () Bool (or s174 s184))+[GOOD] (define-fun s186 () Bool (not s19))+[GOOD] (define-fun s187 () Bool (and s185 s186)) [GOOD] (assert s6) [GOOD] (assert s12) [GOOD] (assert s64)-[GOOD] (assert s76)-[GOOD] (assert s88)-[GOOD] (assert s100)-[GOOD] (assert s112)-[GOOD] (assert s124)-[GOOD] (assert s136)-[GOOD] (assert s148)-[GOOD] (assert s160)-[GOOD] (assert s172)-[GOOD] (assert s177)+[GOOD] (assert s77)+[GOOD] (assert s90)+[GOOD] (assert s103)+[GOOD] (assert s116)+[GOOD] (assert s129)+[GOOD] (assert s142)+[GOOD] (assert s155)+[GOOD] (assert s168)+[GOOD] (assert s181)+[GOOD] (assert s187) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/mapWithFailure.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s8 () Int 0) [GOOD] (define-fun s11 () Int 1) [GOOD] (define-fun s154 () Int 2)@@ -186,53 +185,63 @@ [GOOD] (define-fun s163 () Bool (< s124 s8)) [GOOD] (define-fun s165 () Bool (> s124 s164)) [GOOD] (define-fun s166 () Bool (or s163 s165))-[GOOD] (define-fun s167 () Bool (ite s123 s_2 s166))-[GOOD] (define-fun s168 () Bool (< s111 s8))-[GOOD] (define-fun s169 () Bool (> s111 s164))-[GOOD] (define-fun s170 () Bool (or s168 s169))-[GOOD] (define-fun s171 () Bool (or s167 s170))-[GOOD] (define-fun s172 () Bool (ite s110 s_2 s171))-[GOOD] (define-fun s173 () Bool (< s98 s8))-[GOOD] (define-fun s174 () Bool (> s98 s164))-[GOOD] (define-fun s175 () Bool (or s173 s174))-[GOOD] (define-fun s176 () Bool (or s172 s175))-[GOOD] (define-fun s177 () Bool (ite s97 s_2 s176))-[GOOD] (define-fun s178 () Bool (< s85 s8))-[GOOD] (define-fun s179 () Bool (> s85 s164))-[GOOD] (define-fun s180 () Bool (or s178 s179))-[GOOD] (define-fun s181 () Bool (or s177 s180))-[GOOD] (define-fun s182 () Bool (ite s84 s_2 s181))-[GOOD] (define-fun s183 () Bool (< s72 s8))-[GOOD] (define-fun s184 () Bool (> s72 s164))-[GOOD] (define-fun s185 () Bool (or s183 s184))-[GOOD] (define-fun s186 () Bool (or s182 s185))-[GOOD] (define-fun s187 () Bool (ite s71 s_2 s186))-[GOOD] (define-fun s188 () Bool (< s59 s8))-[GOOD] (define-fun s189 () Bool (> s59 s164))-[GOOD] (define-fun s190 () Bool (or s188 s189))-[GOOD] (define-fun s191 () Bool (or s187 s190))-[GOOD] (define-fun s192 () Bool (ite s58 s_2 s191))-[GOOD] (define-fun s193 () Bool (< s46 s8))-[GOOD] (define-fun s194 () Bool (> s46 s164))+[GOOD] (define-fun s167 () Bool (not s123))+[GOOD] (define-fun s168 () Bool (and s166 s167))+[GOOD] (define-fun s169 () Bool (< s111 s8))+[GOOD] (define-fun s170 () Bool (> s111 s164))+[GOOD] (define-fun s171 () Bool (or s169 s170))+[GOOD] (define-fun s172 () Bool (or s168 s171))+[GOOD] (define-fun s173 () Bool (not s110))+[GOOD] (define-fun s174 () Bool (and s172 s173))+[GOOD] (define-fun s175 () Bool (< s98 s8))+[GOOD] (define-fun s176 () Bool (> s98 s164))+[GOOD] (define-fun s177 () Bool (or s175 s176))+[GOOD] (define-fun s178 () Bool (or s174 s177))+[GOOD] (define-fun s179 () Bool (not s97))+[GOOD] (define-fun s180 () Bool (and s178 s179))+[GOOD] (define-fun s181 () Bool (< s85 s8))+[GOOD] (define-fun s182 () Bool (> s85 s164))+[GOOD] (define-fun s183 () Bool (or s181 s182))+[GOOD] (define-fun s184 () Bool (or s180 s183))+[GOOD] (define-fun s185 () Bool (not s84))+[GOOD] (define-fun s186 () Bool (and s184 s185))+[GOOD] (define-fun s187 () Bool (< s72 s8))+[GOOD] (define-fun s188 () Bool (> s72 s164))+[GOOD] (define-fun s189 () Bool (or s187 s188))+[GOOD] (define-fun s190 () Bool (or s186 s189))+[GOOD] (define-fun s191 () Bool (not s71))+[GOOD] (define-fun s192 () Bool (and s190 s191))+[GOOD] (define-fun s193 () Bool (< s59 s8))+[GOOD] (define-fun s194 () Bool (> s59 s164)) [GOOD] (define-fun s195 () Bool (or s193 s194)) [GOOD] (define-fun s196 () Bool (or s192 s195))-[GOOD] (define-fun s197 () Bool (ite s45 s_2 s196))-[GOOD] (define-fun s198 () Bool (< s33 s8))-[GOOD] (define-fun s199 () Bool (> s33 s164))-[GOOD] (define-fun s200 () Bool (or s198 s199))-[GOOD] (define-fun s201 () Bool (or s197 s200))-[GOOD] (define-fun s202 () Bool (ite s32 s_2 s201))-[GOOD] (define-fun s203 () Bool (< s20 s8))-[GOOD] (define-fun s204 () Bool (> s20 s164))-[GOOD] (define-fun s205 () Bool (or s203 s204))-[GOOD] (define-fun s206 () Bool (or s202 s205))-[GOOD] (define-fun s207 () Bool (ite s19 s_2 s206))-[GOOD] (define-fun s208 () Bool (< s5 s8))-[GOOD] (define-fun s209 () Bool (> s5 s164))-[GOOD] (define-fun s210 () Bool (or s208 s209))-[GOOD] (define-fun s211 () Bool (or s207 s210))-[GOOD] (define-fun s212 () Bool (ite s4 s_2 s211))-[GOOD] (define-fun s213 () Bool (or s162 s212))+[GOOD] (define-fun s197 () Bool (not s58))+[GOOD] (define-fun s198 () Bool (and s196 s197))+[GOOD] (define-fun s199 () Bool (< s46 s8))+[GOOD] (define-fun s200 () Bool (> s46 s164))+[GOOD] (define-fun s201 () Bool (or s199 s200))+[GOOD] (define-fun s202 () Bool (or s198 s201))+[GOOD] (define-fun s203 () Bool (not s45))+[GOOD] (define-fun s204 () Bool (and s202 s203))+[GOOD] (define-fun s205 () Bool (< s33 s8))+[GOOD] (define-fun s206 () Bool (> s33 s164))+[GOOD] (define-fun s207 () Bool (or s205 s206))+[GOOD] (define-fun s208 () Bool (or s204 s207))+[GOOD] (define-fun s209 () Bool (not s32))+[GOOD] (define-fun s210 () Bool (and s208 s209))+[GOOD] (define-fun s211 () Bool (< s20 s8))+[GOOD] (define-fun s212 () Bool (> s20 s164))+[GOOD] (define-fun s213 () Bool (or s211 s212))+[GOOD] (define-fun s214 () Bool (or s210 s213))+[GOOD] (define-fun s215 () Bool (not s19))+[GOOD] (define-fun s216 () Bool (and s214 s215))+[GOOD] (define-fun s217 () Bool (< s5 s8))+[GOOD] (define-fun s218 () Bool (> s5 s164))+[GOOD] (define-fun s219 () Bool (or s217 s218))+[GOOD] (define-fun s220 () Bool (or s216 s219))+[GOOD] (define-fun s221 () Bool (not s4))+[GOOD] (define-fun s222 () Bool (and s220 s221))+[GOOD] (define-fun s223 () Bool (or s162 s222)) [GOOD] (assert s14) [GOOD] (assert s27) [GOOD] (assert s40)@@ -244,7 +253,7 @@ [GOOD] (assert s118) [GOOD] (assert s131) [GOOD] (assert s159)-[GOOD] (assert s213)+[GOOD] (assert s223) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/maxlWithFailure.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () Int 0) [GOOD] (define-fun s4 () Int 1) [GOOD] (define-fun s142 () Int 10)@@ -212,8 +211,9 @@ [GOOD] (define-fun s190 () Bool (ite s34 s155 s189)) [GOOD] (define-fun s191 () Bool (ite s21 s151 s190)) [GOOD] (define-fun s192 () Bool (ite s8 s147 s191))-[GOOD] (define-fun s193 () Bool (ite s2 s_2 s192))-[GOOD] (define-fun s194 () Bool (or s144 s193))+[GOOD] (define-fun s193 () Bool (not s2))+[GOOD] (define-fun s194 () Bool (and s192 s193))+[GOOD] (define-fun s195 () Bool (or s144 s194)) [GOOD] (assert s15) [GOOD] (assert s28) [GOOD] (assert s41)@@ -224,7 +224,7 @@ [GOOD] (assert s106) [GOOD] (assert s119) [GOOD] (assert s129)-[GOOD] (assert s194)+[GOOD] (assert s195) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/maxrWithFailure.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () Int 0) [GOOD] (define-fun s9 () Int 1) [GOOD] (define-fun s142 () Int 10)@@ -167,53 +166,63 @@ [GOOD] (define-fun s145 () Bool (< s104 s3)) [GOOD] (define-fun s146 () Bool (> s104 s142)) [GOOD] (define-fun s147 () Bool (or s145 s146))-[GOOD] (define-fun s148 () Bool (ite s103 s_2 s147))-[GOOD] (define-fun s149 () Bool (< s93 s3))-[GOOD] (define-fun s150 () Bool (> s93 s142))-[GOOD] (define-fun s151 () Bool (or s149 s150))-[GOOD] (define-fun s152 () Bool (or s148 s151))-[GOOD] (define-fun s153 () Bool (ite s92 s_2 s152))-[GOOD] (define-fun s154 () Bool (< s82 s3))-[GOOD] (define-fun s155 () Bool (> s82 s142))-[GOOD] (define-fun s156 () Bool (or s154 s155))-[GOOD] (define-fun s157 () Bool (or s153 s156))-[GOOD] (define-fun s158 () Bool (ite s81 s_2 s157))-[GOOD] (define-fun s159 () Bool (< s71 s3))-[GOOD] (define-fun s160 () Bool (> s71 s142))-[GOOD] (define-fun s161 () Bool (or s159 s160))-[GOOD] (define-fun s162 () Bool (or s158 s161))-[GOOD] (define-fun s163 () Bool (ite s70 s_2 s162))-[GOOD] (define-fun s164 () Bool (< s60 s3))-[GOOD] (define-fun s165 () Bool (> s60 s142))-[GOOD] (define-fun s166 () Bool (or s164 s165))-[GOOD] (define-fun s167 () Bool (or s163 s166))-[GOOD] (define-fun s168 () Bool (ite s59 s_2 s167))-[GOOD] (define-fun s169 () Bool (< s49 s3))-[GOOD] (define-fun s170 () Bool (> s49 s142))-[GOOD] (define-fun s171 () Bool (or s169 s170))-[GOOD] (define-fun s172 () Bool (or s168 s171))-[GOOD] (define-fun s173 () Bool (ite s48 s_2 s172))-[GOOD] (define-fun s174 () Bool (< s38 s3))-[GOOD] (define-fun s175 () Bool (> s38 s142))+[GOOD] (define-fun s148 () Bool (not s103))+[GOOD] (define-fun s149 () Bool (and s147 s148))+[GOOD] (define-fun s150 () Bool (< s93 s3))+[GOOD] (define-fun s151 () Bool (> s93 s142))+[GOOD] (define-fun s152 () Bool (or s150 s151))+[GOOD] (define-fun s153 () Bool (or s149 s152))+[GOOD] (define-fun s154 () Bool (not s92))+[GOOD] (define-fun s155 () Bool (and s153 s154))+[GOOD] (define-fun s156 () Bool (< s82 s3))+[GOOD] (define-fun s157 () Bool (> s82 s142))+[GOOD] (define-fun s158 () Bool (or s156 s157))+[GOOD] (define-fun s159 () Bool (or s155 s158))+[GOOD] (define-fun s160 () Bool (not s81))+[GOOD] (define-fun s161 () Bool (and s159 s160))+[GOOD] (define-fun s162 () Bool (< s71 s3))+[GOOD] (define-fun s163 () Bool (> s71 s142))+[GOOD] (define-fun s164 () Bool (or s162 s163))+[GOOD] (define-fun s165 () Bool (or s161 s164))+[GOOD] (define-fun s166 () Bool (not s70))+[GOOD] (define-fun s167 () Bool (and s165 s166))+[GOOD] (define-fun s168 () Bool (< s60 s3))+[GOOD] (define-fun s169 () Bool (> s60 s142))+[GOOD] (define-fun s170 () Bool (or s168 s169))+[GOOD] (define-fun s171 () Bool (or s167 s170))+[GOOD] (define-fun s172 () Bool (not s59))+[GOOD] (define-fun s173 () Bool (and s171 s172))+[GOOD] (define-fun s174 () Bool (< s49 s3))+[GOOD] (define-fun s175 () Bool (> s49 s142)) [GOOD] (define-fun s176 () Bool (or s174 s175)) [GOOD] (define-fun s177 () Bool (or s173 s176))-[GOOD] (define-fun s178 () Bool (ite s37 s_2 s177))-[GOOD] (define-fun s179 () Bool (< s27 s3))-[GOOD] (define-fun s180 () Bool (> s27 s142))-[GOOD] (define-fun s181 () Bool (or s179 s180))-[GOOD] (define-fun s182 () Bool (or s178 s181))-[GOOD] (define-fun s183 () Bool (ite s26 s_2 s182))-[GOOD] (define-fun s184 () Bool (< s16 s3))-[GOOD] (define-fun s185 () Bool (> s16 s142))-[GOOD] (define-fun s186 () Bool (or s184 s185))-[GOOD] (define-fun s187 () Bool (or s183 s186))-[GOOD] (define-fun s188 () Bool (ite s15 s_2 s187))-[GOOD] (define-fun s189 () Bool (< s4 s3))-[GOOD] (define-fun s190 () Bool (> s4 s142))-[GOOD] (define-fun s191 () Bool (or s189 s190))-[GOOD] (define-fun s192 () Bool (or s188 s191))-[GOOD] (define-fun s193 () Bool (ite s2 s_2 s192))-[GOOD] (define-fun s194 () Bool (or s144 s193))+[GOOD] (define-fun s178 () Bool (not s48))+[GOOD] (define-fun s179 () Bool (and s177 s178))+[GOOD] (define-fun s180 () Bool (< s38 s3))+[GOOD] (define-fun s181 () Bool (> s38 s142))+[GOOD] (define-fun s182 () Bool (or s180 s181))+[GOOD] (define-fun s183 () Bool (or s179 s182))+[GOOD] (define-fun s184 () Bool (not s37))+[GOOD] (define-fun s185 () Bool (and s183 s184))+[GOOD] (define-fun s186 () Bool (< s27 s3))+[GOOD] (define-fun s187 () Bool (> s27 s142))+[GOOD] (define-fun s188 () Bool (or s186 s187))+[GOOD] (define-fun s189 () Bool (or s185 s188))+[GOOD] (define-fun s190 () Bool (not s26))+[GOOD] (define-fun s191 () Bool (and s189 s190))+[GOOD] (define-fun s192 () Bool (< s16 s3))+[GOOD] (define-fun s193 () Bool (> s16 s142))+[GOOD] (define-fun s194 () Bool (or s192 s193))+[GOOD] (define-fun s195 () Bool (or s191 s194))+[GOOD] (define-fun s196 () Bool (not s15))+[GOOD] (define-fun s197 () Bool (and s195 s196))+[GOOD] (define-fun s198 () Bool (< s4 s3))+[GOOD] (define-fun s199 () Bool (> s4 s142))+[GOOD] (define-fun s200 () Bool (or s198 s199))+[GOOD] (define-fun s201 () Bool (or s197 s200))+[GOOD] (define-fun s202 () Bool (not s2))+[GOOD] (define-fun s203 () Bool (and s201 s202))+[GOOD] (define-fun s204 () Bool (or s144 s203)) [GOOD] (assert s12) [GOOD] (assert s23) [GOOD] (assert s34)@@ -224,7 +233,7 @@ [GOOD] (assert s89) [GOOD] (assert s100) [GOOD] (assert s111)-[GOOD] (assert s194)+[GOOD] (assert s204) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/noOpt1.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) [GOOD] ; --- constant tables ---@@ -18,7 +17,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1)
SBVTestSuite/GoldFiles/noOpt2.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) [GOOD] ; --- optimization tracker variables ---@@ -20,7 +19,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1)
SBVTestSuite/GoldFiles/pbAtLeast.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s11 () (_ BitVec 32) #x00000001) [GOOD] (define-fun s12 () (_ BitVec 32) #x00000000) [GOOD] (define-fun s32 () (_ BitVec 32) #x00000005)
SBVTestSuite/GoldFiles/pbAtMost.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s11 () (_ BitVec 32) #x00000001) [GOOD] (define-fun s12 () (_ BitVec 32) #x00000000) [GOOD] (define-fun s32 () (_ BitVec 32) #x00000008)
SBVTestSuite/GoldFiles/pbEq.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s11 () Int 1) [GOOD] (define-fun s12 () Int 0) [GOOD] (define-fun s14 () Int 2)
SBVTestSuite/GoldFiles/pbEq2.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () Bool) ; tracks user variable "b0" [GOOD] (declare-fun s1 () Bool) ; tracks user variable "b1"@@ -35,14 +34,14 @@ [GOOD] (define-fun s15 () Bool (ite s2 s13 s14)) [GOOD] (define-fun s16 () Bool (and s12 s15)) [GOOD] (define-fun s17 () Bool (not s16))-[GOOD] (define-fun s18 () Bool (= s_2 s0))-[GOOD] (define-fun s19 () Bool (= s_2 s2))-[GOOD] (define-fun s20 () Bool (= s_2 s4))+[GOOD] (define-fun s18 () Bool (= false s0))+[GOOD] (define-fun s19 () Bool (= false s2))+[GOOD] (define-fun s20 () Bool (= false s4)) [GOOD] (define-fun s21 () Bool (and s3 s20)) [GOOD] (define-fun s22 () Bool (and s19 s21)) [GOOD] (define-fun s23 () Bool (and s1 s22)) [GOOD] (define-fun s24 () Bool (and s18 s23))-[GOOD] (define-fun s25 () Bool (= s_2 s3))+[GOOD] (define-fun s25 () Bool (= false s3)) [GOOD] (define-fun s26 () Bool (and s4 s25)) [GOOD] (define-fun s27 () Bool (and s19 s26)) [GOOD] (define-fun s28 () Bool (and s1 s27))
SBVTestSuite/GoldFiles/pbExactly.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s11 () (_ BitVec 32) #x00000001) [GOOD] (define-fun s12 () (_ BitVec 32) #x00000000) [GOOD] (define-fun s32 () (_ BitVec 32) #x00000005)
SBVTestSuite/GoldFiles/pbGe.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s11 () Int 1) [GOOD] (define-fun s12 () Int 0) [GOOD] (define-fun s14 () Int 2)
SBVTestSuite/GoldFiles/pbLe.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s11 () Int 1) [GOOD] (define-fun s12 () Int 0) [GOOD] (define-fun s14 () Int 2)
SBVTestSuite/GoldFiles/pbMutexed.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s11 () (_ BitVec 32) #x00000001) [GOOD] (define-fun s12 () (_ BitVec 32) #x00000000) [GOOD] ; --- skolem constants ---
SBVTestSuite/GoldFiles/pbStronglyMutexed.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s11 () (_ BitVec 32) #x00000001) [GOOD] (define-fun s12 () (_ BitVec 32) #x00000000) [GOOD] ; --- skolem constants ---
SBVTestSuite/GoldFiles/qEnum1.gold view
@@ -11,9 +11,8 @@ [GOOD] (define-fun BinOp_constrIndex ((x BinOp)) Int           (ite (= x Plus) 0 (ite (= x Minus) 1 2))        )+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () BinOp) ; tracks user variable "p" [GOOD] (declare-fun s1 () BinOp) ; tracks user variable "m"
SBVTestSuite/GoldFiles/qUninterp1.gold view
@@ -8,9 +8,8 @@ [GOOD] (set-logic ALL) ; has user-defined sorts, using catch-all. [GOOD] ; --- uninterpreted sorts --- [GOOD] (declare-sort L 0)  ; N.B. Uninterpreted: L.B: not a nullary constructor+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () L) [GOOD] ; --- constant tables ---@@ -19,7 +18,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat [SEND] (get-value (s0))
SBVTestSuite/GoldFiles/quantified_prove_existsexists_contradiction_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -22,7 +21,7 @@                    (let ((s2 (= s0 s1)))                    (let ((s3 (distinct s0 s1)))                    (let ((s4 (and s2 s3)))-                   (and s4 s_2))))))+                   false))))) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_existsexists_contradiction_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---
SBVTestSuite/GoldFiles/quantified_prove_existsexists_satisfiable_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables ---@@ -22,7 +21,7 @@                         (s1 (_ BitVec 8)))                    (let ((s3 (bvadd s1 s2)))                    (let ((s4 (= s0 s3)))-                   (and s4 s_2)))))+                   false)))) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_existsexists_satisfiable_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_prove_existsexists_thm_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -22,7 +21,7 @@                    (let ((s2 (bvsub s1 s0)))                    (let ((s3 (bvadd s0 s2)))                    (let ((s4 (= s1 s3)))-                   (and s4 s_2))))))+                   false))))) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_existsexists_thm_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---
SBVTestSuite/GoldFiles/quantified_prove_existsforall_contradiction_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y" [GOOD] ; --- constant tables ---@@ -22,7 +21,7 @@                    (let ((s2 (= s0 (s1 s0))))                    (let ((s3 (distinct s0 (s1 s0))))                    (let ((s4 (and s2 s3)))-                   (and s4 s_2))))))+                   false))))) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_existsforall_contradiction_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_prove_existsforall_satisfiable_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y"@@ -22,7 +21,7 @@ [GOOD] (assert (forall ((s0 (_ BitVec 8)))                    (let ((s3 (bvadd (s1 s0) s2)))                    (let ((s4 (= s0 s3)))-                   (and s4 s_2)))))+                   false)))) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_existsforall_satisfiable_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y"
SBVTestSuite/GoldFiles/quantified_prove_existsforall_thm_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y" [GOOD] ; --- constant tables ---@@ -22,7 +21,7 @@                    (let ((s2 (bvsub (s1 s0) s0)))                    (let ((s3 (bvadd s0 s2)))                    (let ((s4 (= (s1 s0) s3)))-                   (and s4 s_2))))))+                   false))))) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_existsforall_thm_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_prove_forallexists_contradiction_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] ; --- constant tables ---@@ -22,7 +21,7 @@                    (let ((s2 (= s0 s1)))                    (let ((s3 (distinct s0 s1)))                    (let ((s4 (and s2 s3)))-                   (and s4 s_2))))))+                   false))))) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_forallexists_contradiction_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_prove_forallexists_satisfiable_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x"@@ -22,7 +21,7 @@ [GOOD] (assert (forall ((s1 (_ BitVec 8)))                    (let ((s3 (bvadd s1 s2)))                    (let ((s4 (= s0 s3)))-                   (and s4 s_2)))))+                   false)))) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_forallexists_satisfiable_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x"
SBVTestSuite/GoldFiles/quantified_prove_forallexists_thm_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] ; --- constant tables ---@@ -22,7 +21,7 @@                    (let ((s2 (bvsub s1 s0)))                    (let ((s3 (bvadd s0 s2)))                    (let ((s4 (= s1 s3)))-                   (and s4 s_2))))))+                   false))))) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_forallexists_thm_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_prove_forallforall_contradiction_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "y"@@ -23,7 +22,7 @@ [GOOD] (define-fun s3 () Bool (distinct s0 s1)) [GOOD] (define-fun s4 () Bool (and s2 s3)) [GOOD] (assert s4)-[GOOD] (assert s_2)+[GOOD] (assert false) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_forallforall_contradiction_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "y"
SBVTestSuite/GoldFiles/quantified_prove_forallforall_satisfiable_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x"@@ -23,7 +22,7 @@ [GOOD] (define-fun s3 () (_ BitVec 8) (bvadd s1 s2)) [GOOD] (define-fun s4 () Bool (= s0 s3)) [GOOD] (assert s4)-[GOOD] (assert s_2)+[GOOD] (assert false) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_forallforall_satisfiable_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x"
SBVTestSuite/GoldFiles/quantified_prove_forallforall_thm_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "y"@@ -23,7 +22,7 @@ [GOOD] (define-fun s3 () (_ BitVec 8) (bvadd s0 s2)) [GOOD] (define-fun s4 () Bool (= s1 s3)) [GOOD] (assert s4)-[GOOD] (assert s_2)+[GOOD] (assert false) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/quantified_prove_forallforall_thm_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "y"
SBVTestSuite/GoldFiles/quantified_sat_existsexists_contradiction_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "y"
SBVTestSuite/GoldFiles/quantified_sat_existsexists_contradiction_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "y"
SBVTestSuite/GoldFiles/quantified_sat_existsexists_satisfiable_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x"
SBVTestSuite/GoldFiles/quantified_sat_existsexists_satisfiable_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x"
SBVTestSuite/GoldFiles/quantified_sat_existsexists_thm_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "y"
SBVTestSuite/GoldFiles/quantified_sat_existsexists_thm_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "y"
SBVTestSuite/GoldFiles/quantified_sat_existsforall_contradiction_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_existsforall_contradiction_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_existsforall_satisfiable_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x"
SBVTestSuite/GoldFiles/quantified_sat_existsforall_satisfiable_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x"
SBVTestSuite/GoldFiles/quantified_sat_existsforall_thm_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_existsforall_thm_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "x" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallexists_contradiction_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallexists_contradiction_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallexists_satisfiable_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y"
SBVTestSuite/GoldFiles/quantified_sat_forallexists_satisfiable_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y"
SBVTestSuite/GoldFiles/quantified_sat_forallexists_thm_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallexists_thm_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s1 ((_ BitVec 8)) (_ BitVec 8)) ; tracks user variable "y" [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallforall_contradiction_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallforall_contradiction_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallforall_satisfiable_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallforall_satisfiable_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallforall_thm_c.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---
SBVTestSuite/GoldFiles/quantified_sat_forallforall_thm_p.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic BV) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---
SBVTestSuite/GoldFiles/query1.gold view
@@ -17,9 +17,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s6 () Int 0) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () Int) ; tracks user variable "a"@@ -60,14 +59,14 @@ [SEND] (get-option :produce-unsat-assumptions) [RECV] unsupported [SEND] (get-option :produce-unsat-cores)-[SKIP] ; :produce-unsat-assumptions line: 44 position: 0+[SKIP] ; :produce-unsat-assumptions line: 42 position: 0 [RECV] true [SEND] (get-option :random-seed) [RECV] 123 [SEND] (get-option :reproducible-resource-limit) [RECV] unsupported [SEND] (get-option :verbosity)-[SKIP] ; :reproducible-resource-limit line: 47 position: 0+[SKIP] ; :reproducible-resource-limit line: 45 position: 0 [RECV] 0 [SEND] (get-option :smt.mbqi) [RECV] true@@ -76,7 +75,7 @@ [SEND] (get-info :reason-unknown) [RECV] (:reason-unknown "state of the most recent check-sat command is not known") [SEND] (get-info :version)-[RECV] (:version "4.8.4")+[RECV] (:version "4.8.5") [SEND] (get-info :status) [RECV] (:status sat) [GOOD] (define-fun s16 () Int 4)@@ -95,7 +94,7 @@ [SEND] (check-sat-assuming (__assumption_proxy_s18_20)) [RECV] sat [SEND] (get-assignment)-[RECV] ((s_1 true) (s7 true) (|a > 0| true) (s15 true) (s_2 false) (s8 true) (a+b_<_12 true) (s17 true) (|later, a > 4| true) (s18 true) (s12 true))+[RECV] ((s7 true) (|a > 0| true) (s15 true) (s8 true) (s17 true) (a+b_<_12 true) (|later, a > 4| true) (s18 true) (s12 true)) [SEND] (get-info :assertion-stack-levels) [RECV] (:assertion-stack-levels 0) [SEND] (get-info :authors)@@ -107,14 +106,14 @@ [SEND] (get-info :reason-unknown) [RECV] (:reason-unknown "unknown") [SEND] (get-info :version)-[RECV] (:version "4.8.4")+[RECV] (:version "4.8.5") [SEND] (get-info :memory) [RECV] unsupported [SEND] (get-info :time)-[SKIP] ; :memory line: 73 position: 0+[SKIP] ; :memory line: 71 position: 0 [RECV] unsupported [SEND] (get-value (s0))-[SKIP] ; :time line: 74 position: 0+[SKIP] ; :time line: 72 position: 0 [RECV] ((s0 5)) [SEND] (get-value (s1)) [RECV] ((s1 1))
SBVTestSuite/GoldFiles/queryArrays1.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_ABV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "a1" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "a2"
SBVTestSuite/GoldFiles/queryArrays2.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_UFBV) ; NB. User specified. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "i" [GOOD] ; --- constant tables ---@@ -18,7 +17,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [GOOD] (define-fun s1 () (_ BitVec 8) #x00) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] (define-fun s3 () (_ BitVec 8) #x02)
SBVTestSuite/GoldFiles/queryArrays3.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_UFBV) ; NB. User specified. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "i" [GOOD] ; --- constant tables ---@@ -18,7 +17,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [GOOD] (define-fun s1 () (_ BitVec 8) #x00) [GOOD] (declare-fun table0 ((_ BitVec 8)) (_ BitVec 8)) [GOOD] (assert (= (table0 #x00) s0))
SBVTestSuite/GoldFiles/queryArrays4.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic QF_UFBV) ; NB. User specified. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "i" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "j"@@ -19,7 +18,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [GOOD] (define-fun s2 () (_ BitVec 8) #x00) [GOOD] (define-fun s3 () (_ BitVec 8) #x01) [GOOD] (define-fun s4 () (_ BitVec 8) #x02)
SBVTestSuite/GoldFiles/queryArrays5.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_ABV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 8)) ; tracks user variable "a" [GOOD] (declare-fun s1 () (_ BitVec 8)) ; tracks user variable "v"@@ -20,7 +19,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [GOOD] (define-fun s4 () (_ BitVec 8) #x01) [GOOD] (define-fun s2 () (_ BitVec 8) #x01) [GOOD] (declare-fun array_1 () (Array (_ BitVec 8) (_ BitVec 8)))
SBVTestSuite/GoldFiles/queryArrays6.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -18,7 +17,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [GOOD] (push 1) [GOOD] (define-fun s0 () Int 1) [GOOD] (define-fun s2 () Int 5)
SBVTestSuite/GoldFiles/query_Chars1.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () Int 65) [GOOD] (define-fun s4 () Int 66) [GOOD] ; --- skolem constants ---
SBVTestSuite/GoldFiles/query_Interpolant1.gold view
@@ -8,9 +8,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () Int) ; tracks user variable "a" [GOOD] (declare-fun s1 () Int) ; tracks user variable "b"
SBVTestSuite/GoldFiles/query_Interpolant2.gold view
@@ -8,9 +8,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () Int) ; tracks user variable "a" [GOOD] (declare-fun s1 () Int) ; tracks user variable "b"
SBVTestSuite/GoldFiles/query_Lists1.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s1 () (Seq Int) (seq.++ (seq.unit 1) (seq.unit 2) (seq.unit 3) (seq.unit 4) (seq.unit 5))) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (Seq Int)) ; tracks user variable "a"
SBVTestSuite/GoldFiles/query_Strings1.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () String) ; tracks user variable "a" [GOOD] ; --- constant tables ---
+ SBVTestSuite/GoldFiles/query_Tuples1.gold view
@@ -0,0 +1,35 @@+** Calling: z3 -nw -in -smt2+[GOOD] ; Automatically generated by SBV. Do not edit.+[GOOD] (set-option :print-success true)+[GOOD] (set-option :global-declarations true)+[GOOD] (set-option :smtlib2_compliant true)+[GOOD] (set-option :diagnostic-output-channel "stdout")+[GOOD] (set-option :produce-models true)+[GOOD] (set-logic ALL) ; has unbounded values, using catch-all.+[GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples ---+[GOOD] (declare-datatypes ((SBVTuple2 2)) ((par (T1 T2)+                                           ((mkSBVTuple2 (proj_1_SBVTuple2 T1)+                                                         (proj_2_SBVTuple2 T2))))))+[GOOD] ; --- literal constants ---+[GOOD] (define-fun s2 () Int 1)+[GOOD] ; --- skolem constants ---+[GOOD] (declare-fun s0 () (SBVTuple2 Int (_ BitVec 8))) ; tracks user variable "a"+[GOOD] ; --- constant tables ---+[GOOD] ; --- skolemized tables ---+[GOOD] ; --- arrays ---+[GOOD] ; --- uninterpreted constants ---+[GOOD] ; --- user given axioms ---+[GOOD] ; --- formula ---+[GOOD] (define-fun s1 () Int (proj_1_SBVTuple2 s0))+[GOOD] (define-fun s3 () Bool (= s1 s2))+[GOOD] (assert s3)+[SEND] (check-sat)+[RECV] sat+[SEND] (get-value (s0))+[RECV] ((s0 (mkSBVTuple2 1 #x00)))+*** Solver   : Z3+*** Exit code: ExitSuccess++FINAL OUTPUT:+(1,'\NUL')
+ SBVTestSuite/GoldFiles/query_Tuples2.gold view
@@ -0,0 +1,37 @@+** Calling: z3 -nw -in -smt2+[GOOD] ; Automatically generated by SBV. Do not edit.+[GOOD] (set-option :print-success true)+[GOOD] (set-option :global-declarations true)+[GOOD] (set-option :smtlib2_compliant true)+[GOOD] (set-option :diagnostic-output-channel "stdout")+[GOOD] (set-option :produce-models true)+[GOOD] (set-logic ALL) ; has unbounded values, using catch-all.+[GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples ---+[GOOD] (declare-datatypes () ((SBVTuple0 SBVTuple0)))+[GOOD] (declare-datatypes ((SBVTuple2 2)) ((par (T1 T2)+                                           ((mkSBVTuple2 (proj_1_SBVTuple2 T1)+                                                         (proj_2_SBVTuple2 T2))))))+[GOOD] ; --- literal constants ---+[GOOD] (define-fun s3 () (_ BitVec 8) #x63)+[GOOD] ; --- skolem constants ---+[GOOD] (declare-fun s0 () (SBVTuple2 Int (SBVTuple2 (_ BitVec 8) SBVTuple0))) ; tracks user variable "a"+[GOOD] ; --- constant tables ---+[GOOD] ; --- skolemized tables ---+[GOOD] ; --- arrays ---+[GOOD] ; --- uninterpreted constants ---+[GOOD] ; --- user given axioms ---+[GOOD] ; --- formula ---+[GOOD] (define-fun s1 () (SBVTuple2 (_ BitVec 8) SBVTuple0) (proj_2_SBVTuple2 s0))+[GOOD] (define-fun s2 () (_ BitVec 8) (proj_1_SBVTuple2 s1))+[GOOD] (define-fun s4 () Bool (= s2 s3))+[GOOD] (assert s4)+[SEND] (check-sat)+[RECV] sat+[SEND] (get-value (s0))+[RECV] ((s0 (mkSBVTuple2 0 (mkSBVTuple2 #x63 SBVTuple0))))+*** Solver   : Z3+*** Exit code: ExitSuccess++FINAL OUTPUT:+(0,('c',()))
SBVTestSuite/GoldFiles/query_abc.gold view
@@ -5,11 +5,10 @@ ** Some incremental calls, such as pop, will be limited. [ISSUE] (set-option :diagnostic-output-channel "stdout") [ISSUE] (set-option :produce-models true)-[ISSUE] (set-logic QF_BV)+[ISSUE] (set-logic ALL) ; external query, using all logics. [ISSUE] ; --- uninterpreted sorts ---+[ISSUE] ; --- tuples --- [ISSUE] ; --- literal constants ----[ISSUE] (define-fun s_2 () Bool false)-[ISSUE] (define-fun s_1 () Bool true) [ISSUE] (define-fun s2 () (_ BitVec 32) #x00000000) [ISSUE] ; --- skolem constants --- [ISSUE] (declare-fun s0 () (_ BitVec 32)) ; tracks user variable "a"
SBVTestSuite/GoldFiles/query_boolector.gold view
@@ -4,11 +4,10 @@ ** Backend solver Boolector does not support global decls. ** Some incremental calls, such as pop, will be limited. [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 32) #x00000000) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 32)) ; tracks user variable "a"
SBVTestSuite/GoldFiles/query_cvc4.gold view
@@ -4,11 +4,10 @@ [GOOD] (set-option :global-declarations true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 32) #x00000000) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 32)) ; tracks user variable "a"
SBVTestSuite/GoldFiles/query_mathsat.gold view
@@ -5,11 +5,10 @@ ** Some incremental calls, such as pop, will be limited. [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 32) #x00000000) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 32)) ; tracks user variable "a"
SBVTestSuite/GoldFiles/query_yices.gold view
@@ -4,11 +4,10 @@ ** Backend solver Yices does not support global decls. ** Some incremental calls, such as pop, will be limited. [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 32) #x00000000) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 32)) ; tracks user variable "a"
SBVTestSuite/GoldFiles/query_z3.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s2 () (_ BitVec 32) #x00000000) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (_ BitVec 32)) ; tracks user variable "a"
SBVTestSuite/GoldFiles/reverse.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s13 () Int 1) [GOOD] (define-fun s53 () Int 0) [GOOD] (define-fun s11 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/reverseAlt10.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () Int 1) [GOOD] (define-fun s43 () Int 0) [GOOD] (define-fun s1 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/safe1.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s1 () Int 12) [GOOD] (define-fun s3 () Int 2) [GOOD] ; --- skolem constants ---@@ -23,7 +22,6 @@ [GOOD] (define-fun s2 () Bool (= s0 s1)) [GOOD] (define-fun s4 () Bool (> s0 s3)) [GOOD] (define-fun s5 () Bool (not s4))-[GOOD] (assert s_1) [GOOD] (push 1) [GOOD] (assert s5) [SEND] (check-sat)
SBVTestSuite/GoldFiles/safe2.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) ; has unbounded values, using catch-all. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s1 () Int 12) [GOOD] (define-fun s2 () Int 2) [GOOD] ; --- skolem constants ---@@ -22,7 +21,6 @@ [GOOD] ; --- formula --- [GOOD] (define-fun s3 () Bool (> s0 s2)) [GOOD] (define-fun s4 () Bool (not s3))-[GOOD] (assert s_1) [GOOD] (push 1) [GOOD] (assert s4) [SEND] (check-sat)
SBVTestSuite/GoldFiles/seqConcat.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/seqConcatBad.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,7 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_2)+[GOOD] (assert false) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/seqExamples1.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/seqExamples2.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s1 () (Seq Int) (seq.unit 2)) [GOOD] (define-fun s3 () (Seq Int) (seq.unit 1)) [GOOD] ; --- skolem constants ---
SBVTestSuite/GoldFiles/seqExamples3.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s4 () (Seq Int) (seq.++ (seq.unit 1) (seq.unit 2) (seq.unit 3) (seq.unit 4))) [GOOD] (define-fun s7 () (Seq Int) (seq.++ (seq.unit 3) (seq.unit 4) (seq.unit 5) (seq.unit 6))) [GOOD] (define-fun s9 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/seqExamples4.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s8 () Int 2) [GOOD] (define-fun s2 () (Seq Int) (seq.++ (seq.unit 1) (seq.unit 2) (seq.unit 3))) [GOOD] (define-fun s4 () (Seq Int) (seq.++ (seq.unit 3) (seq.unit 4) (seq.unit 5)))
SBVTestSuite/GoldFiles/seqExamples5.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () (Seq Int) (seq.++ (seq.unit 1) (seq.unit 2))) [GOOD] (define-fun s6 () (Seq Int) (seq.++ (seq.unit 2) (seq.unit 1))) [GOOD] (define-fun s12 () (Seq Int) (seq.unit 1))
SBVTestSuite/GoldFiles/seqExamples6.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (Seq Int)) ; tracks user variable "a" [GOOD] (declare-fun s1 () (Seq Int)) ; tracks user variable "b"
SBVTestSuite/GoldFiles/seqExamples7.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (Seq Int)) ; tracks user variable "a" [GOOD] (declare-fun s1 () (Seq Int)) ; tracks user variable "b"
SBVTestSuite/GoldFiles/seqExamples8.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () (Seq Int)) ; tracks user variable "a" [GOOD] (declare-fun s1 () (Seq Int)) ; tracks user variable "b"
SBVTestSuite/GoldFiles/seqIndexOf.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/seqIndexOfBad.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,7 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_2)+[GOOD] (assert false) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/sort.gold view
@@ -9,9 +9,8 @@ [GOOD] (set-option :pp.min_alias_size 4294967295) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s14 () Int 1) [GOOD] (define-fun s26 () Int 0) [GOOD] (define-fun s12 () (Seq Int) (as seq.empty (Seq Int)))
SBVTestSuite/GoldFiles/strConcat.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/strConcatBad.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,7 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_2)+[GOOD] (assert false) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
SBVTestSuite/GoldFiles/strExamples1.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/strExamples10.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () Int 6) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () String) ; tracks user variable "a"
SBVTestSuite/GoldFiles/strExamples11.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s1 () Int 11) [GOOD] (define-fun s4 () String "11") [GOOD] ; --- skolem constants ---
SBVTestSuite/GoldFiles/strExamples12.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s1 () Int (- 2)) [GOOD] (define-fun s4 () String "") [GOOD] ; --- skolem constants ---
SBVTestSuite/GoldFiles/strExamples13.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s4 () Int 13) [GOOD] (define-fun s1 () String "13") [GOOD] ; --- skolem constants ---
SBVTestSuite/GoldFiles/strExamples2.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s1 () String "b") [GOOD] (define-fun s3 () String "a") [GOOD] ; --- skolem constants ---
SBVTestSuite/GoldFiles/strExamples3.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s4 () String "abcd") [GOOD] (define-fun s7 () String "cdef") [GOOD] (define-fun s9 () String "")
SBVTestSuite/GoldFiles/strExamples4.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s8 () Int 2) [GOOD] (define-fun s2 () String "abc") [GOOD] (define-fun s4 () String "cef")
SBVTestSuite/GoldFiles/strExamples5.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () String "ab") [GOOD] (define-fun s6 () String "ba") [GOOD] (define-fun s12 () String "a")
SBVTestSuite/GoldFiles/strExamples6.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () String) ; tracks user variable "a" [GOOD] (declare-fun s1 () String) ; tracks user variable "b"
SBVTestSuite/GoldFiles/strExamples7.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () String) ; tracks user variable "a" [GOOD] (declare-fun s1 () String) ; tracks user variable "b"
SBVTestSuite/GoldFiles/strExamples8.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () String) ; tracks user variable "a" [GOOD] (declare-fun s1 () String) ; tracks user variable "b"
SBVTestSuite/GoldFiles/strExamples9.gold view
@@ -7,9 +7,8 @@ [GOOD] (set-option :produce-models true) [GOOD] (set-logic ALL) [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] (define-fun s3 () Int 6) [GOOD] ; --- skolem constants --- [GOOD] (declare-fun s0 () String) ; tracks user variable "a"
SBVTestSuite/GoldFiles/strIndexOf.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,6 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_1) [SEND] (check-sat) [RECV] sat *** Solver   : Z3
SBVTestSuite/GoldFiles/strIndexOfBad.gold view
@@ -5,11 +5,10 @@ [GOOD] (set-option :smtlib2_compliant true) [GOOD] (set-option :diagnostic-output-channel "stdout") [GOOD] (set-option :produce-models true)-[GOOD] (set-logic QF_BV)+[GOOD] (set-logic ALL) ; external query, using all logics. [GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples --- [GOOD] ; --- literal constants ----[GOOD] (define-fun s_2 () Bool false)-[GOOD] (define-fun s_1 () Bool true) [GOOD] ; --- skolem constants --- [GOOD] ; --- constant tables --- [GOOD] ; --- skolemized tables ---@@ -17,7 +16,7 @@ [GOOD] ; --- uninterpreted constants --- [GOOD] ; --- user given axioms --- [GOOD] ; --- formula ----[GOOD] (assert s_2)+[GOOD] (assert false) [SEND] (check-sat) [RECV] unsat *** Solver   : Z3
+ SBVTestSuite/GoldFiles/tuple_enum.gold view
@@ -0,0 +1,109 @@+** Calling: z3 -nw -in -smt2+[GOOD] ; Automatically generated by SBV. Do not edit.+[GOOD] (set-option :print-success true)+[GOOD] (set-option :global-declarations true)+[GOOD] (set-option :smtlib2_compliant true)+[GOOD] (set-option :diagnostic-output-channel "stdout")+[GOOD] (set-option :produce-models true)+[GOOD] (set-option :pp.max_depth      4294967295)+[GOOD] (set-option :pp.min_alias_size 4294967295)+[GOOD] (set-logic ALL)+[GOOD] ; --- uninterpreted sorts ---+[GOOD] (declare-datatypes () ((E (A) (B) (C))))+[GOOD] (define-fun E_constrIndex ((x E)) Int+          (ite (= x A) 0 (ite (= x B) 1 2))+       )+[GOOD] ; --- tuples ---+[GOOD] (declare-datatypes ((SBVTuple2 2)) ((par (T1 T2)+                                           ((mkSBVTuple2 (proj_1_SBVTuple2 T1)+                                                         (proj_2_SBVTuple2 T2))))))+[GOOD] ; --- literal constants ---+[GOOD] (define-fun s6 () Int 1)+[GOOD] (define-fun s17 () Int 3)+[GOOD] (define-fun s21 () Int 2)+[GOOD] (define-fun s32 () Int 6)+[GOOD] (define-fun s36 () Int 4)+[GOOD] (define-fun s28 () E C)+[GOOD] (define-fun s13 () (Seq Bool) (seq.unit true))+[GOOD] ; --- skolem constants ---+[GOOD] (declare-fun s0 () (Seq (SBVTuple2 E (Seq Bool)))) ; tracks user variable "v1"+[GOOD] (declare-fun s1 () Bool) ; tracks user variable "q"+[GOOD] (declare-fun s3 () (SBVTuple2 E (Seq Bool))) ; tracks user variable "__internal_sbv_s3"+[GOOD] (declare-fun s19 () (SBVTuple2 E (Seq Bool))) ; tracks user variable "__internal_sbv_s19"+[GOOD] (declare-fun s34 () Bool) ; tracks user variable "__internal_sbv_s34"+[GOOD] ; --- constant tables ---+[GOOD] ; --- skolemized tables ---+[GOOD] ; --- arrays ---+[GOOD] ; --- uninterpreted constants ---+[GOOD] ; --- user given axioms ---+[GOOD] ; --- formula ---+[GOOD] (define-fun s2 () Bool (not s1))+[GOOD] (define-fun s4 () (Seq (SBVTuple2 E (Seq Bool))) (seq.unit s3))+[GOOD] (define-fun s5 () Int (seq.len s0))+[GOOD] (define-fun s7 () Bool (> s5 s6))+[GOOD] (define-fun s8 () Bool (not s7))+[GOOD] (define-fun s9 () (Seq (SBVTuple2 E (Seq Bool))) (seq.extract s0 s6 s6))+[GOOD] (define-fun s10 () Bool (= s4 s9))+[GOOD] (define-fun s11 () Bool (or s8 s10))+[GOOD] (define-fun s12 () (Seq Bool) (proj_2_SBVTuple2 s3))+[GOOD] (define-fun s14 () (Seq Bool) (seq.unit s1))+[GOOD] (define-fun s15 () (Seq Bool) (seq.++ s13 s14))+[GOOD] (define-fun s16 () Bool (= s12 s15))+[GOOD] (define-fun s18 () Bool (= s5 s17))+[GOOD] (define-fun s20 () (Seq (SBVTuple2 E (Seq Bool))) (seq.unit s19))+[GOOD] (define-fun s22 () Bool (> s5 s21))+[GOOD] (define-fun s23 () Bool (not s22))+[GOOD] (define-fun s24 () (Seq (SBVTuple2 E (Seq Bool))) (seq.extract s0 s21 s6))+[GOOD] (define-fun s25 () Bool (= s20 s24))+[GOOD] (define-fun s26 () Bool (or s23 s25))+[GOOD] (define-fun s27 () E (proj_1_SBVTuple2 s19))+[GOOD] (define-fun s29 () Bool (= s27 s28))+[GOOD] (define-fun s30 () (Seq Bool) (proj_2_SBVTuple2 s19))+[GOOD] (define-fun s31 () Int (seq.len s30))+[GOOD] (define-fun s33 () Bool (= s31 s32))+[GOOD] (define-fun s35 () (Seq Bool) (seq.unit s34))+[GOOD] (define-fun s37 () Bool (> s31 s36))+[GOOD] (define-fun s38 () Bool (not s37))+[GOOD] (define-fun s39 () (Seq Bool) (seq.extract s30 s36 s6))+[GOOD] (define-fun s40 () Bool (= s35 s39))+[GOOD] (define-fun s41 () Bool (or s38 s40))+[GOOD] (assert s2)+[GOOD] (assert s11)+[GOOD] (assert s16)+[GOOD] (assert s18)+[GOOD] (assert s26)+[GOOD] (assert s29)+[GOOD] (assert s33)+[GOOD] (assert s41)+[GOOD] (assert s34)+[GOOD] (declare-datatypes ((SBVTuple3 3)) ((par (T1 T2 T3)+                                           ((mkSBVTuple3 (proj_1_SBVTuple3 T1)+                                                         (proj_2_SBVTuple3 T2)+                                                         (proj_3_SBVTuple3 T3))))))+[GOOD] (declare-fun s42 () (SBVTuple2 (_ BitVec 8) (SBVTuple3 E (_ BitVec 8) (_ FloatingPoint  8 24))))+[GOOD] (define-fun s43 () (SBVTuple2 (_ BitVec 8) (SBVTuple3 E (_ BitVec 8) (_ FloatingPoint  8 24))) (mkSBVTuple2 #x05 (mkSBVTuple3 C #x41 ((_ to_fp 8 24) roundNearestTiesToEven (/ 8514437.0 1048576.0)))))+[GOOD] (define-fun s44 () Bool (= s42 s43))+[GOOD] (assert s44)+[GOOD] (define-fun s45 () (Seq (SBVTuple2 E (Seq Bool))) (seq.++ (seq.unit (mkSBVTuple2 B (as seq.empty (Seq Bool)))) (seq.unit (mkSBVTuple2 A (seq.++ (seq.unit true) (seq.unit false)))) (seq.unit (mkSBVTuple2 C (seq.++ (seq.unit false) (seq.unit false) (seq.unit false) (seq.unit false) (seq.unit true) (seq.unit false))))))+[GOOD] (define-fun s46 () Bool (= s0 s45))+[GOOD] (assert s46)+[SEND] (check-sat)+[RECV] sat+[SEND] (get-value (s0))+[RECV] ((s0 (seq.++ (seq.unit (mkSBVTuple2 B (as seq.empty (Seq Bool))))+               (seq.++ (seq.unit (mkSBVTuple2 A+                                              (seq.++ (seq.unit true) (seq.unit false))))+                       (seq.unit (mkSBVTuple2 C+                                              (seq.++ (seq.unit false)+                                                      (seq.++ (seq.unit false)+                                                              (seq.++ (seq.unit false)+                                                                      (seq.++ (seq.unit false)+                                                                              (seq.++ (seq.unit true)+                                                                                      (seq.unit false))))))))))))+[SEND] (get-value (s42))+[RECV] ((s42 (mkSBVTuple2 #x05 (mkSBVTuple3 C #x41 (fp #b0 #x82 #b00000011110101110000101)))))+*** Solver   : Z3+*** Exit code: ExitSuccess++ FINAL: ([(B,[]),(A,[True,False]),(C,[False,False,False,False,True,False])],(5,(C,'A',8.12)))+DONE!
+ SBVTestSuite/GoldFiles/tuple_list.gold view
@@ -0,0 +1,114 @@+** Calling: z3 -nw -in -smt2+[GOOD] ; Automatically generated by SBV. Do not edit.+[GOOD] (set-option :print-success true)+[GOOD] (set-option :global-declarations true)+[GOOD] (set-option :smtlib2_compliant true)+[GOOD] (set-option :diagnostic-output-channel "stdout")+[GOOD] (set-option :produce-models true)+[GOOD] (set-option :pp.max_depth      4294967295)+[GOOD] (set-option :pp.min_alias_size 4294967295)+[GOOD] (set-logic ALL)+[GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples ---+[GOOD] (declare-datatypes ((SBVTuple2 2)) ((par (T1 T2)+                                           ((mkSBVTuple2 (proj_1_SBVTuple2 T1)+                                                         (proj_2_SBVTuple2 T2))))))+[GOOD] ; --- literal constants ---+[GOOD] (define-fun s4 () Int 0)+[GOOD] (define-fun s7 () Int 1)+[GOOD] (define-fun s12 () Int 2)+[GOOD] (define-fun s33 () Int 4)+[GOOD] (define-fun s41 () Int 5)+[GOOD] (define-fun s31 () String "foo")+[GOOD] (define-fun s53 () (Seq (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) (seq.++ (seq.unit (mkSBVTuple2 2 (as seq.empty (Seq (SBVTuple2 Int String))))) (seq.unit (mkSBVTuple2 1 (seq.++ (seq.unit (mkSBVTuple2 3 "foo")) (seq.unit (mkSBVTuple2 0 "bar")) (seq.unit (mkSBVTuple2 (- 1) "baz")) (seq.unit (mkSBVTuple2 (- 2) "quux")) (seq.unit (mkSBVTuple2 (- 3) "enough"))))) (seq.unit (mkSBVTuple2 (- 4) (as seq.empty (Seq (SBVTuple2 Int String))))) (seq.unit (mkSBVTuple2 (- 5) (as seq.empty (Seq (SBVTuple2 Int String)))))))+[GOOD] ; --- skolem constants ---+[GOOD] (declare-fun s0 () (Seq (SBVTuple2 Int (Seq (SBVTuple2 Int String))))) ; tracks user variable "lst"+[GOOD] (declare-fun s1 () (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) ; tracks user variable "__internal_sbv_s1"+[GOOD] (declare-fun s14 () (SBVTuple2 Int String)) ; tracks user variable "__internal_sbv_s14"+[GOOD] (declare-fun s16 () (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) ; tracks user variable "__internal_sbv_s16"+[GOOD] (declare-fun s35 () (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) ; tracks user variable "__internal_sbv_s35"+[GOOD] (declare-fun s43 () (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) ; tracks user variable "__internal_sbv_s43"+[GOOD] ; --- constant tables ---+[GOOD] ; --- skolemized tables ---+[GOOD] ; --- arrays ---+[GOOD] ; --- uninterpreted constants ---+[GOOD] ; --- user given axioms ---+[GOOD] ; --- formula ---+[GOOD] (define-fun s2 () (Seq (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) (seq.unit s1))+[GOOD] (define-fun s3 () Int (seq.len s0))+[GOOD] (define-fun s5 () Bool (> s3 s4))+[GOOD] (define-fun s6 () Bool (not s5))+[GOOD] (define-fun s8 () (Seq (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) (seq.extract s0 s4 s7))+[GOOD] (define-fun s9 () Bool (= s2 s8))+[GOOD] (define-fun s10 () Bool (or s6 s9))+[GOOD] (define-fun s11 () Int (proj_1_SBVTuple2 s1))+[GOOD] (define-fun s13 () Bool (= s11 s12))+[GOOD] (define-fun s15 () (Seq (SBVTuple2 Int String)) (seq.unit s14))+[GOOD] (define-fun s17 () (Seq (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) (seq.unit s16))+[GOOD] (define-fun s18 () Bool (> s3 s7))+[GOOD] (define-fun s19 () Bool (not s18))+[GOOD] (define-fun s20 () (Seq (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) (seq.extract s0 s7 s7))+[GOOD] (define-fun s21 () Bool (= s17 s20))+[GOOD] (define-fun s22 () Bool (or s19 s21))+[GOOD] (define-fun s23 () (Seq (SBVTuple2 Int String)) (proj_2_SBVTuple2 s16))+[GOOD] (define-fun s24 () Int (seq.len s23))+[GOOD] (define-fun s25 () Bool (> s24 s4))+[GOOD] (define-fun s26 () Bool (not s25))+[GOOD] (define-fun s27 () (Seq (SBVTuple2 Int String)) (seq.extract s23 s4 s7))+[GOOD] (define-fun s28 () Bool (= s15 s27))+[GOOD] (define-fun s29 () Bool (or s26 s28))+[GOOD] (define-fun s30 () String (proj_2_SBVTuple2 s14))+[GOOD] (define-fun s32 () Bool (= s30 s31))+[GOOD] (define-fun s34 () Bool (= s3 s33))+[GOOD] (define-fun s36 () (Seq (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) (seq.unit s35))+[GOOD] (define-fun s37 () Bool (= s20 s36))+[GOOD] (define-fun s38 () Bool (or s19 s37))+[GOOD] (define-fun s39 () (Seq (SBVTuple2 Int String)) (proj_2_SBVTuple2 s35))+[GOOD] (define-fun s40 () Int (seq.len s39))+[GOOD] (define-fun s42 () Bool (= s40 s41))+[GOOD] (define-fun s44 () (Seq (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) (seq.unit s43))+[GOOD] (define-fun s45 () Bool (> s3 s12))+[GOOD] (define-fun s46 () Bool (not s45))+[GOOD] (define-fun s47 () (Seq (SBVTuple2 Int (Seq (SBVTuple2 Int String)))) (seq.extract s0 s12 s7))+[GOOD] (define-fun s48 () Bool (= s44 s47))+[GOOD] (define-fun s49 () Bool (or s46 s48))+[GOOD] (define-fun s50 () (Seq (SBVTuple2 Int String)) (proj_2_SBVTuple2 s43))+[GOOD] (define-fun s51 () Int (seq.len s50))+[GOOD] (define-fun s52 () Bool (= s4 s51))+[GOOD] (define-fun s54 () Bool (= s0 s53))+[GOOD] (assert s10)+[GOOD] (assert s13)+[GOOD] (assert s22)+[GOOD] (assert s29)+[GOOD] (assert s32)+[GOOD] (assert s34)+[GOOD] (assert s38)+[GOOD] (assert s42)+[GOOD] (assert s49)+[GOOD] (assert s52)+[GOOD] (assert s54)+[SEND] (check-sat)+[RECV] sat+[SEND] (get-value (s0))+[RECV] ((s0 (seq.++ (seq.unit (mkSBVTuple2 2 (as seq.empty (Seq (SBVTuple2 Int String)))))+               (seq.++ (seq.unit (mkSBVTuple2 1+                                              (seq.++ (seq.unit (mkSBVTuple2 3 "foo"))+                                                      (seq.++ (seq.unit (mkSBVTuple2 0+                                                                                     "bar"))+                                                              (seq.++ (seq.unit (mkSBVTuple2 (- 1)+                                                                                             "baz"))+                                                                      (seq.++ (seq.unit (mkSBVTuple2 (- 2)+                                                                                                     "quux"))+                                                                              (seq.unit (mkSBVTuple2 (- 3)+                                                                                                     "enough"))))))))+                       (seq.++ (seq.unit (mkSBVTuple2 (- 4)+                                                      (as seq.empty+                                                          (Seq (SBVTuple2 Int String)))))+                               (seq.unit (mkSBVTuple2 (- 5)+                                                      (as seq.empty+                                                          (Seq (SBVTuple2 Int String))))))))))+*** Solver   : Z3+*** Exit code: ExitSuccess++ FINAL: [(2,[]),(1,[(3,"foo"),(0,"bar"),(-1,"baz"),(-2,"quux"),(-3,"enough")]),(-4,[]),(-5,[])]+DONE!
+ SBVTestSuite/GoldFiles/tuple_makePair.gold view
@@ -0,0 +1,3 @@++ FINAL: ()+DONE!
+ SBVTestSuite/GoldFiles/tuple_nested.gold view
@@ -0,0 +1,49 @@+** Calling: z3 -nw -in -smt2+[GOOD] ; Automatically generated by SBV. Do not edit.+[GOOD] (set-option :print-success true)+[GOOD] (set-option :global-declarations true)+[GOOD] (set-option :smtlib2_compliant true)+[GOOD] (set-option :diagnostic-output-channel "stdout")+[GOOD] (set-option :produce-models true)+[GOOD] (set-logic ALL)+[GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples ---+[GOOD] (declare-datatypes ((SBVTuple2 2)) ((par (T1 T2)+                                           ((mkSBVTuple2 (proj_1_SBVTuple2 T1)+                                                         (proj_2_SBVTuple2 T2))))))+[GOOD] ; --- literal constants ---+[GOOD] (define-fun s13 () (_ BitVec 8) #x00)+[GOOD] (define-fun s3 () Int 1)+[GOOD] (define-fun s10 () (_ BitVec 8) #x63)+[GOOD] (define-fun s7 () String "foo")+[GOOD] ; --- skolem constants ---+[GOOD] (declare-fun s0 () (SBVTuple2 (SBVTuple2 Int (SBVTuple2 String (_ BitVec 8))) (_ BitVec 8))) ; tracks user variable "abcd"+[GOOD] ; --- constant tables ---+[GOOD] ; --- skolemized tables ---+[GOOD] ; --- arrays ---+[GOOD] ; --- uninterpreted constants ---+[GOOD] ; --- user given axioms ---+[GOOD] ; --- formula ---+[GOOD] (define-fun s1 () (SBVTuple2 Int (SBVTuple2 String (_ BitVec 8))) (proj_1_SBVTuple2 s0))+[GOOD] (define-fun s2 () Int (proj_1_SBVTuple2 s1))+[GOOD] (define-fun s4 () Bool (= s2 s3))+[GOOD] (define-fun s5 () (SBVTuple2 String (_ BitVec 8)) (proj_2_SBVTuple2 s1))+[GOOD] (define-fun s6 () String (proj_1_SBVTuple2 s5))+[GOOD] (define-fun s8 () Bool (= s6 s7))+[GOOD] (define-fun s9 () (_ BitVec 8) (proj_2_SBVTuple2 s5))+[GOOD] (define-fun s11 () Bool (= s9 s10))+[GOOD] (define-fun s12 () (_ BitVec 8) (proj_2_SBVTuple2 s0))+[GOOD] (define-fun s14 () Bool (= s12 s13))+[GOOD] (assert s4)+[GOOD] (assert s8)+[GOOD] (assert s11)+[GOOD] (assert s14)+[SEND] (check-sat)+[RECV] sat+[SEND] (get-value (s0))+[RECV] ((s0 (mkSBVTuple2 (mkSBVTuple2 1 (mkSBVTuple2 "foo" #x63)) #x00)))+*** Solver   : Z3+*** Exit code: ExitSuccess++ FINAL: ((1,("foo",'c')),0)+DONE!
+ SBVTestSuite/GoldFiles/tuple_swap.gold view
@@ -0,0 +1,43 @@+** Calling: z3 -nw -in -smt2+[GOOD] ; Automatically generated by SBV. Do not edit.+[GOOD] (set-option :print-success true)+[GOOD] (set-option :global-declarations true)+[GOOD] (set-option :smtlib2_compliant true)+[GOOD] (set-option :diagnostic-output-channel "stdout")+[GOOD] (set-option :produce-models true)+[GOOD] (set-logic ALL) ; has unbounded values, using catch-all.+[GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples ---+[GOOD] (declare-datatypes ((SBVTuple3 3)) ((par (T1 T2 T3)+                                           ((mkSBVTuple3 (proj_1_SBVTuple3 T1)+                                                         (proj_2_SBVTuple3 T2)+                                                         (proj_3_SBVTuple3 T3))))))+[GOOD] ; --- literal constants ---+[GOOD] ; --- skolem constants ---+[GOOD] (declare-fun s0 () (SBVTuple3 Int Int Int)) ; tracks user variable "abx"+[GOOD] (declare-fun s1 () (SBVTuple3 Int Int Int)) ; tracks user variable "bay"+[GOOD] ; --- constant tables ---+[GOOD] ; --- skolemized tables ---+[GOOD] ; --- arrays ---+[GOOD] ; --- uninterpreted constants ---+[GOOD] ; --- user given axioms ---+[GOOD] ; --- formula ---+[GOOD] (define-fun s2 () Int (proj_1_SBVTuple3 s0))+[GOOD] (define-fun s3 () Int (proj_2_SBVTuple3 s1))+[GOOD] (define-fun s4 () Bool (= s2 s3))+[GOOD] (define-fun s5 () Int (proj_2_SBVTuple3 s0))+[GOOD] (define-fun s6 () Int (proj_1_SBVTuple3 s1))+[GOOD] (define-fun s7 () Bool (= s5 s6))+[GOOD] (assert s4)+[GOOD] (assert s7)+[SEND] (check-sat)+[RECV] sat+[SEND] (get-value (s0))+[RECV] ((s0 (mkSBVTuple3 1 2 0)))+[SEND] (get-value (s1))+[RECV] ((s1 (mkSBVTuple3 2 1 3)))+*** Solver   : Z3+*** Exit code: ExitSuccess++ FINAL: ((1,2,0),(2,1,3))+DONE!
+ SBVTestSuite/GoldFiles/tuple_twoTwo.gold view
@@ -0,0 +1,42 @@+** Calling: z3 -nw -in -smt2+[GOOD] ; Automatically generated by SBV. Do not edit.+[GOOD] (set-option :print-success true)+[GOOD] (set-option :global-declarations true)+[GOOD] (set-option :smtlib2_compliant true)+[GOOD] (set-option :diagnostic-output-channel "stdout")+[GOOD] (set-option :produce-models true)+[GOOD] (set-logic ALL)+[GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples ---+[GOOD] (declare-datatypes ((SBVTuple2 2)) ((par (T1 T2)+                                           ((mkSBVTuple2 (proj_1_SBVTuple2 T1)+                                                         (proj_2_SBVTuple2 T2))))))+[GOOD] ; --- literal constants ---+[GOOD] (define-fun s3 () Int 1)+[GOOD] (define-fun s6 () (_ BitVec 8) #x63)+[GOOD] ; --- skolem constants ---+[GOOD] (declare-fun s0 () (SBVTuple2 Int String)) ; tracks user variable "ab"+[GOOD] (declare-fun s1 () (SBVTuple2 (_ BitVec 8) (_ BitVec 8))) ; tracks user variable "cd"+[GOOD] ; --- constant tables ---+[GOOD] ; --- skolemized tables ---+[GOOD] ; --- arrays ---+[GOOD] ; --- uninterpreted constants ---+[GOOD] ; --- user given axioms ---+[GOOD] ; --- formula ---+[GOOD] (define-fun s2 () Int (proj_1_SBVTuple2 s0))+[GOOD] (define-fun s4 () Bool (= s2 s3))+[GOOD] (define-fun s5 () (_ BitVec 8) (proj_1_SBVTuple2 s1))+[GOOD] (define-fun s7 () Bool (= s5 s6))+[GOOD] (assert s4)+[GOOD] (assert s7)+[SEND] (check-sat)+[RECV] sat+[SEND] (get-value (s0))+[RECV] ((s0 (mkSBVTuple2 1 "")))+[SEND] (get-value (s1))+[RECV] ((s1 (mkSBVTuple2 #x63 #x00)))+*** Solver   : Z3+*** Exit code: ExitSuccess++ FINAL: ((1,""),('c',0))+DONE!
+ SBVTestSuite/GoldFiles/tuple_unit.gold view
@@ -0,0 +1,3 @@++ FINAL: ()+DONE!
+ SBVTestSuite/GoldFiles/unit.gold view
@@ -0,0 +1,29 @@+** Calling: z3 -nw -in -smt2+[GOOD] ; Automatically generated by SBV. Do not edit.+[GOOD] (set-option :print-success true)+[GOOD] (set-option :global-declarations true)+[GOOD] (set-option :smtlib2_compliant true)+[GOOD] (set-option :diagnostic-output-channel "stdout")+[GOOD] (set-option :produce-models true)+[GOOD] (set-logic ALL) ; external query, using all logics.+[GOOD] ; --- uninterpreted sorts ---+[GOOD] ; --- tuples ---+[GOOD] (declare-datatypes () ((tup-0 (tup-0))))+[GOOD] ; --- literal constants ---+[GOOD] (define-fun s_2 () Bool false)+[GOOD] (define-fun s_1 () Bool true)+[GOOD] ; --- skolem constants ---+[GOOD] (declare-fun s0 () tup-0) ; tracks user variable "x"+[GOOD] (declare-fun s1 () tup-0) ; tracks user variable "y"+[GOOD] ; --- constant tables ---+[GOOD] ; --- skolemized tables ---+[GOOD] ; --- arrays ---+[GOOD] ; --- uninterpreted constants ---+[GOOD] ; --- user given axioms ---+[GOOD] ; --- formula ---+[GOOD] (define-fun s2 () Bool (= s0 s1))+[GOOD] (assert s2)+[SEND] (check-sat)+[RECV] sat+*** Solver   : Z3+*** Exit code: ExitSuccess
SBVTestSuite/SBVDocTest.hs view
@@ -1,3 +1,14 @@+-----------------------------------------------------------------------------+-- |+-- Module    : SBVDocTest+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Doctest interface for SBV testsuite+-----------------------------------------------------------------------------+ module Main (main) where  import System.FilePath.Glob (glob)
SBVTestSuite/SBVHLint.hs view
@@ -1,3 +1,14 @@+-----------------------------------------------------------------------------+-- |+-- Module    : SBVHLint+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- HLint interface for SBV testsuite+-----------------------------------------------------------------------------+ module Main (main) where  import Utils.SBVTestFramework (getTestEnvironment, TestEnvironment(..))
SBVTestSuite/SBVTest.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  SBVTestSuite.SBVTest.Main--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : SBVTest+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Main entry point to the test suite -----------------------------------------------------------------------------@@ -43,6 +43,7 @@ import qualified TestSuite.Basics.SquashReals import qualified TestSuite.Basics.String import qualified TestSuite.Basics.TOut+import qualified TestSuite.Basics.Tuple import qualified TestSuite.BitPrecise.BitTricks import qualified TestSuite.BitPrecise.Legato import qualified TestSuite.BitPrecise.MergeSort@@ -97,8 +98,10 @@ import qualified TestSuite.Queries.Interpolants import qualified TestSuite.Queries.Lists import qualified TestSuite.Queries.Strings+import qualified TestSuite.Queries.Tuples import qualified TestSuite.Queries.Uninterpreted import qualified TestSuite.QuickCheck.QC+import qualified TestSuite.Transformers.SymbolicEval import qualified TestSuite.Uninterpreted.AUF import qualified TestSuite.Uninterpreted.Axioms import qualified TestSuite.Uninterpreted.Function@@ -177,6 +180,7 @@                , TestSuite.Basics.SquashReals.tests                , TestSuite.Basics.String.tests                , TestSuite.Basics.TOut.tests+               , TestSuite.Basics.Tuple.tests                , TestSuite.BitPrecise.BitTricks.tests                , TestSuite.BitPrecise.Legato.tests                , TestSuite.BitPrecise.MergeSort.tests@@ -223,7 +227,9 @@                , TestSuite.Queries.Int_Z3.tests                , TestSuite.Queries.Lists.tests                , TestSuite.Queries.Strings.tests+               , TestSuite.Queries.Tuples.tests                , TestSuite.Queries.Uninterpreted.tests+               , TestSuite.Transformers.SymbolicEval.tests                , TestSuite.Uninterpreted.AUF.tests                , TestSuite.Uninterpreted.Axioms.tests                , TestSuite.Uninterpreted.Function.tests
SBVTestSuite/TestSuite/Arrays/InitVals.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Arrays.InitVals--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Arrays.InitVals+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing arrays with initializers -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Arrays/Memory.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Arrays.Memory--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Arrays.Memory+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.Arrays.Memory -----------------------------------------------------------------------------@@ -27,7 +27,7 @@  -- | if read from a place you didn't write to, the result doesn't change rawd :: SymArray m => Address -> Address -> Value -> Memory m -> SBool-rawd a b v m = a ./= b ==> readArray (writeArray m a v) b .== readArray m b+rawd a b v m = a ./= b .=> readArray (writeArray m a v) b .== readArray m b  -- | write-after-write: If you write to the same location twice, then the first one is ignored waw :: SymArray m => Address -> Value -> Value -> Memory m -> Address -> SBool@@ -38,7 +38,7 @@  -- | Two writes to different locations commute, i.e., can be done in any order wcommutesGood :: SymArray m => (Address, Value) -> (Address, Value) -> Memory m -> Address -> SBool-wcommutesGood (a, x) (b, y) m i = a ./= b ==> wcommutesBad (a, x) (b, y) m i+wcommutesGood (a, x) (b, y) m i = a ./= b .=> wcommutesBad (a, x) (b, y) m i  -- | Two writes do not commute if they can be done to the same location wcommutesBad :: SymArray m => (Address, Value) -> (Address, Value) -> Memory m -> Address -> SBool@@ -52,20 +52,20 @@ -- quantifier here. extensionality :: (SymArray m, EqSymbolic (Memory m)) => Memory m -> Memory m -> Predicate extensionality m1 m2 = do i <- exists_-                          return $ (readArray m1 i ./= readArray m2 i) ||| m1 .== m2+                          return $ (readArray m1 i ./= readArray m2 i) .|| m1 .== m2  -- | Extensionality, second variant. Expressible for both kinds of arrays. extensionality2 :: SymArray m => Memory m -> Memory m -> Address -> Predicate extensionality2 m1 m2 i = do j <- exists_-                             return $ (readArray m1 j ./= readArray m2 j) ||| readArray m1 i .== readArray m2 i+                             return $ (readArray m1 j ./= readArray m2 j) .|| readArray m1 i .== readArray m2 i  -- | Merge, using memory equality to check result mergeEq :: (SymArray m, Mergeable (Memory m), EqSymbolic (Memory m)) => SBool -> Memory m  -> Memory m -> SBool-mergeEq b m1 m2 = ite b m1 m2 .== ite (bnot b) m2 m1+mergeEq b m1 m2 = ite b m1 m2 .== ite (sNot b) m2 m1  -- | Merge, using extensionality to check result mergeExt :: (SymArray m, Mergeable (Memory m)) => SBool -> Memory m -> Memory m -> Address -> SBool-mergeExt b m1 m2 i = readArray (ite b m1 m2) i .== readArray (ite (bnot b) m2 m1) i+mergeExt b m1 m2 i = readArray (ite b m1 m2) i .== readArray (ite (sNot b) m2 m1) i  -- | Merge semantics mergeSem :: (SymArray m, Mergeable (Memory m)) => SBool -> Memory m -> Memory m -> Address -> SBool
SBVTestSuite/TestSuite/Arrays/Query.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Arrays.Query--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Arrays.Query+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for query mode arrays -----------------------------------------------------------------------------@@ -113,7 +113,7 @@                             Unk   -> error "Unknown"                             Unsat -> do pop 1                                         d <- freshVar $ "d" ++ show (length sofar)-                                        constrain $ d .>= 1 &&& d .< 3+                                        constrain $ d .>= 1 .&& d .< 3                                         loop (writeArray a 1 (readArray a 1 + d)) (sofar ++ [d])                             Sat   -> mapM getValue sofar
SBVTestSuite/TestSuite/Basics/AllSat.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.AllSat--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.AllSat+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for basic allsat calls -----------------------------------------------------------------------------@@ -26,14 +26,14 @@     , goldenVsStringShow "allSat2" t2     , goldenVsStringShow "allSat3" $            allSat $ \x -> x .== (0::SFloat)     , goldenVsStringShow "allSat4" $            allSat $ \x -> x .<  (0::SWord8)-    , goldenVsStringShow "allSat5" $ fmap srt $ allSat $ \x y -> x .< y &&& y .< (4::SWord8)-    , goldenVsStringShow "allSat6" $            allSat $ exists "x" >>= \x -> exists "y" >>= \y -> forall "z" >>= \z -> return (x .< (y::SWord8) &&& y .< 3 &&& z .== (z::SWord8))+    , goldenVsStringShow "allSat5" $ fmap srt $ allSat $ \x y -> x .< y .&& y .< (4::SWord8)+    , goldenVsStringShow "allSat6" $            allSat $ exists "x" >>= \x -> exists "y" >>= \y -> forall "z" >>= \z -> return (x .< (y::SWord8) .&& y .< 3 .&& z .== (z::SWord8))     ]  srt :: AllSatResult -> AllSatResult srt (AllSatResult (b1, b2, rs)) = AllSatResult (b1, b2, sortOn getModelDictionary rs) -newtype Q = Q () deriving (Eq, Ord, Data, Read, Show, SymWord, HasKind)+newtype Q = Q () deriving (Eq, Ord, Data, Read, Show, SymVal, HasKind) type SQ = SBV Q  t1 :: IO AllSatResult@@ -45,4 +45,4 @@ t2 = allSat $ do x <- free "x"                  y <- free "y"                  z <- free "z"-                 return $ x .== (y :: SQ) &&& z .== (z :: SQ)+                 return $ x .== (y :: SQ) .&& z .== (z :: SQ)
SBVTestSuite/TestSuite/Basics/ArithNoSolver.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.ArithNoSolver--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.ArithNoSolver+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for basic concrete arithmetic, i.e., testing all -- the constant folding based arithmetic implementation in SBV@@ -173,7 +173,7 @@         ++ map pair [(show x, show y, "shr_i8_w16", literal x `sShiftRight` literal y,  x `shiftR` fromIntegral y) | x <- i8s,  y <- yw16s]         ++ map pair [(show x, show y, "shl_i16_w8", literal x `sShiftLeft`  literal y,  x `shiftL` fromIntegral y) | x <- i16s, y <- w8s]         ++ map pair [(show x, show y, "shr_i16_w8", literal x `sShiftRight` literal y,  x `shiftR` fromIntegral y) | x <- i16s, y <- w8s]-   where pair :: (SymWord a, Show a) => (String, String, String, SBV a, a) -> (String, Bool)+   where pair :: (SymVal a, Show a) => (String, String, String, SBV a, a) -> (String, Bool)          pair (x, y, l, sr, lr) = (l ++ "." ++ x ++ "_" ++ y ++ "_" ++  show (unliteral sr) ++ "_" ++ show lr, isJust (unliteral sr) && unliteral sr == Just lr)          mkTest (l, s) = testCase ("arithCF-genShiftMixSize" ++ l) (s `showsAs` "True") @@ -231,7 +231,7 @@    where mkTest (x, r) = testCase ("intCast-" ++ x) (r `showsAs` "True")          lhs x = sFromIntegral (literal x)          rhs x = literal (fromIntegral x)-         cast :: forall a. (Show a, Integral a, SymWord a) => [a] -> [(String, SBool)]+         cast :: forall a. (Show a, Integral a, SymVal a) => [a] -> [(String, SBool)]          cast xs = toWords xs ++ toInts xs          toWords xs =  [(show x, lhs x .== (rhs x :: SWord8 ))  | x <- xs]                     ++ [(show x, lhs x .== (rhs x :: SWord16))  | x <- xs]@@ -439,7 +439,7 @@         alt0 x y = isNegativeZero x && y == 0 && not (isNegativeZero y)         uTests = map mkTest1 $  concatMap (checkPred fs sfs) predicates                              ++ concatMap (checkPred ds sds) predicates-        extract :: SymWord a => SBV a -> a+        extract :: SymVal a => SBV a -> a         extract = fromJust . unliteral          comb  (x, y, a, b) = (show x, show y, same a b)@@ -447,7 +447,7 @@         combN (x, y, a, b) = (show x, show y, checkNaN f x y a b) where f v w =      v && w   -- /=: Both should be True         combE (x, y, a, b) = (show x, show y, a == b)         comb1 (x, a, b)    = (show x, same a b)-        same a b = (isNaN a &&& isNaN b) || (a == b)+        same a b = (isNaN a && isNaN b) || (a == b)         checkNaN f x y a b           | isNaN x || isNaN y = f a b           | True               = a == b
SBVTestSuite/TestSuite/Basics/ArithSolver.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.ArithSolver--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.ArithSolver+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for basic non-concrete arithmetic, i.e., testing all -- basic arithmetic reasoning using an SMT solver without any@@ -19,7 +19,7 @@  import qualified Data.Numbers.CrackNum as RC (wordToFloat, wordToDouble, floatToWord, doubleToWord) -import Data.SBV.Internals+import Data.SBV.Internals hiding (free, free_) import Utils.SBVTestFramework  import Data.List (genericIndex, isInfixOf, isPrefixOf, isSuffixOf, genericTake, genericDrop, genericLength)@@ -203,7 +203,7 @@          yw16s = [0, 255, 256, 257, maxBound]           mkTest (x, y, l, t) = testCase ("genShiftMixSize." ++ l ++ "." ++ x ++ "_" ++ y) (assert t)-         mk :: (SymWord a, SymWord b) => (SBV a -> SBV b -> SBV a) -> a -> b -> a -> IO Bool+         mk :: (SymVal a, SymVal b) => (SBV a -> SBV b -> SBV a) -> a -> b -> a -> IO Bool          mk o x y r           = isTheorem $ do a <- free "x"                            b <- free "y"@@ -260,7 +260,7 @@                          ++ cast i8s ++ cast i16s ++ cast i32s ++ cast i64s                          ++ cast iUBs    where mkTest (x, t) = testCase ("sIntCast-" ++ x) (assert t)-         cast :: forall a. (Show a, Integral a, SymWord a) => [a] -> [(String, IO Bool)]+         cast :: forall a. (Show a, Integral a, SymVal a) => [a] -> [(String, IO Bool)]          cast xs = toWords xs ++ toInts xs          toWords xs =  [(show x, mkThm x (fromIntegral x :: Word8 ))  | x <- xs]                     ++ [(show x, mkThm x (fromIntegral x :: Word16))  | x <- xs]@@ -348,8 +348,8 @@           | isNaN          val        = constrain $ fpIsNaN v           | isNegativeZero val        = constrain $ fpIsNegativeZero v           | val == 0                  = constrain $ fpIsPositiveZero v-          | isInfinite val && val > 0 = constrain $ fpIsInfinite v &&& fpIsPositive v-          | isInfinite val && val < 0 = constrain $ fpIsInfinite v &&& fpIsNegative v+          | isInfinite val && val > 0 = constrain $ fpIsInfinite v .&& fpIsPositive v+          | isInfinite val && val < 0 = constrain $ fpIsInfinite v .&& fpIsNegative v           | True                      = constrain $ v .== literal val          -- Quickly pick which solver to use. Currently z3 or mathSAT supports FP@@ -381,7 +381,7 @@                                           eqF a x                                           eqF b y                                           return $ if isNaN x || isNaN y-                                                   then (if neq then a `op` b else bnot (a `op` b))+                                                   then (if neq then a `op` b else sNot (a `op` b))                                                    else literal r .== a `op` b          predicates :: (IEEEFloating a) => [(String, SBV a -> SBool, a -> Bool)]@@ -469,8 +469,8 @@           | isNaN          val        = constrain $ fpIsNaN v           | isNegativeZero val        = constrain $ fpIsNegativeZero v           | val == 0                  = constrain $ fpIsPositiveZero v-          | isInfinite val && val > 0 = constrain $ fpIsInfinite v &&& fpIsPositive v-          | isInfinite val && val < 0 = constrain $ fpIsInfinite v &&& fpIsNegative v+          | isInfinite val && val > 0 = constrain $ fpIsInfinite v .&& fpIsPositive v+          | isInfinite val && val < 0 = constrain $ fpIsInfinite v .&& fpIsNegative v           | True                      = constrain $ v .== literal val          -- Quickly pick which solver to use. Currently z3 or mathSAT supports FP
SBVTestSuite/TestSuite/Basics/Assert.hs view
@@ -1,13 +1,15 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.Assert--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.Assert+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test the sAssert feature. -----------------------------------------------------------------------------++{-# LANGUAGE FlexibleContexts #-}  module TestSuite.Basics.Assert(tests) where
SBVTestSuite/TestSuite/Basics/BasicTests.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.BasicTests--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.BasicTests+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.Basics.BasicTests -----------------------------------------------------------------------------@@ -14,7 +14,7 @@  module TestSuite.Basics.BasicTests(tests) where -import Data.SBV.Internals+import Data.SBV.Internals hiding (forall, output) import Utils.SBVTestFramework  -- Test suite
SBVTestSuite/TestSuite/Basics/BoundedList.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.BoundedList--- Copyright   :  (c) Joel Burget--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.BoundedList+-- Author    : Joel Burget+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test the bounded sequence/list functions. -----------------------------------------------------------------------------@@ -20,21 +20,21 @@  import Data.SBV.List ((.:), (.!!)) import qualified Data.SBV.List as L-import qualified Data.SBV.List.Bounded as BL+import qualified Data.SBV.Tools.BoundedList as BL  import Control.Monad (unless) import Control.Monad.State  -- | Flag to mark a failed computation newtype Failure = Failure SBool-  deriving (Boolean, Mergeable, EqSymbolic)+  deriving (Mergeable, EqSymbolic)  -- | Evaluation monad with failure newtype Eval a = Eval { unEval :: State Failure a }   deriving (Functor, Applicative, Monad, MonadState Failure)  runEval :: Eval a -> (a, Failure)-runEval (Eval eval) = runState eval false+runEval (Eval eval) = runState eval (Failure sFalse)  instance Mergeable a => Mergeable (Eval a) where   symbolicMerge force test left right = Eval $ state $ \s0 ->@@ -45,7 +45,7 @@        )  markFailure :: SBool -> Eval ()-markFailure failure = modify (||| Failure failure)+markFailure failure = modify (\(Failure b) -> Failure (b .|| failure))  -- Test suite tests :: TestTree@@ -133,26 +133,26 @@              let sorted = BL.bsort 3 $ L.implode [a, b, c]                   ordered :: (SInteger, SInteger, SInteger) -> SBool-                 ordered (x, y, z) = x .<= y &&& y .<= z+                 ordered (x, y, z) = x .<= y .&& y .<= z -             constrain $ ordered (a, b, c) ==> sorted .== L.implode [a, b, c]-             constrain $ ordered (a, c, b) ==> sorted .== L.implode [a, c, b]-             constrain $ ordered (b, a, c) ==> sorted .== L.implode [b, a, c]-             constrain $ ordered (b, c, a) ==> sorted .== L.implode [b, c, a]-             constrain $ ordered (c, a, b) ==> sorted .== L.implode [c, a, b]-             constrain $ ordered (c, b, a) ==> sorted .== L.implode [c, b, a]+             constrain $ ordered (a, b, c) .=> sorted .== L.implode [a, b, c]+             constrain $ ordered (a, c, b) .=> sorted .== L.implode [a, c, b]+             constrain $ ordered (b, a, c) .=> sorted .== L.implode [b, a, c]+             constrain $ ordered (b, c, a) .=> sorted .== L.implode [b, c, a]+             constrain $ ordered (c, a, b) .=> sorted .== L.implode [c, a, b]+             constrain $ ordered (c, b, a) .=> sorted .== L.implode [c, b, a]  -- | Increment, failing if a value lies outside of [0, 10] boundedIncr :: SList Integer -> Eval (SList Integer) boundedIncr = BL.bmapM 10 $ \i -> do-  markFailure $ i .< 0 ||| i .> 10+  markFailure $ i .< 0 .|| i .> 10   pure $ i + 1  -- | Max (based on foldr), failing if a value lies outside of [0, 10] boundedMaxr :: SList Integer -> Eval SInteger boundedMaxr = BL.bfoldrM 10   (\i maxi -> do-    markFailure $ i .< 0 ||| i .> 10+    markFailure $ i .< 0 .|| i .> 10     pure $ smax i maxi)   0 @@ -160,7 +160,7 @@ boundedMaxl :: SList Integer -> Eval SInteger boundedMaxl = BL.bfoldlM 10   (\maxi i -> do-    markFailure $ i .< 0 ||| i .> 10+    markFailure $ i .< 0 .|| i .> 10     pure $ smax i maxi)   0 @@ -170,7 +170,7 @@ mapWithFailure = do   lst <- sList "ints"   let (lst', failure) = runEval $ boundedIncr lst-  constrain $ lst' .!! 2 .> 11 ==> failure .== true+  constrain $ lst' .!! 2 .> 11 .=> failure .== Failure sTrue  -- mapping over these values of a, b, and c cannot fail (this is unsat) mapNoFailure :: Symbolic ()@@ -178,7 +178,7 @@   [a, b, c] <- sIntegers ["a", "b", "c"]   let (_lst', Failure failure) = runEval $ boundedIncr $ L.implode [a, b, c]   constrain $ a + b + c .== 6-  constrain $ a .> 0 &&& b .> 0 &&& c .> 0+  constrain $ a .> 0 .&& b .> 0 .&& c .> 0   constrain failure  -- boundedMaxl fails if one of the values is too big@@ -186,11 +186,11 @@ maxlWithFailure = do   lst <- sList "ints"   let (maxi, Failure failure) = runEval $ boundedMaxl lst-  constrain $ maxi .> 10 ==> failure+  constrain $ maxi .> 10 .=> failure  -- boundedMaxl fails if one of the values is too big maxrWithFailure :: Symbolic () maxrWithFailure = do   lst <- sList "ints"   let (maxi, Failure failure) = runEval $ boundedMaxr lst-  constrain $ maxi .> 10 ==> failure+  constrain $ maxi .> 10 .=> failure
SBVTestSuite/TestSuite/Basics/Exceptions.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.Exceptions--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.Exceptions+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test the exception mechanism -----------------------------------------------------------------------------@@ -32,7 +32,7 @@                              `C.catch` \(e :: SBVException) -> do appendFile rf "CAUGHT SMT EXCEPTION"                                                                   appendFile rf (show e)  where exc = do x <- sWord32 "x"-                constrain $ lsb x ==> (x * (x .^ (-1::SWord32))) .== 1+                constrain $ lsb x .=> (x * (x .^ (-1::SWord32))) .== 1                 query $ do cs <- checkSat                            cs `seq` return ()
SBVTestSuite/TestSuite/Basics/GenBenchmark.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.GenBenchmark--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.GenBenchmark+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test the generateSMTBenchmark function. -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Basics/Higher.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.Higher--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.Higher+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.Basics.Higher -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Basics/Index.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.Index--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.Index+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.Basics.Index -----------------------------------------------------------------------------@@ -37,7 +37,7 @@                 r2 = (select :: [SWord8] -> SWord8 -> SWord8 -> SWord8) elts err ind2                 r3 = slowSearch elts err ind                 r4 = slowSearch elts err ind2-            return $ r1 .== r3 &&& r2 .== r4+            return $ r1 .== r3 .&& r2 .== r4  where slowSearch elts err i = ite (i .< 0) err (go elts i)          where go []     _      = err                go (x:xs) curInd = ite (curInd .== 0) x (go xs (curInd - 1))@@ -56,7 +56,7 @@                 r2 = (select :: [(SWord8, SWord8)] -> (SWord8, SWord8) -> SWord8 -> (SWord8, SWord8)) elts err ind2                 r3 = slowSearch elts err ind                 r4 = slowSearch elts err ind2-            return $ r1 .== r3 &&& r2 .== r4+            return $ r1 .== r3 .&& r2 .== r4  where slowSearch elts err i = ite (i .< 0) err (go elts i)          where go []     _      = err                go (x:xs) curInd = ite (curInd .== 0) x (go xs (curInd - 1))
SBVTestSuite/TestSuite/Basics/IteTest.hs view
@@ -1,26 +1,28 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.IteTest--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.IteTest+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test various incarnations of laziness in ite -----------------------------------------------------------------------------  module TestSuite.Basics.IteTest(tests)  where +import Data.SBV.Internals (Result)+ import Utils.SBVTestFramework  chk1 :: (SBool -> SBool -> SBool -> SBool) -> SWord8 -> SBool-chk1 cond x = cond (x .== x) true undefined+chk1 cond x = cond (x .== x) sTrue undefined  chk2 :: (SBool -> [SBool] -> [SBool] -> [SBool]) -> SWord8 -> SBool-chk2 cond x = head (cond (x .== x) [true] [undefined])+chk2 cond x = head (cond (x .== x) [sTrue] [undefined])  chk3 :: (SBool -> (SBool, SBool) -> (SBool, SBool)  -> (SBool, SBool)) -> SWord8 -> SBool-chk3 cond x = fst (cond (x .== x) (true, undefined::SBool) (undefined, undefined))+chk3 cond x = fst (cond (x .== x) (sTrue, undefined::SBool) (undefined, undefined))  -- Test suite tests :: TestTree@@ -33,4 +35,5 @@     , testCase "iteTest5" (assertIsThm (chk2 iteLazy))     , testCase "iteTest6" (assertIsThm (chk3 iteLazy))     ]- where rs f = runSAT $ forAll ["x"] f+ where rs :: (SWord8 -> SBool) -> IO Result+       rs f = runSAT $ forAll ["x"] f
SBVTestSuite/TestSuite/Basics/List.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.List--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.List+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test the sequence/list functions. -- Most of these tests are adopted from <http://rise4fun.com/z3/tutorialcontent/sequences>@@ -68,7 +68,7 @@  -- Basic sequence operations seqExamples1 :: Symbolic ()-seqExamples1 = constrain $ bAnd+seqExamples1 = constrain $ sAnd   [ L.singleton (([1,2,3] :: SList Integer) .!! 1) .++ L.singleton (([1,2,3] :: SList Integer) .!! 0) .== [2,1]   , ([1,2,3,1,2,3] :: SList Integer) `L.indexOf` [1]                                                  .== 0   , L.offsetIndexOf ([1,2,3,1,2,3] :: SList Integer) [1] 1                                            .== 3@@ -87,7 +87,7 @@   [a, b, c :: SList Integer] <- sLists ["a", "b", "c"]   constrain $ a .++ b .== [1..4]   constrain $ b .++ c .== [3..6]-  constrain $ bnot $ b .== []+  constrain $ sNot $ b .== []  -- There is a solution to a of length at most 2. seqExamples4 :: Symbolic ()@@ -102,7 +102,7 @@   [a, b, c :: SList Integer] <- sLists ["a", "b", "c"]   constrain $ a .++ [1,2] .++ b .== b .++ [2,1] .++ c   constrain $ c .== a .++ b-  constrain $ bnot $ a.++ [1] .== [1] .++ a+  constrain $ sNot $ a.++ [1] .== [1] .++ a  -- Contains is transitive. seqExamples6 :: Symbolic ()@@ -110,7 +110,7 @@   [a, b, c :: SList Integer] <- sLists ["a", "b", "c"]   constrain $ b `L.isInfixOf` a   constrain $ c `L.isInfixOf` b-  constrain $ bnot $ c `L.isInfixOf` a+  constrain $ sNot $ c `L.isInfixOf` a  -- But containment is not a linear order. seqExamples7 :: Symbolic ()@@ -118,8 +118,8 @@   [a, b, c :: SList Integer] <- sLists ["a", "b", "c"]   constrain $ b `L.isInfixOf` a   constrain $ c `L.isInfixOf` a-  constrain $ bnot $ c `L.isInfixOf` b-  constrain $ bnot $ b `L.isInfixOf` c+  constrain $ sNot $ c `L.isInfixOf` b+  constrain $ sNot $ b `L.isInfixOf` c  -- Any string is equal to the prefix and suffix that add up to a its length. seqExamples8 :: Symbolic ()@@ -128,7 +128,7 @@   constrain $ b `L.isPrefixOf` a   constrain $ c `L.isSuffixOf` a   constrain $ L.length a .== L.length b + L.length c-  constrain $ bnot $ a .== b .++ c+  constrain $ sNot $ a .== b .++ c  -- Generate all length one sequences, to enumerate all and making sure we can parse correctly seqExamples9 :: IO Bool
SBVTestSuite/TestSuite/Basics/ProofTests.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.ProofTests--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.ProofTests+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.Basics.ProofTests -----------------------------------------------------------------------------@@ -27,7 +27,7 @@     , testCase "proofs-9" (assertIsSat (exists "x" >>= \x -> return x :: Predicate))     ] -xyEq :: (EqSymbolic a, SymWord a1) => (SBV a1 -> SBV Word8 -> a) -> (SBV a1 -> SWord8 -> a) -> Symbolic SBool+xyEq :: (EqSymbolic a, SymVal a1) => (SBV a1 -> SBV Word8 -> a) -> (SBV a1 -> SWord8 -> a) -> Symbolic SBool func1 `xyEq` func2 = do x <- exists_                         y <- exists_                         return $ func1 x y .== func2 x (y :: SWord8)
SBVTestSuite/TestSuite/Basics/PseudoBoolean.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.PseudoBoolean--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.PseudoBoolean+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test the pseudo-boolean functions -----------------------------------------------------------------------------@@ -35,7 +35,7 @@ checkWith :: SMTConfig -> ([SBool] -> SBool) -> IO () checkWith cfg spec = runSMTWith cfg{verbose=True} $ do         bs <- sBools $ map (\i -> "b" ++ show i) [0..(9::Int)]-        constrain $ bnot (spec bs)+        constrain $ sNot (spec bs)         query $ do cs <- checkSat                    case cs of                      Unsat -> return ()@@ -69,8 +69,8 @@ -- Reported here as a bug <http://github.com/Z3Prover/z3/issues/1571> -- and SBV didn't catch this. So let's add it as a test case. propPbEq2 :: [SBool] -> SBool-propPbEq2 bs = (c1 &&& c2) ==> (   ([a, b, c, d, e] .== [false, true, false, true, false])-                               ||| ([a, b, c, d, e] .== [false, true, false, false, true]))+propPbEq2 bs = (c1 .&& c2) .=> (   ([a, b, c, d, e] .== [sFalse, sTrue, sFalse, sTrue, sFalse])+                               .|| ([a, b, c, d, e] .== [sFalse, sTrue, sFalse, sFalse, sTrue]))   where ~(a : b : c : d : e : _) = take 5 bs         c1 = ite a (pbEq [(1, b), (1, c)]         3) (pbEq [(1, b), (1, c)]         1)         c2 = ite c (pbEq [(1, a), (1, d), (1, e)] 3) (pbEq [(1, a), (1, d), (1, e)] 1)
SBVTestSuite/TestSuite/Basics/QRem.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.QRem--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.QRem+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.Basics.QRem -----------------------------------------------------------------------------@@ -27,7 +27,7 @@ -- defined to be 0 and the remainder is the numerator qrem :: (Num a, EqSymbolic a, SDivisible a) => a -> a -> SBool qrem x y = ite (y .== 0)-               ((0, x) .== (q, r) &&& (0, x) .== (d, m))-               (x .== y * q + r &&& x .== y * d + m)+               ((0, x) .== (q, r) .&& (0, x) .== (d, m))+               (x .== y * q + r .&& x .== y * d + m)   where (q, r) = x `sQuotRem` y         (d, m) = x `sDivMod` y
SBVTestSuite/TestSuite/Basics/Quantifiers.hs view
@@ -1,14 +1,16 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.Quantifiers--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.Quantifiers+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Various combinations of quantifiers ----------------------------------------------------------------------------- +{-# LANGUAGE FlexibleContexts #-}+ module TestSuite.Basics.Quantifiers(tests) where  import Control.Monad (void)@@ -27,7 +29,7 @@          qs   = [(exists, "exists"), (forall, "forall")]           acts = [ (\x y -> x + (y - x) .== y  , "thm")-                , (\x y -> x .== y &&& x ./= y, "contradiction")+                , (\x y -> x .== y .&& x ./= y, "contradiction")                 , (\x y -> x .== y + 1        , "satisfiable")                 ]
SBVTestSuite/TestSuite/Basics/Recursive.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.Recursive--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.Recursive+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Some recursive definitions. -----------------------------------------------------------------------------@@ -13,8 +13,8 @@  import Utils.SBVTestFramework -import Control.Monad.Reader (ask)-import Control.Monad.Trans  (liftIO)+import Data.SBV.Internals  (genMkSymVar, unSBV)+ import qualified Data.SBV.Dynamic as D  -- This is recursive and suffers from the termination problem.@@ -27,7 +27,7 @@ mgcdDyn i = D.proveWith z3 $ do                let var8 :: String -> Symbolic D.SVal-                  var8 nm = ask >>= liftIO . D.svMkSymVar (Just D.ALL) word8 (Just nm)+                  var8 nm = unSBV <$> genMkSymVar word8 (Just D.ALL) (Just nm)                    word8   = KBounded False 8                   zero8   = D.svInteger word8 0
SBVTestSuite/TestSuite/Basics/SmallShifts.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.SmallShift--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.SmallShifts+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing small-shift amounts using the dynamic interface. See -- http://github.com/LeventErkok/sbv/issues/323 for the genesis.@@ -14,9 +14,8 @@  import Utils.SBVTestFramework hiding (proveWith) -import Control.Monad.Reader (ask)-import Control.Monad.Trans  (liftIO) import Data.SBV.Dynamic+import Data.SBV.Internals  (genMkSymVar, unSBV)  k1, k32, k33 :: Kind k1   = KBounded False  1@@ -42,8 +41,8 @@                 `svPlus` (x `svAnd` (y `svAnd` svInteger k32 1))  prop :: Symbolic SVal-prop = do x <- ask >>= liftIO . svMkSymVar Nothing k32 (Just "x")-          y <- ask >>= liftIO . svMkSymVar Nothing k32 (Just "y")+prop = do x <- unSBV <$> genMkSymVar k32 Nothing (Just "x")+          y <- unSBV <$> genMkSymVar k32 Nothing (Just "y")           return $ average33 x y `svEqual` average4 x y  checkThm :: ThmResult -> Assertion
SBVTestSuite/TestSuite/Basics/SquashReals.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.SquashReals--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.SquashReals+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test the "squash" reals feature -----------------------------------------------------------------------------@@ -17,8 +17,8 @@ tests :: TestTree tests =   testGroup "Basics.Reals.Squash"-    [ goldenVsStringShow "squashReals1" $ sat                            (\x -> x .>= 0 &&& x*x .== (59::SReal))-    , goldenVsStringShow "squashReals2" $ sat                            (\x -> x .>= 0 &&& x*x .== (16::SReal))-    , goldenVsStringShow "squashReals3" $ satWith z3{printRealPrec = 35} (\x -> x .>= 0 &&& x*x .== (59::SReal))-    , goldenVsStringShow "squashReals4" $ satWith z3{printRealPrec = 35} (\x -> x .>= 0 &&& x*x .== (16::SReal))+    [ goldenVsStringShow "squashReals1" $ sat                            (\x -> x .>= 0 .&& x*x .== (59::SReal))+    , goldenVsStringShow "squashReals2" $ sat                            (\x -> x .>= 0 .&& x*x .== (16::SReal))+    , goldenVsStringShow "squashReals3" $ satWith z3{printRealPrec = 35} (\x -> x .>= 0 .&& x*x .== (59::SReal))+    , goldenVsStringShow "squashReals4" $ satWith z3{printRealPrec = 35} (\x -> x .>= 0 .&& x*x .== (16::SReal))     ]
SBVTestSuite/TestSuite/Basics/String.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.String--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.String+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test the string functions. -- Most of these tests are adopted from <http://rise4fun.com/z3/tutorialcontent/sequences>@@ -76,7 +76,7 @@  -- Basic string operations strExamples1 :: Symbolic ()-strExamples1 = constrain $ bAnd+strExamples1 = constrain $ sAnd   [ S.singleton ("abc" .!! 1) .++ S.singleton ("abc" .!! 0) .== "ba"   , "abcabc" `S.indexOf` "a"                                .== 0   , S.offsetIndexOf "abcabc" "a" 1                          .== 3@@ -95,7 +95,7 @@   [a, b, c] <- sStrings ["a", "b", "c"]   constrain $ a .++ b .== "abcd"   constrain $ b .++ c .== "cdef"-  constrain $ bnot $ b .== ""+  constrain $ sNot $ b .== ""  -- There is a solution to a of length at most 2. strExamples4 :: Symbolic ()@@ -110,7 +110,7 @@   [a, b, c] <- sStrings ["a", "b", "c"]   constrain $ a .++ "ab" .++ b .== b .++ "ba" .++ c   constrain $ c .== a .++ b-  constrain $ bnot $ a.++ "a" .== "a" .++ a+  constrain $ sNot $ a.++ "a" .== "a" .++ a  -- Contains is transitive. strExamples6 :: Symbolic ()@@ -118,7 +118,7 @@   [a, b, c] <- sStrings ["a", "b", "c"]   constrain $ b `S.isInfixOf` a   constrain $ c `S.isInfixOf` b-  constrain $ bnot $ c `S.isInfixOf` a+  constrain $ sNot $ c `S.isInfixOf` a  -- But containment is not a linear order. strExamples7 :: Symbolic ()@@ -126,8 +126,8 @@   [a, b, c] <- sStrings ["a", "b", "c"]   constrain $ b `S.isInfixOf` a   constrain $ c `S.isInfixOf` a-  constrain $ bnot $ c `S.isInfixOf` b-  constrain $ bnot $ b `S.isInfixOf` c+  constrain $ sNot $ c `S.isInfixOf` b+  constrain $ sNot $ b `S.isInfixOf` c  -- Any string is equal to the prefix and suffix that add up to a its length. strExamples8 :: Symbolic ()@@ -136,7 +136,7 @@   constrain $ b `S.isPrefixOf` a   constrain $ c `S.isSuffixOf` a   constrain $ S.length a .== S.length b + S.length c-  constrain $ bnot $ a .== b .++ c+  constrain $ sNot $ a .== b .++ c  -- The maximal length is 6 for a string of length 2 repeated at most 3 times strExamples9 :: Symbolic ()@@ -157,21 +157,21 @@ strExamples11 = do    i <- sInteger "i"    constrain $ i .== 11-   constrain $ bnot $ S.natToStr i .== "11"+   constrain $ sNot $ S.natToStr i .== "11"  -- Conversion from nat to string, negative values produce empty string strExamples12 :: Symbolic () strExamples12 = do    i <- sInteger "i"    constrain $ i .== -2-   constrain $ bnot $ S.natToStr i .== ""+   constrain $ sNot $ S.natToStr i .== ""  -- Conversion from string to nat, only ground terms strExamples13 :: Symbolic () strExamples13 = do    s <- sString "s"    constrain $ s .== "13"-   constrain $ bnot $ S.strToNat s .== 13+   constrain $ sNot $ S.strToNat s .== 13  -- Generate all length one strings, to enumerate all and making sure we can parse correctly strExamples14 :: IO Bool@@ -180,7 +180,7 @@                    let dicts = getModelDictionaries m                         vals :: [Int]-                       vals = map C.ord $ concat $ sort $ map (fromCW . snd) (concatMap M.assocs dicts)+                       vals = map C.ord $ concat $ sort $ map (fromCV . snd) (concatMap M.assocs dicts)                     case length dicts of                      256 -> return $ vals == [0 .. 255]
SBVTestSuite/TestSuite/Basics/TOut.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Basics.TOut--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Basics.TOut+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test the basic timeout mechanism -----------------------------------------------------------------------------
+ SBVTestSuite/TestSuite/Basics/Tuple.hs view
@@ -0,0 +1,123 @@+-----------------------------------------------------------------------------+-- |+-- Module    : TestSuite.Basics.Tuple+-- Author    : Joel Burget+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Test tuples.+-----------------------------------------------------------------------------++{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE DeriveAnyClass      #-}+{-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE TypeApplications    #-}++module TestSuite.Basics.Tuple (tests)  where++import Data.SBV.Control+import Data.SBV.List ((.!!), (.:))+import Data.SBV.Tuple++import qualified Data.SBV.List as L++import Utils.SBVTestFramework++data E = A | B | C+mkSymbolicEnumeration ''E++-- Test suite+tests :: TestTree+tests = testGroup "Basics.Tuple" [+          goldenCapturedIO "tuple_swap"       $ t tupleSwapSat+        , goldenCapturedIO "tuple_twoTwo"     $ t twoTwoTuples+        , goldenCapturedIO "tuple_nested"     $ t nested+        , goldenCapturedIO "tuple_list"       $ t list+        , goldenCapturedIO "tuple_enum"       $ t enum+        , goldenCapturedIO "tuple_unit"       $ t unit+        , goldenCapturedIO "tuple_makePair"   $ t makePair+        ]+    where t tc goldFile = do r <- runSMTWith defaultSMTCfg{verbose=True, redirectVerbose=Just goldFile} tc+                             appendFile goldFile ("\n FINAL: " ++ show r ++ "\nDONE!\n")++tupleSwapSat :: Symbolic ((Integer, Integer, Integer), (Integer, Integer, Integer))+tupleSwapSat = do+  [abx, bay] <- sTuples @(Integer, Integer, Integer) ["abx", "bay"]+  constrain $ abx^._1 .== bay^._2+  constrain $ abx^._2 .== bay^._1+  query $ do _ <- checkSat+             (,) <$> getValue abx <*> getValue bay++twoTwoTuples :: Symbolic ((Integer, String), (Char, Word8))+twoTwoTuples = do+  ab <- sTuple @(Integer, String) "ab"+  cd <- sTuple @(Char,    Word8)  "cd"+  constrain $ ab^._1 .== 1+  constrain $ cd^._1 .== literal 'c'+  query $ do _ <- checkSat+             (,) <$> getValue ab <*> getValue cd++nested :: Symbolic ((Integer, (String, Char)), Word8)+nested = do+  abcd <- sTuple @((Integer, (String, Char)), Word8) "abcd"+  constrain $     abcd^._1^._1 .== 1+  constrain $ abcd^._1^._2^._1 .== literal "foo"+  constrain $ abcd^._1^._2^._2 .== literal 'c'+  constrain $         abcd^._2 .== 0+  query $ do _ <- checkSat+             getValue abcd++list :: Symbolic [(Integer, [(Integer, String)])]+list = do+  lst <- sList @(Integer, [(Integer, String)]) "lst"++  constrain $ (lst .!! 0)^._1 .== 2+  constrain $ (((lst .!! 1)^._2) .!! 0)^._2 .== literal "foo"+  constrain $ L.length lst .== 4+  constrain $ L.length ((lst .!! 1)^._2) .== 5+  constrain $ L.length ((lst .!! 2)^._2) .== 0++  constrain $ lst .== literal [(2,[]), (1,[(3,"foo"), (0,"bar"), (-1,"baz"), (-2,"quux"), (-3,"enough")]), (-4,[]), (-5,[])]++  query $ do _ <- checkSat+             getValue lst++enum :: Symbolic ([(E, [Bool])], (Word8, (E, Char, Float)))+enum = do+   vTup1 :: SList (E, [Bool]) <- sTuple "v1"+   q <- sBool "q"+   constrain $ sNot q+   constrain $ (vTup1 .!! 1)^._2 .== sTrue .: q .: L.nil+   constrain $ L.length vTup1 .== 3++   case untuple (vTup1 .!! 2)  of+     (e, b) -> do constrain $ e .== literal C+                  constrain $ L.length b .== 6+                  constrain $ b .!! 4 .== sTrue++   query $ do+     vTup2 :: STuple2 Word8 (E, Char, Float) <- freshVar "v2"+     constrain $ vTup2 .== literal (5, (C, 'A', 8.12))++     constrain $ vTup1 .== literal [(B, []), (A, [True, False]), (C, [False, False, False, False, True, False])]++     _ <- checkSat+     (,) <$> getValue vTup1 <*> getValue vTup2++unit :: Symbolic ()+unit = do+  x <- sTuple @() "x"+  y <- sTuple @() "y"+  constrain $ x .== y++makePair :: Symbolic ()+makePair = do+  [x, y] <- sIntegers ["x", "y"]+  let xy = tuple (x, y)+  constrain $ xy^._1 + xy^._2 .== 0++{-# ANN module ("HLint: ignore Use ." :: String) #-}
SBVTestSuite/TestSuite/BitPrecise/BitTricks.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.BitPrecise.BitTricks--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.BitPrecise.BitTricks+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.BitPrecise.BitTricks -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/BitPrecise/Legato.hs view
@@ -1,17 +1,17 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.BitPrecise.Legato--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.BitPrecise.Legato+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.BitPrecise.Legato -----------------------------------------------------------------------------  module TestSuite.BitPrecise.Legato(tests) where -import Data.SBV.Internals+import Data.SBV.Internals hiding (free, output) import Documentation.SBV.Examples.BitPrecise.Legato  import Utils.SBVTestFramework@@ -35,6 +35,6 @@                     cgSetDriverValues [87, 92]                     x <- cgInput "x"                     y <- cgInput "y"-                    let (hi, lo) = runLegato (initMachine (x, y, 0, 0, 0, false, false))+                    let (hi, lo) = runLegato (initMachine (x, y, 0, 0, 0, sFalse, sFalse))                     cgOutput "hi" hi                     cgOutput "lo" lo)
SBVTestSuite/TestSuite/BitPrecise/MergeSort.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.BitPrecise.MergeSort--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.BitPrecise.MergeSort+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.BitPrecise.MergeSort -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/BitPrecise/PrefixSum.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.BitPrecise.PrefixSum--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.BitPrecise.PrefixSum+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.PrefixSum.PrefixSum -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/CRC/CCITT.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CRC.CCITT--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CRC.CCITT+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.CRC.CCITT -----------------------------------------------------------------------------@@ -48,6 +48,6 @@ -- Claim: If there is an undetected corruption, it must be at least at 4 bits; i.e. HD is 4 crcGood :: SWord48 -> SWord48 -> SBool crcGood sent received =-     sent ./= received ==> diffCount frameSent frameReceived .> 3+     sent ./= received .=> diffCount frameSent frameReceived .> 3    where frameSent     = mkFrame sent          frameReceived = mkFrame received
SBVTestSuite/TestSuite/CRC/CCITT_Unidir.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CRC.CCITT_Unidir--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CRC.CCITT_Unidir+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.CRC.CCITT_Unidir -----------------------------------------------------------------------------@@ -47,13 +47,13 @@  -- returns true if there's a 0->1 error (1->0 is ok) nonUnidir :: [SBool] -> [SBool] -> SBool-nonUnidir []     _      = false-nonUnidir _      []     = false-nonUnidir (a:as) (b:bs) = (bnot a &&& b) ||| nonUnidir as bs+nonUnidir []     _      = sFalse+nonUnidir _      []     = sTrue+nonUnidir (a:as) (b:bs) = (sNot a .&& b) .|| nonUnidir as bs  crcUniGood :: SWord8 -> SWord48 -> SWord48 -> SBool crcUniGood hd sent received =-     sent ./= received ==> nonUnidir frameSent frameReceived ||| diffCount frameSent frameReceived .> hd+     sent ./= received .=> nonUnidir frameSent frameReceived .|| diffCount frameSent frameReceived .> hd    where frameSent     = blastLE $ mkFrame sent          frameReceived = blastLE $ mkFrame received
SBVTestSuite/TestSuite/CRC/GenPoly.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CRC.GenPoly--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CRC.GenPoly+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.CRC.GenPoly -----------------------------------------------------------------------------@@ -53,7 +53,7 @@  crcGood :: SWord8 -> SWord16 -> SWord48 -> SWord48 -> SBool crcGood hd divisor sent received =-     sent ./= received ==> diffCount frameSent frameReceived .> hd+     sent ./= received .=> diffCount frameSent frameReceived .> hd    where frameSent     = mkFrame poly sent          frameReceived = mkFrame poly received          poly          = mkPoly divisor
SBVTestSuite/TestSuite/CRC/Parity.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CRC.Parity--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CRC.Parity+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.CRC.Parity -----------------------------------------------------------------------------@@ -20,7 +20,7 @@     ]  parity :: SWord64 -> SBool-parity x = bnot (isOdd cnt)+parity x = sNot (isOdd cnt)   where cnt :: SWord8         cnt = sum $ map oneIf $ blastLE x @@ -30,7 +30,7 @@ -- Example suggested by Lee Pike -- If x and y differ in odd-number of bits, then their parities are flipped parityOK :: SWord64 -> SWord64 -> SBool-parityOK x y = isOdd cnt ==> px .== bnot py+parityOK x y = isOdd cnt .=> px .== sNot py   where cnt = sum $ map oneIf $ zipWith (./=) (blastLE x) (blastLE y)         px  = parity x         py  = parity y
SBVTestSuite/TestSuite/CRC/USB5.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CRC.USB5--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CRC.USB5+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.CRC.USB5 -----------------------------------------------------------------------------@@ -50,7 +50,7 @@ -- Claim: If there is an undetected corruption, it must be at least at 3 bits usbGood :: SWord16 -> SWord16 -> SBool usbGood sent16 received16 =-    sent ./= received ==> diffCount frameSent frameReceived .>= 3+    sent ./= received .=> diffCount frameSent frameReceived .>= 3    where sent     = mkSWord11 sent16          received = mkSWord11 received16          frameSent     = mkFrame sent
SBVTestSuite/TestSuite/CodeGeneration/AddSub.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CodeGeneration.AddSub--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CodeGeneration.AddSub+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.CodeGeneration.AddSub -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/CodeGeneration/CRC_USB5.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CodeGeneration.CRC_USB5--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CodeGeneration.CRC_USB5+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.CodeGeneration.CRC_USB5 -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/CodeGeneration/CgTests.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CodeGeneration.CgTests--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CodeGeneration.CgTests+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for code-generation features -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/CodeGeneration/Fibonacci.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CodeGeneration.Fibonacci--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CodeGeneration.Fibonacci+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.CodeGeneration.Fibonacci -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/CodeGeneration/Floats.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CodeGeneration.Floats--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CodeGeneration.Floats+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test-suite for generating floating-point related C code -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/CodeGeneration/GCD.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CodeGeneration.GCD--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CodeGeneration.GCD+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.CodeGeneration.GCD -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/CodeGeneration/PopulationCount.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CodeGeneration.PopulationCount--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CodeGeneration.PopulationCount+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.CodeGeneration.PopulationCount -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/CodeGeneration/Uninterpreted.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.CodeGeneration.Uninterpreted--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.CodeGeneration.Uninterpreted+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.CodeGeneration.Uninterpreted -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Crypto/AES.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Crypto.AES--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Crypto.AES+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Crypto.AES -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Crypto/RC4.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Crypto.RC4--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Crypto.RC4+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Crypto.RC4 -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Existentials/CRCPolynomial.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Existentials.CRCPolynomial--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Existentials.CRCPolynomial+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Existentials.CRCPolynomial -----------------------------------------------------------------------------@@ -28,4 +28,4 @@                 r <- do rh <- forall "rh"                         rl <- forall "rl"                         return (rh, rl)-                output $ sTestBit p 0 &&& crcGood 4 p s r+                output $ sTestBit p 0 .&& crcGood 4 p s r
SBVTestSuite/TestSuite/GenTest/GenTests.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.GenTest.GenTests--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.GenTest.GenTests+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test-suite for generating tests -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Optimization/AssertWithPenalty.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Optimization.AssertWithPenalty--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Optimization.AssertWithPenalty+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for optimization routines, soft assertions -----------------------------------------------------------------------------@@ -31,12 +31,12 @@                      a3 = x+y .<= 0                   constrain $ a1 .== a3-                 constrain $ a3 ||| a2+                 constrain $ a3 .|| a2                   assertWithPenalty "as1" a3        (Penalty  3 Nothing)-                 assertWithPenalty "as2" (bnot a3) (Penalty  5 Nothing)-                 assertWithPenalty "as3" (bnot a1) (Penalty 10 Nothing)-                 assertWithPenalty "as4" (bnot a2) (Penalty  3 Nothing)+                 assertWithPenalty "as2" (sNot a3) (Penalty  5 Nothing)+                 assertWithPenalty "as3" (sNot a1) (Penalty 10 Nothing)+                 assertWithPenalty "as4" (sNot a2) (Penalty  3 Nothing)  assertWithPenalty2 :: Goal assertWithPenalty2 = do@@ -47,4 +47,4 @@                  assertWithPenalty "as_a1" a1                    (Penalty  0.1 Nothing)                  assertWithPenalty "as_a2" a2                    (Penalty  1.0 Nothing)                  assertWithPenalty "as_a3" a3                    (Penalty  1   Nothing)-                 assertWithPenalty "as_a4" (bnot a1 ||| bnot a2) (Penalty 3.2 Nothing)+                 assertWithPenalty "as_a4" (sNot a1 .|| sNot a2) (Penalty 3.2 Nothing)
SBVTestSuite/TestSuite/Optimization/Basics.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Optimization.Basics--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Optimization.Basics+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for optimization routines -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Optimization/Combined.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Optimization.Combined--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Optimization.Combined+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for optimization routines, combined objectives -----------------------------------------------------------------------------@@ -48,7 +48,7 @@                assertWithPenalty "soft_c" c (Penalty 3 (Just "A"))                 constrain $ a .== c-               constrain $ bnot (a &&& b)+               constrain $ sNot (a .&& b)  pareto1 :: Goal pareto1 = do x <- sInteger "x"
SBVTestSuite/TestSuite/Optimization/ExtensionField.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Optimization.ExtensionField--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Optimization.ExtensionField+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for optimization routines, extension field -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Optimization/NoOpt.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Optimization.NoOpt--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Optimization.NoOpt+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Check that if optimization is done, there must be goals and vice versa -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Optimization/Quantified.hs view
@@ -1,14 +1,15 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Optimization.Quantified--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Optimization.Quantified+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for optimization iwth quantifiers ----------------------------------------------------------------------------- +{-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE ScopedTypeVariables #-}  module TestSuite.Optimization.Quantified(tests) where
SBVTestSuite/TestSuite/Optimization/Reals.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Optimization.Reals--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Optimization.Reals+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for optimization routines, reals -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Overflows/Arithmetic.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Overflows.Arithmetic--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Overflows.Arithmetic+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for overflow checking -----------------------------------------------------------------------------@@ -131,7 +131,7 @@ exactlyWhen (SBV a) b = SBV $ (a `svAnd` b) `svOr` (svNot a `svAnd` svNot b)  -- Properly extend to a dynamic large vector-toLarge :: SBV a -> SLarge+toLarge :: HasKind a => SBV a -> SLarge toLarge v   | extra < 0 = error $ "toLarge: Unexpected size: " ++ show (n, large)   | hasSign v = p `svJoin` dv@@ -147,7 +147,7 @@         p     = svIte pos z o  -- Multiplication checks are expensive. For these, we simply check that the SBV encodings and the z3 versions are equivalent-mulChkO :: forall a. (SymWord a) => (SBV a -> SBV a -> (SBool, SBool)) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate+mulChkO :: forall a. SymVal a => (SBV a -> SBV a -> (SBool, SBool)) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate mulChkO fast slow = do setLogic Logic_NONE                        x <- free "x"                        y <- free "y"@@ -158,7 +158,7 @@                        return $ ov1 .== ov2  -- Underflow mults-mulChkU :: forall a. (SymWord a) => (SBV a -> SBV a -> (SBool, SBool)) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate+mulChkU :: forall a. SymVal a => (SBV a -> SBV a -> (SBool, SBool)) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate mulChkU fast slow = do setLogic Logic_NONE                        x <- free "x"                        y <- free "y"@@ -169,7 +169,7 @@                        return $ uf1 .== uf2  -- Signed division can only underflow under one condition, check that simply instead of trying to do an expensive embedding proof-divChk :: forall a. (Integral a, Bounded a, SymWord a) => (SLarge -> SLarge -> SLarge) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate+divChk :: forall a. (Integral a, Bounded a, SymVal a) => (SLarge -> SLarge -> SLarge) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate divChk _op cond = do x  <- free "x"                      y  <- free "y" @@ -185,7 +185,7 @@  -- For a few cases, we expect them to "never" overflow. The "embedding proofs" are either too expensive (in case of division), or -- not possible (in case of negation). We capture these here.-never :: forall a. (Integral a, Bounded a, SymWord a) => (SLarge -> SLarge -> SLarge) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate+never :: forall a. (Integral a, Bounded a, SymVal a) => (SLarge -> SLarge -> SLarge) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate never _op cond = do x  <- free "x"                     y  <- free "y" @@ -193,14 +193,14 @@                      return $ underflowHappens `exactlyWhen` svFalse -never1 :: forall a. (Integral a, Bounded a, SymWord a) => (SLarge -> SLarge) -> (SBV a -> (SBool, SBool)) -> Predicate+never1 :: forall a. (Integral a, Bounded a, SymVal a) => (SLarge -> SLarge) -> (SBV a -> (SBool, SBool)) -> Predicate never1 _op cond = do x  <- free "x"                       let (underflowHappens, _) = cond x                       return $ underflowHappens `exactlyWhen` svFalse -underflow :: forall a. (Integral a, Bounded a, SymWord a) => (SLarge -> SLarge -> SLarge) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate+underflow :: forall a. (Integral a, Bounded a, SymVal a) => (SLarge -> SLarge -> SLarge) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate underflow op cond = do x  <- free "x"                        y  <- free "y" @@ -212,7 +212,7 @@                         return $ underflowHappens `exactlyWhen` (extResult `svLessThan` toLarge (minBound :: SBV a)) -overflow :: forall a. (Integral a, Bounded a, SymWord a) => (SLarge -> SLarge -> SLarge) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate+overflow :: forall a. (Integral a, Bounded a, SymVal a) => (SLarge -> SLarge -> SLarge) -> (SBV a -> SBV a -> (SBool, SBool)) -> Predicate overflow op cond = do x  <- free "x"                       y  <- free "y" @@ -223,7 +223,7 @@                        return $ overflowHappens `exactlyWhen` (extResult `svGreaterThan` toLarge (maxBound :: SBV a)) -underflow1 :: forall a. (Integral a, Bounded a, SymWord a) => (SLarge -> SLarge) -> (SBV a -> (SBool, SBool)) -> Predicate+underflow1 :: forall a. (Integral a, Bounded a, SymVal a) => (SLarge -> SLarge) -> (SBV a -> (SBool, SBool)) -> Predicate underflow1 op cond = do x  <- free "x"                          let (underflowHappens, _) = cond x@@ -233,7 +233,7 @@                          return $ underflowHappens `exactlyWhen` (extResult `svLessThan` toLarge (minBound :: SBV a)) -overflow1 :: forall a. (Integral a, Bounded a, SymWord a) => (SLarge -> SLarge) -> (SBV a -> (SBool, SBool)) -> Predicate+overflow1 :: forall a. (Integral a, Bounded a, SymVal a) => (SLarge -> SLarge) -> (SBV a -> (SBool, SBool)) -> Predicate overflow1 op cond = do x  <- free "x"                         let (_, overflowHappens) = cond x
SBVTestSuite/TestSuite/Overflows/Casts.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Overflows.Casts--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Overflows.Casts+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for overflow checking -----------------------------------------------------------------------------@@ -119,7 +119,7 @@                                ]              ] -chk :: forall a b. (SymWord a, SymWord b, Integral a, Integral b) => Maybe (Integer, Integer) -> (SBV a -> (SBV b, (SBool, SBool))) -> Predicate+chk :: forall a b. (SymVal a, SymVal b, Integral a, Integral b) => Maybe (Integer, Integer) -> (SBV a -> (SBV b, (SBool, SBool))) -> Predicate chk mb cvt = do (x :: SBV a) <- free "x"                  let (_ :: SBV b, (uf, ov)) = cvt x@@ -128,7 +128,7 @@                     ix = sFromIntegral x                      (ufCorrect, ovCorrect) = case mb of-                                               Nothing       -> (uf .== false,            ov .== false)-                                               Just (lb, ub) -> (uf <=> ix .< literal lb, ov <=> ix .> literal ub)+                                               Nothing       -> (uf .== sFalse,            ov .== sFalse)+                                               Just (lb, ub) -> (uf .<=> ix .< literal lb, ov .<=> ix .> literal ub) -                return $ ufCorrect &&& ovCorrect+                return $ ufCorrect .&& ovCorrect
SBVTestSuite/TestSuite/Polynomials/Polynomials.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Polynomials.Polynomials--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Polynomials.Polynomials+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Polynomials.Polynomials -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Puzzles/Coins.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.Coins--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.Coins+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Puzzles.Coins -----------------------------------------------------------------------------@@ -22,5 +22,5 @@  ]  where coinsPgm = runSAT $ do cs <- mapM mkCoin [1..6]                               mapM_ constrain [c s | s <- combinations cs, length s >= 2, c <- [c1, c2, c3, c4, c5, c6]]-                              constrain $ bAnd $ zipWith (.>=) cs (tail cs)+                              constrain $ sAnd $ zipWith (.>=) cs (tail cs)                               output $ sum cs .== 115
SBVTestSuite/TestSuite/Puzzles/Counts.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.Counts--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.Counts+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Puzzles.Counts -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Puzzles/DogCatMouse.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.DogCatMouse--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.DogCatMouse+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Puzzles.DogCatMouse -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Puzzles/Euler185.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.Euler185--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.Euler185+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Puzzles.Euler185 -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Puzzles/MagicSquare.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.MagicSquare--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.MagicSquare+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Puzzles.MagicSquare -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Puzzles/NQueens.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.NQueens--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.NQueens+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Puzzles.NQueens -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Puzzles/PowerSet.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.PowerSet--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.PowerSet+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.Puzzles.PowerSet -----------------------------------------------------------------------------@@ -21,5 +21,5 @@ pSet :: Int -> IO Bool pSet n = do cnt <- numberOfModels $ do mapM_ (\i -> sBool ("e" ++ show i)) [1..n]                                        -- Look ma! No constraints!-                                       return (true :: SBool)+                                       return sTrue             return (cnt == 2^n)
SBVTestSuite/TestSuite/Puzzles/Sudoku.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.Sudoku--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.Sudoku+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Puzzles.Sudoku -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Puzzles/Temperature.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.Temperature--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.Temperature+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Examples.Puzzles.Temperature -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Puzzles/U2Bridge.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Puzzles.U2Bridge--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Puzzles.U2Bridge+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Puzzles.U2Bridge -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/BadOption.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.BadOption--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.BadOption+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing that a bad option setting is caught properly. -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/BasicQuery.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.BasicQuery--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.BasicQuery+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- A hodgepodge of query commands -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/Enums.hs view
@@ -1,19 +1,19 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Enums--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Enums+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Uninterpreted.AUF ----------------------------------------------------------------------------- -{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE DeriveAnyClass      #-}+{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}  module TestSuite.Queries.Enums where
SBVTestSuite/TestSuite/Queries/FreshVars.hs view
@@ -1,21 +1,21 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.FreshVars--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.FreshVars+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing fresh-vars in query mode ----------------------------------------------------------------------------- -{-# LANGUAGE TemplateHaskell     #-}-{-# LANGUAGE StandaloneDeriving  #-}-{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE DeriveAnyClass      #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE DeriveDataTypeable  #-} {-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving  #-}+{-# LANGUAGE TemplateHaskell     #-}  module TestSuite.Queries.FreshVars (tests)  where @@ -89,10 +89,10 @@                    mustBe42                               <- freshVar "mustBe42"                    mustBeX                                <- freshVar "mustBeX" -                   constrain $ readArray viSArray 96    .== mustBe42-                   constrain $ readArray viFArray false .== mustBeX+                   constrain $ readArray viSArray 96     .== mustBe42+                   constrain $ readArray viFArray sFalse .== mustBeX                    constrain $ vi1 .== 1-                   constrain $ bnot vi2+                   constrain $ sNot vi2                     vString  :: SString         <- freshVar  "vString"                    vList1   :: SList Integer   <- freshVar  "vList1"
SBVTestSuite/TestSuite/Queries/Int_ABC.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Int_ABC--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Int_ABC+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing ABC specific interactive features. -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/Int_Boolector.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Int_Boolector--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Int_Boolector+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing Boolector specific interactive features. -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/Int_CVC4.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Int_CVC4--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Int_CVC4+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing CVC4 specific interactive features -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/Int_Mathsat.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Int_Mathsat--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Int_Mathsat+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing MathSAT specific interactive features. -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/Int_Yices.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Int_Yices--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Int_Yices+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing Yices specific interactive features. -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/Int_Z3.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Int_Z3--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Int_Z3+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing Z3 specific interactive features. -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/Interpolants.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Interpolants--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Interpolants+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing a few interpolant computations. --@@ -41,8 +41,8 @@          setOption $ ProduceInterpolants True -        iConstraint "c1" $ a .== b &&& a .== c-        iConstraint "c2" $ b .== d &&& bnot (c .== d)+        iConstraint "c1" $ a .== b .&& a .== c+        iConstraint "c2" $ b .== d .&& sNot (c .== d)          query $ do _ <- checkSat                    getInterpolant ["c1"]@@ -59,8 +59,8 @@          setOption $ ProduceInterpolants True -        iConstraint "c1" $ f a .== c &&& f b .== d-        iConstraint "c2" $   a .== b &&& g c ./= g d+        iConstraint "c1" $ f a .== c .&& f b .== d+        iConstraint "c2" $   a .== b .&& g c ./= g d          query $ do _ <- checkSat                    getInterpolant ["c1"]
SBVTestSuite/TestSuite/Queries/Lists.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Lists--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Lists+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing a few lists -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Queries/Strings.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Strings--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Strings+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing a few strings -----------------------------------------------------------------------------
+ SBVTestSuite/TestSuite/Queries/Tuples.hs view
@@ -0,0 +1,65 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Queries.Tuples+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+--+-- Testing tuple queries+-----------------------------------------------------------------------------++{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}++module TestSuite.Queries.Tuples (tests)  where++import Data.SBV+import Data.SBV.Control+import Data.SBV.Tuple++import Utils.SBVTestFramework++-- Test suite+tests :: TestTree+tests =+  testGroup "Basics.QueryTuples"+    [ goldenCapturedIO "query_Tuples1" $ testQuery queryTuples1+    , goldenCapturedIO "query_Tuples2" $ testQuery queryTuples2+    ]++testQuery :: Show a => Symbolic a -> FilePath -> IO ()+testQuery t rf = do r <- runSMTWith defaultSMTCfg{verbose=True, redirectVerbose=Just rf} t+                    appendFile rf ("\nFINAL OUTPUT:\n" ++ show r ++ "\n")++queryTuples1 :: Symbolic (Integer, Char)+queryTuples1 = do+  a <- sTuple @(Integer, Char) "a"++  constrain $ a^._1 .== 1++  query $ do+    _ <- checkSat++    av <- getValue a++    if fst av == 1+       then return av+       else error $ "Didn't expect this: " ++ show av++queryTuples2 :: Symbolic (Integer, (Char, ()))+queryTuples2 = do+  a <- sTuple @(Integer, (Char, ())) "a"++  constrain $ a^._2^._1 .== literal 'c'++  query $ do+    _ <- checkSat++    av@(_, (c, _)) <- getValue a++    if c == 'c'+       then return av+       else error $ "Didn't expect this: " ++ show av++{-# ANN module ("HLint: ignore Use ." :: String) #-}
SBVTestSuite/TestSuite/Queries/Uninterpreted.hs view
@@ -1,16 +1,16 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Queries.Uninterpreted--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Queries.Uninterpreted+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testing uninterpreted value extraction ----------------------------------------------------------------------------- -{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable  #-}+{-# LANGUAGE ScopedTypeVariables #-}  module TestSuite.Queries.Uninterpreted where @@ -34,7 +34,7 @@ data L = A | B ()        deriving (Eq, Ord, Show, Read, Data) -instance SymWord L+instance SymVal L instance HasKind L instance SMTValue L
SBVTestSuite/TestSuite/QuickCheck/QC.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.QuickCheck.QC--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.QuickCheck.QC+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Quick-check based test suite for SBV -----------------------------------------------------------------------------
+ SBVTestSuite/TestSuite/Transformers/SymbolicEval.hs view
@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- Module    : TestSuite.Transformers.SymbolicEval+-- Author    : Brian Schroeder+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental+--+-- Test suite for Documentation.SBV.Examples.Transformers.SymbolicEval+-----------------------------------------------------------------------------++module TestSuite.Transformers.SymbolicEval(tests) where++import Control.Monad.Except (ExceptT, runExceptT, throwError)+import Data.Either          (isLeft)++import Data.SBV.Trans         (runSMT, sat, unliteral)+import Data.SBV.Trans.Control (query)++import Documentation.SBV.Examples.Transformers.SymbolicEval+import Utils.SBVTestFramework                               hiding (runSMT, sat)++isSat :: SatResult -> Bool+isSat (SatResult Unsatisfiable{}) = False+isSat (SatResult Satisfiable{})   = True+isSat _                           = error "isSat: Unexpected result!"++-- Test suite+tests :: TestTree+tests = testGroup "Transformers.SymbolicEval"+    [ testCase "alloc success" $ assert $+          (== Right True) . fmap isSat <$>+            runExceptT (sat $ (.< 5) <$> runAlloc (alloc "x") :: ExceptT String IO SatResult)++    , testCase "alloc failure" $ assert $+          (== Left "tried to allocate unnamed value") <$>+              runExceptT (runSMT (runAlloc (alloc "")))++    , testCase "query success" $ assert $+          (== Right (Just True)) . fmap unliteral <$>+              runExceptT (runSMT (query (runQ (pure $ (5 :: SInt8) .< 6))))++    , testCase "query failure" $ assert $+          isLeft <$>+              runExceptT (runSMT (query (runQ $ throwError "oops")))++    , testCase "combined success" $ assert $+          (== Right (Counterexample 0 9)) <$>+              check (Program  $ Var "x" `Plus` Lit 1 `Plus` Var "y")+                    (Property $ Var "result" `LessThan` Lit 10)++    , testCase "combined failure" $ assert $+          (== Left "unknown variable") <$>+              check (Program  $ Var "notAValidVar")+                    (Property $ Var "result" `LessThan` Lit 10)+    ]
SBVTestSuite/TestSuite/Uninterpreted/AUF.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Uninterpreted.AUF--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Uninterpreted.AUF+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for Documentation.SBV.Examples.Uninterpreted.AUF -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Uninterpreted/Axioms.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Uninterpreted.Axioms--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Uninterpreted.Axioms+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for basic axioms and uninterpreted functions -----------------------------------------------------------------------------@@ -23,7 +23,7 @@     [ testCase "unint-axioms" (assertIsThm p0) ]  -- Example provided by Thomas DuBuisson:-newtype Bitstring = Bitstring () deriving (Eq, Ord, Show, Read, Data, SymWord, HasKind)+newtype Bitstring = Bitstring () deriving (Eq, Ord, Show, Read, Data, SymVal, HasKind) type SBitstring = SBV Bitstring  a :: SBitstring -> SBool
SBVTestSuite/TestSuite/Uninterpreted/Function.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Uninterpreted.Function--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Uninterpreted.Function+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Testsuite for Documentation.SBV.Examples.Uninterpreted.Function -----------------------------------------------------------------------------
SBVTestSuite/TestSuite/Uninterpreted/Sort.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  TestSuite.Uninterpreted.Sort--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Uninterpreted.Sort+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Test suite for uninterpreted sorts -----------------------------------------------------------------------------@@ -25,10 +25,10 @@     ]  data L = Nil | Cons Int L deriving (Eq, Ord, Data, Read, Show)-instance SymWord L+instance SymVal L instance HasKind L instance SatModel L where-  parseCWs = undefined -- make GHC shut up about the missing method, we won't actually call it+  parseCVs = undefined -- make GHC shut up about the missing method, we won't actually call it  type UList = SBV L @@ -41,5 +41,5 @@     constrain $ len l0 .== 0     constrain $ len l1 .== 1     x :: SInteger <- symbolic "x"-    constrain $ x .== 0 ||| x.== 1-    return $ l .== l0 ||| l .== l1+    constrain $ x .== 0 .|| x.== 1+    return $ l .== l0 .|| l .== l1
SBVTestSuite/TestSuite/Uninterpreted/Uninterpreted.hs view
@@ -1,12 +1,11 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Examples.TestSuite.Uninterpreted--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : TestSuite.Uninterpreted.Uninterpreted+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental ----- Test suite for Examples.Uninterpreted.Uninterpreted -----------------------------------------------------------------------------  module TestSuite.Uninterpreted.Uninterpreted(tests) where@@ -29,10 +28,10 @@ g = uninterpret "g"  p0 :: SInt8 -> SInt8 -> SBool-p0 x y   = x .== y ==> f x .== f y      -- OK+p0 x y   = x .== y .=> f x .== f y      -- OK  p1 :: SInt8 -> SWord16 -> SWord16 -> SBool-p1 x y z = y .== z ==> g x y .== g x z  -- OK+p1 x y z = y .== z .=> g x y .== g x z  -- OK  p2 :: SInt8 -> SWord16 -> SWord16 -> SBool-p2 x y z = y .== z ==> g x y .== f x    -- Not true+p2 x y z = y .== z .=> g x y .== f x    -- Not true
SBVTestSuite/Utils/SBVTestFramework.hs view
@@ -1,14 +1,15 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Utils.SBVTestFramework--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Utils.SBVTestFramework+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Various goodies for testing SBV ----------------------------------------------------------------------------- +{-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -148,7 +149,7 @@                 diff    = concatMap pick $ zip3 [1..diffLen] (lxs ++ repeat "") (lys ++ repeat "")                  pick (i, expected, got)-                  | expected == got+                  | filter (/= '\r') expected == filter (/= '\r') got                   = []                   | True                   = [ "== Line " ++ show i ++ " =="@@ -186,21 +187,21 @@ assertIsntSat p = assert (fmap not (isSatisfiable p))  -- | Quick-check a unary function, creating one version for constant folding, and another for solver-qc1 :: (SymWord a, SymWord b, Show a, QC.Arbitrary a, SMTValue b) => String -> (a -> b) -> (SBV a -> SBV b) -> [TestTree]+qc1 :: (SymVal a, SymVal b, Show a, QC.Arbitrary a, SMTValue b) => String -> (a -> b) -> (SBV a -> SBV b) -> [TestTree] qc1 nm opC opS = [cf, sm]    where cf = QC.testProperty (nm ++ ".constantFold") $ do                         i <- free "i" -                        let extract n = fromMaybe (error $ "qc1." ++ nm ++ ": Cannot extract value for: " ++ n) . unliteral+                        let grab n = fromMaybe (error $ "qc1." ++ nm ++ ": Cannot extract value for: " ++ n) . unliteral -                            v = extract "i" i+                            v = grab "i" i                              expected = literal $ opC v                             result   = opS i                          case (unliteral expected, unliteral result) of                            (Just _, Just _) -> return $ expected .== result-                           _                -> return false+                           _                -> return sFalse           sm = QC.testProperty (nm ++ ".symbolic") $ QC.monadicIO $ do                         ((i, expected), result) <- QC.run $ runSMT $ do v   <- liftIO $ QC.generate QC.arbitrary@@ -219,15 +220,15 @@                                                                                      Sat   -> do r <- getValue res                                                                                                  return (pre, Right r) -                        let getCW vnm (SBV (SVal _ (Left c))) = (vnm, c)-                            getCW vnm (SBV (SVal k _       )) = error $ "qc2.getCW: Impossible happened, non-CW value while extracting: " ++ show (vnm, k)+                        let getCV vnm (SBV (SVal _ (Left c))) = (vnm, c)+                            getCV vnm (SBV (SVal k _       )) = error $ "qc2.getCV: Impossible happened, non-CV value while extracting: " ++ show (vnm, k) -                            vals = [ getCW "i"        (literal i)-                                   , getCW "Expected" (literal expected)+                            vals = [ getCV "i"        (literal i)+                                   , getCV "Expected" (literal expected)                                    ]                              model = case result of-                                      Right v -> showModel defaultSMTCfg (SMTModel [] (vals ++ [getCW "Result" (literal v)]))+                                      Right v -> showModel defaultSMTCfg (SMTModel [] (vals ++ [getCV "Result" (literal v)]))                                       Left  e -> showModel defaultSMTCfg (SMTModel [] vals) ++ "\n" ++ e                          QC.monitor (QC.counterexample model)@@ -238,23 +239,23 @@   -- | Quick-check a binary function, creating one version for constant folding, and another for solver-qc2 :: (SymWord a, SymWord b, SymWord c, Show a, Show b, QC.Arbitrary a, QC.Arbitrary b, SMTValue c) => String -> (a -> b -> c) -> (SBV a -> SBV b -> SBV c) -> [TestTree]+qc2 :: (SymVal a, SymVal b, SymVal c, Show a, Show b, QC.Arbitrary a, QC.Arbitrary b, SMTValue c) => String -> (a -> b -> c) -> (SBV a -> SBV b -> SBV c) -> [TestTree] qc2 nm opC opS = [cf, sm]    where cf = QC.testProperty (nm ++ ".constantFold") $ do                         i1 <- free "i1"                         i2 <- free "i2" -                        let extract n = fromMaybe (error $ "qc2." ++ nm ++ ": Cannot extract value for: " ++ n) . unliteral+                        let grab n = fromMaybe (error $ "qc2." ++ nm ++ ": Cannot extract value for: " ++ n) . unliteral -                            v1 = extract "i1" i1-                            v2 = extract "i2" i2+                            v1 = grab "i1" i1+                            v2 = grab "i2" i2                              expected = literal $ opC v1 v2                             result   = opS i1 i2                          case (unliteral expected, unliteral result) of                            (Just _, Just _) -> return $ expected .== result-                           _                -> return false+                           _                -> return sFalse           sm = QC.testProperty (nm ++ ".symbolic") $ QC.monadicIO $ do                         ((i1, i2, expected), result) <- QC.run $ runSMT $ do v1  <- liftIO $ QC.generate QC.arbitrary@@ -276,16 +277,16 @@                                                                                           Sat   -> do r <- getValue res                                                                                                       return (pre, Right r) -                        let getCW vnm (SBV (SVal _ (Left c))) = (vnm, c)-                            getCW vnm (SBV (SVal k _       )) = error $ "qc2.getCW: Impossible happened, non-CW value while extracting: " ++ show (vnm, k)+                        let getCV vnm (SBV (SVal _ (Left c))) = (vnm, c)+                            getCV vnm (SBV (SVal k _       )) = error $ "qc2.getCV: Impossible happened, non-CV value while extracting: " ++ show (vnm, k) -                            vals = [ getCW "i1"       (literal i1)-                                   , getCW "i2"       (literal i2)-                                   , getCW "Expected" (literal expected)+                            vals = [ getCV "i1"       (literal i1)+                                   , getCV "i2"       (literal i2)+                                   , getCV "Expected" (literal expected)                                    ]                              model = case result of-                                      Right v -> showModel defaultSMTCfg (SMTModel [] (vals ++ [getCW "Result" (literal v)]))+                                      Right v -> showModel defaultSMTCfg (SMTModel [] (vals ++ [getCV "Result" (literal v)]))                                       Left  e -> showModel defaultSMTCfg (SMTModel [] vals) ++ "\n" ++ e                          QC.monitor (QC.counterexample model)
Setup.hs view
@@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- |--- Module      :  Main--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental+-- Module    : Setup+-- Author    : Levent Erkok+-- License   : BSD3+-- Maintainer: erkokl@gmail.com+-- Stability : experimental -- -- Setup module for the sbv library -----------------------------------------------------------------------------
sbv.cabal view
@@ -1,5 +1,5 @@ Name:          sbv-Version:       7.13+Version:       8.0 Category:      Formal Methods, Theorem Provers, Bit vectors, Symbolic Computation, Math, SMT Synopsis:      SMT Based Verification: Symbolic Haskell theorem prover using SMT solving. Description:   Express properties about Haskell programs and automatically prove them using SMT@@ -7,7 +7,7 @@                .                For details, please see: <http://leventerkok.github.com/sbv/> -Copyright:     Levent Erkok, 2010-2018+Copyright:     Levent Erkok, 2010-2019 License:       BSD3 License-file:  LICENSE Stability:     Experimental@@ -26,49 +26,70 @@  Library   default-language: Haskell2010-  ghc-options     : -Wall+  ghc-options     : -Wall -O2   other-extensions: BangPatterns+                    CPP+                    ConstraintKinds+                    DataKinds                     DefaultSignatures                     DeriveAnyClass                     DeriveDataTypeable+                    DeriveFunctor+                    DeriveGeneric                     FlexibleContexts                     FlexibleInstances                     FunctionalDependencies+                    GADTs                     GeneralizedNewtypeDeriving+                    ImplicitParams+                    InstanceSigs+                    KindSignatures+                    LambdaCase                     MultiParamTypeClasses-                    OverlappingInstances-                    ParallelListComp+                    NamedFieldPuns+                    OverloadedLists+                    OverloadedStrings                     PatternGuards+                    QuasiQuotes                     Rank2Types                     RankNTypes                     ScopedTypeVariables                     StandaloneDeriving                     TemplateHaskell                     TupleSections+                    TypeApplications+                    TypeFamilies                     TypeOperators                     TypeSynonymInstances+                    UndecidableInstances+                    ViewPatterns   Build-Depends   : base >= 4.9 && < 5                   , crackNum >= 2.3                   , ghc, QuickCheck, template-haskell                   , array, async, containers, deepseq, directory, filepath, time-                  , pretty, process, mtl, random, syb+                  , pretty, process, mtl, random, syb, transformers                   , generic-deriving   Exposed-modules : Data.SBV                   , Data.SBV.Control                   , Data.SBV.Dynamic                   , Data.SBV.Internals                   , Data.SBV.List-                  , Data.SBV.List.Bounded                   , Data.SBV.String+                  , Data.SBV.Tuple                   , Data.SBV.Char                   , Data.SBV.RegExp+                  , Data.SBV.Tools.BMC+                  , Data.SBV.Tools.BoundedList+                  , Data.SBV.Tools.Induction+                  , Data.SBV.Tools.BoundedFix                   , Data.SBV.Tools.CodeGen                   , Data.SBV.Tools.GenTest                   , Data.SBV.Tools.Overflow                   , Data.SBV.Tools.Polynomial                   , Data.SBV.Tools.Range-                  , Data.SBV.Tools.BoundedFix                   , Data.SBV.Tools.STree+                  , Data.SBV.Trans+                  , Data.SBV.Trans.Control                   , Documentation.SBV.Examples.BitPrecise.BitTricks                   , Documentation.SBV.Examples.BitPrecise.BrokenSearch                   , Documentation.SBV.Examples.BitPrecise.Legato@@ -95,11 +116,16 @@                   , Documentation.SBV.Examples.Misc.NoDiv0                   , Documentation.SBV.Examples.Misc.Polynomials                   , Documentation.SBV.Examples.Misc.SoftConstrain+                  , Documentation.SBV.Examples.Misc.Tuple                   , Documentation.SBV.Examples.Misc.Word4                   , Documentation.SBV.Examples.Optimization.LinearOpt                   , Documentation.SBV.Examples.Optimization.Production                   , Documentation.SBV.Examples.Optimization.VM                   , Documentation.SBV.Examples.Optimization.ExtField+                  , Documentation.SBV.Examples.ProofTools.BMC+                  , Documentation.SBV.Examples.ProofTools.Fibonacci+                  , Documentation.SBV.Examples.ProofTools.Strengthen+                  , Documentation.SBV.Examples.ProofTools.Sum                   , Documentation.SBV.Examples.Puzzles.Birthday                   , Documentation.SBV.Examples.Puzzles.Coins                   , Documentation.SBV.Examples.Puzzles.Counts@@ -123,13 +149,16 @@                   , Documentation.SBV.Examples.Queries.Interpolants                   , Documentation.SBV.Examples.Strings.RegexCrossword                   , Documentation.SBV.Examples.Strings.SQLInjection+                  , Documentation.SBV.Examples.Transformers.SymbolicEval                   , Documentation.SBV.Examples.Uninterpreted.AUF                   , Documentation.SBV.Examples.Uninterpreted.Deduce                   , Documentation.SBV.Examples.Uninterpreted.Function                   , Documentation.SBV.Examples.Uninterpreted.Shannon                   , Documentation.SBV.Examples.Uninterpreted.Sort                   , Documentation.SBV.Examples.Uninterpreted.UISortAllSat-  Other-modules   : Data.SBV.Core.AlgReals+  Other-modules   : Data.SBV.Client+                  , Data.SBV.Client.BaseIO+                  , Data.SBV.Core.AlgReals                   , Data.SBV.Core.Concrete                   , Data.SBV.Core.Data                   , Data.SBV.Core.Kind@@ -138,6 +167,7 @@                   , Data.SBV.Core.Floating                   , Data.SBV.Core.Splittable                   , Data.SBV.Core.Symbolic+                  , Data.SBV.Control.BaseIO                   , Data.SBV.Control.Query                   , Data.SBV.Control.Types                   , Data.SBV.Control.Utils@@ -155,7 +185,7 @@                   , Data.SBV.Provers.Z3                   , Data.SBV.Provers.MathSAT                   , Data.SBV.Provers.ABC-                  , Data.SBV.Utils.Boolean+                  , Data.SBV.Utils.ExtractIO                   , Data.SBV.Utils.Numeric                   , Data.SBV.Utils.TDiff                   , Data.SBV.Utils.Lib@@ -165,11 +195,21 @@ Test-Suite SBVTest   type            : exitcode-stdio-1.0   default-language: Haskell2010-  ghc-options     : -Wall -with-rtsopts=-K64m-  other-extensions: DeriveAnyClass-                  , DeriveDataTypeable-                  , Rank2Types-                  , ScopedTypeVariables+  ghc-options     : -Wall -with-rtsopts=-K64m -O2+  other-extensions: DataKinds+                    DeriveAnyClass+                    DeriveDataTypeable+                    FlexibleContexts+                    GeneralizedNewtypeDeriving+                    OverloadedLists+                    OverloadedStrings+                    Rank2Types+                    RankNTypes+                    ScopedTypeVariables+                    StandaloneDeriving+                    TemplateHaskell+                    TupleSections+                    TypeApplications   Build-depends : base >= 4.9, filepath, syb, crackNum >= 2.3                 , sbv, directory, random, mtl, containers                 , template-haskell, bytestring, tasty, tasty-golden, tasty-hunit, tasty-quickcheck, QuickCheck@@ -200,6 +240,7 @@                   , TestSuite.Basics.String                   , TestSuite.Basics.List                   , TestSuite.Basics.TOut+                  , TestSuite.Basics.Tuple                   , TestSuite.BitPrecise.BitTricks                   , TestSuite.BitPrecise.Legato                   , TestSuite.BitPrecise.MergeSort@@ -254,8 +295,10 @@                   , TestSuite.Queries.Interpolants                   , TestSuite.Queries.Lists                   , TestSuite.Queries.Strings+                  , TestSuite.Queries.Tuples                   , TestSuite.Queries.Uninterpreted                   , TestSuite.QuickCheck.QC+                  , TestSuite.Transformers.SymbolicEval                   , TestSuite.Uninterpreted.AUF                   , TestSuite.Uninterpreted.Axioms                   , TestSuite.Uninterpreted.Function@@ -266,6 +309,21 @@     Build-Depends:    base, directory, filepath, random                     , doctest, Glob, bytestring, tasty, tasty-golden, tasty-hunit, tasty-quickcheck, mtl, QuickCheck, random                     , sbv+    ghc-options     : -Wall -O2+    other-extensions: DataKinds+                      DeriveAnyClass+                      DeriveDataTypeable+                      FlexibleContexts+                      GeneralizedNewtypeDeriving+                      OverloadedLists+                      OverloadedStrings+                      Rank2Types+                      RankNTypes+                      ScopedTypeVariables+                      StandaloneDeriving+                      TemplateHaskell+                      TupleSections+                      TypeApplications     default-language: Haskell2010     Hs-Source-Dirs  : SBVTestSuite     main-is:          SBVDocTest.hs@@ -276,6 +334,21 @@     build-depends:    base, directory, filepath, random                     , hlint, bytestring, tasty, tasty-golden, tasty-hunit, tasty-quickcheck, mtl, QuickCheck                     , sbv+    ghc-options     : -Wall -O2+    other-extensions: DataKinds+                      DeriveAnyClass+                      DeriveDataTypeable+                      FlexibleContexts+                      GeneralizedNewtypeDeriving+                      OverloadedLists+                      OverloadedStrings+                      Rank2Types+                      RankNTypes+                      ScopedTypeVariables+                      StandaloneDeriving+                      TemplateHaskell+                      TupleSections+                      TypeApplications     default-language: Haskell2010     hs-source-dirs:   SBVTestSuite     Other-modules   : Utils.SBVTestFramework