packages feed

sbv 0.9.23 → 0.9.24

raw patch · 165 files changed

+4311/−2411 lines, 165 filesdep ~HUnitdep ~basedep ~randomsetup-changed

Dependency ranges changed: HUnit, base, random

Files

Data/SBV.hs view
@@ -144,7 +144,7 @@   -- ** Adding axioms   , addAxiom -  -- * Proving properties+  -- * Properties, proofs, and satisfiability   -- $proveIntro    -- ** Predicates@@ -155,10 +155,16 @@   , sat, satWith, isSatisfiable, isSatisfiableWithin   -- ** Finding all satisfying assignments   , allSat, allSatWith, numberOfModels+  -- ** Adding constraints+  -- $constrainIntro+  , constrain, pConstrain+  -- ** Checking constraint vacuity+  , isVacuous, isVacuousWith    -- * Optimization   -- $optimizeIntro   , minimize, maximize, optimize+  , minimizeWith, maximizeWith, optimizeWith    -- * Model extraction   -- $modelExtraction@@ -169,10 +175,10 @@    -- ** Programmable model extraction   -- $programmableExtraction-  , SatModel(..), getModel, displayModels+  , SatModel(..), Modelable(..), displayModels    -- * SMT Interface: Configurations and solvers-  , SMTConfig(..), SMTSolver(..), yices, z3+  , SMTConfig(..), OptimizeOpts(..), SMTSolver(..), yices, z3, defaultSMTCfg    -- * Symbolic computations   , Symbolic, output, SymWord(..)@@ -180,6 +186,9 @@   -- * Getting SMT-Lib output (for offline analysis)   , compileToSMTLib +  -- * Test case generation+  , genTest, CW(..), Size(..)+   -- * Code generation from symbolic programs   -- $cCodeGeneration   , SBVCodeGen@@ -211,6 +220,7 @@   ) where  import Data.SBV.BitVectors.Data+import Data.SBV.BitVectors.GenTest import Data.SBV.BitVectors.Model import Data.SBV.BitVectors.Optimize import Data.SBV.BitVectors.PrettyNum@@ -266,7 +276,7 @@ {- $optimizeIntro Symbolic optimization. A call of the form: -    @minimize cost n valid@+    @minimize Quantified cost n valid@  returns @Just xs@, such that: @@ -282,9 +292,16 @@  The function 'optimize' allows the user to give a custom comparison function. -Logically, the SBV optimization engine satisfies the following predicate:+The 'OptimizeOpts' argument controls how the optimization is done. If 'Quantified' is used, then the SBV optimization engine satisfies the following predicate:     @exists xs. forall ys. valid xs && (valid ys ``implies`` (cost xs ``cmp`` cost ys))@++Note that this may cause efficiency problems as it involves alternating quantifiers.+If 'OptimizeOpts' is set to 'Iterative' 'True', then SBV will programmatically+search for an optimal solution, by repeatedly calling the solver appropriately. (The boolean argument controls whether progress reports are given. Use+'False' for quiet operation.) Note that the quantified and iterative versions are two different optimization approaches and may not necessarily yield the same+results. In particular, the quantified version can find solutions where there is no global optimum value, while the iterative version would simply loop forever+in such cases. On the other hand, the iterative version might be more suitable if the quantified version of the problem is too hard to deal with by the SMT solver. -}  {- $modelExtraction@@ -338,3 +355,83 @@ Usual arithmetic ('+', '-', '*', 'bvQuotRem') and logical operations ('.<', '.<=', '.>', '.>=', '.==', './=') operations are supported for 'SInteger' fully, both in programming and verification modes. -}++{- $constrainIntro+A constraint is a means for restricting the input domain of a formula. Here's a simple+example:++@+   do x <- 'exists' \"x\"+      y <- 'exists' \"y\"+      'constrain' $ x .> y+      'constrain' $ x + y .>= 12+      'constrain' $ y .>= 3+      ...+@++The first constraint requires @x@ to be larger than @y@. The scond one says that+sum of @x@ and @y@ must be at least @12@, and the final one says that @y@ to be at least @3@.+Constraints provide an easy way to assert additional properties on the input domain, right at the point of+the introduction of variables.++Note that the proper reading of a constraint+depends on the context:++    * In a 'sat' (or 'allSat') call: The constraint added is asserted+    conjunctively. That is, the resulting satisfying model (if any) will+    always satisfy all the constraints given.++  * In a 'prove' call: In this case, the constraint acts as an implication.+    The property is proved under the assumption that the constraint+    holds. In other words, the constraint says that we only care about+    the input space that satisfies the constraint.++  * In a 'quickCheck' call: The constraint acts as a filter for 'quickCheck';+    if the constraint does not hold, then the input value is considered to be irrelevant+    and is skipped. Note that this is similar to 'prove', but is stronger: We do not+    accept a test case to be valid just because the constraints fail on them, although+    semantically the implication does hold. We simply skip that test case as a /bad/+    test vector.++  * In a 'genTest' call: Similar to 'quickCheck' and 'prove': If a constraint+    does not hold, the input value is ignored and is not included in the test+    set.++A good use case (in fact the motivating use case) for 'constrain' is attaching a+constraint to a 'forall' or 'exists' variable at the time of its creation.+Also, the conjunctive semantics for 'sat' and the implicative+semantics for 'prove' simplify programming by choosing the correct interpretation+automatically. However, one should be aware of the semantic difference. For instance, in+the presence of constraints, formulas that are /provable/ are not necessarily+/satisfiable/. To wit, consider:++ @+    do x <- 'exists' \"x\"+       'constrain' $ x .< x+       return $ x .< (x :: 'SWord8')+ @++This predicate is unsatisfiable since no element of 'SWord8' is less than itself. But+it's (vacuously) true, since it excludes the entire domain of values, thus making the proof+trivial. Hence, this predicate is provable, but is not satisfiable. To make sure the given+constraints are not vacuous, the functions 'isVacuous' (and 'isVacuousWith') can be used.++Also note that this semantics imply that test case generation ('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'@.)++A probabilistic constraint (see 'pConstrain') attaches a probability threshold for the+constraint to be considered. For instance:++  @'pConstrain' 0.8 c@++will add the constraint @c@ 80% of the time. This variant is useful for 'genTest' and 'quickCheck' functions,+where we want to filter the test cases according to some probability distribution, to make sure that the test-vectors+are drawn from interesting subsets of the input space.++Note that while 'constrain' can be used freely, 'pConstrain' is only allowed in the contexts of+'genTest' or 'quickCheck'. Calls to 'pConstrain' in a prove/sat call will be rejected as it makes no sense.+Also, 'constrain' and 'pConstrain' calls during code-generation will also be rejected, for similar reasons.+-}++{-# ANN module "HLint: ignore Use import/export shortcut" #-}
Data/SBV/BitVectors/Data.hs view
@@ -22,7 +22,7 @@  ( SBool, SWord8, SWord16, SWord32, SWord64  , SInt8, SInt16, SInt32, SInt64, SInteger  , SymWord(..)- , CW, cwVal, cwSameType, cwIsBit, cwToBool+ , CW(..), cwSameType, cwIsBit, cwToBool, constrain, pConstrain  , mkConstCW ,liftCW2, mapCW, mapCW2  , SW(..), trueSW, falseSW, trueCW, falseCW  , SBV(..), NodeId(..), mkSymSBV@@ -30,7 +30,7 @@  , sbvToSW, sbvToSymSW  , SBVExpr(..), newExpr  , cache, uncache, uncacheAI, HasSignAndSize(..)- , Op(..), NamedSymVar, UnintKind(..), getTableIndex, Pgm, Symbolic, runSymbolic, runSymbolic', State, inCodeGenMode, Size(..), Outputtable(..), Result(..)+ , Op(..), NamedSymVar, UnintKind(..), getTableIndex, Pgm, Symbolic, runSymbolic, runSymbolic', State, inProofMode, SBVRunMode(..), Size(..), Outputtable(..), Result(..), getTraceInfo, getConstraints  , SBVType(..), newUninterpreted, unintFnUIKind, addAxiom  , Quantifier(..), needsExistentials  , SMTLibPgm(..), SMTLibVersion(..)@@ -45,7 +45,7 @@ import Data.Word                       (Word8, Word16, Word32, Word64) import Data.IORef                      (IORef, newIORef, modifyIORef, readIORef, writeIORef) import Data.List                       (intercalate, sortBy)-import Data.Maybe                      (isJust, fromJust)+import Data.Maybe                      (isJust, fromJust, fromMaybe)  import qualified Data.IntMap   as IMap (IntMap, empty, size, toAscList, lookup, insert, insertWith) import qualified Data.Map      as Map  (Map, empty, toList, size, insert, lookup)@@ -53,14 +53,17 @@ import qualified Data.Sequence as S    (Seq, empty, (|>))  import System.Mem.StableName-import Test.QuickCheck                 (Testable(..))+import System.Random  import Data.SBV.Utils.Lib  -- | 'CW' represents a concrete word of a fixed size: -- Endianness is mostly irrelevant (see the 'FromBits' class).--- For signed words, the most significant digit is considered to be the sign-data CW = CW { cwSigned :: !Bool, cwSize :: !Size, cwVal :: !Integer }+-- For signed words, the most significant digit is considered to be the sign.+data CW = CW { cwSigned :: !Bool    -- ^ Is the word signed?+             , cwSize   :: !Size    -- ^ Size of the word (unbounded if Nothing)+             , cwVal    :: !Integer -- ^ The underlying value, represented as a Haskell 'Integer'+             }         deriving (Eq, Ord)  cwSameType :: CW -> CW -> Bool@@ -135,27 +138,31 @@ data SBVExpr = SBVApp !Op ![SW]              deriving (Eq, Ord) ++-- minimal complete definition: sizeOf, hasSign class HasSignAndSize a where   sizeOf     :: a -> Size-  intSizeOf  :: a -> Int   hasSign    :: a -> Bool+  intSizeOf  :: a -> Int   isInfPrec  :: a -> Bool   showType   :: a -> String   showType a     | isInfPrec a                         = "SInteger"     | not (hasSign a) && intSizeOf a == 1 = "SBool"     | True                                = (if hasSign a then "SInt" else "SWord") ++ show (intSizeOf a)+  isInfPrec = maybe True (const False) . unSize . sizeOf+  intSizeOf = fromMaybe (error "SBV.HasSignAndSize.bitSize((S)Integer)") . unSize . sizeOf -instance HasSignAndSize Bool    where {sizeOf _ = Size (Just 1) ; intSizeOf _ =  1; isInfPrec _ = False; hasSign _ = False}-instance HasSignAndSize Int8    where {sizeOf _ = Size (Just 8) ; intSizeOf _ =  8; isInfPrec _ = False; hasSign _ = True }-instance HasSignAndSize Word8   where {sizeOf _ = Size (Just 8) ; intSizeOf _ =  8; isInfPrec _ = False; hasSign _ = False}-instance HasSignAndSize Int16   where {sizeOf _ = Size (Just 16); intSizeOf _ = 16; isInfPrec _ = False; hasSign _ = True }-instance HasSignAndSize Word16  where {sizeOf _ = Size (Just 16); intSizeOf _ = 16; isInfPrec _ = False; hasSign _ = False}-instance HasSignAndSize Int32   where {sizeOf _ = Size (Just 32); intSizeOf _ = 32; isInfPrec _ = False; hasSign _ = True }-instance HasSignAndSize Word32  where {sizeOf _ = Size (Just 32); intSizeOf _ = 32; isInfPrec _ = False; hasSign _ = False}-instance HasSignAndSize Int64   where {sizeOf _ = Size (Just 64); intSizeOf _ = 64; isInfPrec _ = False; hasSign _ = True }-instance HasSignAndSize Word64  where {sizeOf _ = Size (Just 64); intSizeOf _ = 64; isInfPrec _ = False; hasSign _ = False}-instance HasSignAndSize Integer where {sizeOf _ = Size Nothing; intSizeOf _ = error "attempting to compute size of Integer"; isInfPrec _ = True; hasSign _ = True}+instance HasSignAndSize Bool    where {sizeOf _ = Size (Just 1) ; hasSign _ = False}+instance HasSignAndSize Int8    where {sizeOf _ = Size (Just 8) ; hasSign _ = True }+instance HasSignAndSize Word8   where {sizeOf _ = Size (Just 8) ; hasSign _ = False}+instance HasSignAndSize Int16   where {sizeOf _ = Size (Just 16); hasSign _ = True }+instance HasSignAndSize Word16  where {sizeOf _ = Size (Just 16); hasSign _ = False}+instance HasSignAndSize Int32   where {sizeOf _ = Size (Just 32); hasSign _ = True }+instance HasSignAndSize Word32  where {sizeOf _ = Size (Just 32); hasSign _ = False}+instance HasSignAndSize Int64   where {sizeOf _ = Size (Just 64); hasSign _ = True }+instance HasSignAndSize Word64  where {sizeOf _ = Size (Just 64); hasSign _ = False}+instance HasSignAndSize Integer where {sizeOf _ = Size Nothing;   hasSign _ = True}  liftCW :: (Integer -> b) -> CW -> b liftCW f x = f (cwVal x)@@ -251,6 +258,7 @@  -- | Result of running a symbolic computation data Result = Result Bool                                         -- contains unbounded integers+                     [(String, CW)]                               -- quick-check counter-example information (if any)                      [(String, [String])]                         -- uninterpeted code segments                      [(Quantifier, NamedSymVar)]                  -- inputs (possibly existential)                      [(SW, CW)]                                   -- constants@@ -259,13 +267,20 @@                      [(String, SBVType)]                          -- uninterpreted constants                      [(String, [String])]                         -- axioms                      Pgm                                          -- assignments+                     [SW]                                         -- additional constraints (boolean)                      [SW]                                         -- outputs +getConstraints :: Result -> [SW]+getConstraints (Result _ _ _ _ _ _ _ _ _ _ cstrs _) = cstrs++getTraceInfo :: Result -> [(String, CW)]+getTraceInfo (Result _ tvals _ _ _ _ _ _ _ _ _ _) = tvals+ instance Show Result where-  show (Result _ _ _ cs _ _ [] [] _ [r])+  show (Result _ _ _ _ cs _ _ [] [] _ [] [r])     | Just c <- r `lookup` cs     = show c-  show (Result _ cgs is cs ts as uis axs xs os)  = intercalate "\n" $+  show (Result _ _ cgs is cs ts as uis axs xs cstrs os)  = intercalate "\n" $                    ["INPUTS"]                 ++ map shn is                 ++ ["CONSTANTS"]@@ -282,6 +297,8 @@                 ++ map shax axs                 ++ ["DEFINE"]                 ++ map (\(s, e) -> "  " ++ shs s ++ " = " ++ show e) (F.toList xs)+                ++ ["CONSTRAINTS"]+                ++ map (("  " ++) . show) cstrs                 ++ ["OUTPUTS"]                 ++ map (("  " ++) . show) os     where shs sw = show sw ++ " :: " ++ showType sw@@ -339,10 +356,17 @@         external (ArrayMutate{}) = False         external (ArrayMerge{})  = False -data State  = State { inCodeGenMode :: Bool+-- | Different means of running a symbolic piece of code+data SBVRunMode = Proof Bool  -- ^ Symbolic simulation mode, for proof purposes. Bool is True if it's a sat instance+                | CodeGen     -- ^ Code generation mode+                | Concrete    -- ^ Concrete simulation mode++data State  = State { runMode       :: SBVRunMode+                    , rCInfo        :: IORef [(String, CW)]                     , rctr          :: IORef Int                     , rInfPrec      :: IORef Bool                     , rinps         :: IORef [(Quantifier, NamedSymVar)]+                    , rConstraints  :: IORef [SW]                     , routs         :: IORef [SW]                     , rtblMap       :: IORef TableMap                     , spgm          :: IORef Pgm@@ -356,6 +380,12 @@                     , rAICache      :: IORef (Cache Int)                     } +inProofMode :: State -> Bool+inProofMode s = case runMode s of+                  Proof{}  -> True+                  CodeGen  -> False+                  Concrete -> False+ -- | The "Symbolic" value. Either a constant (@Left@) or a symbolic -- value (@Right Cached@). Note that caching is essential for making -- sure sharing is preserved. The parameter 'a' is phantom, but is@@ -406,11 +436,9 @@   SBV _ (Left a) /= SBV _ (Left b) = a /= b   a /= b = error $ "Comparing symbolic bit-vectors; Use (./=) instead. Received: " ++ show (a, b) -instance HasSignAndSize (SBV a) where-  sizeOf    (SBV (_, mbs) _) = mbs-  intSizeOf (SBV (_, mbs) _) = maybe (error "attempting to compute size of SInteger") id $ unSize mbs-  isInfPrec (SBV (_, mbs) _) = maybe True (const False) $ unSize mbs-  hasSign   (SBV (b, _) _)   = b+instance HasSignAndSize a => HasSignAndSize (SBV a) where+  sizeOf  _ = sizeOf  (undefined :: a)+  hasSign _ = hasSign (undefined :: a)  incCtr :: State -> IO Int incCtr s = do ctr <- readIORef (rctr s)@@ -487,15 +515,28 @@ newtype Symbolic a = Symbolic (ReaderT State IO a)                    deriving (Functor, Monad, MonadIO, MonadReader State) -mkSymSBV :: Quantifier -> (Bool, Size) -> Maybe String -> Symbolic (SBV a)-mkSymSBV q sgnsz mbNm = do+mkSymSBV :: forall a. (Random a, SymWord a) => Maybe Quantifier -> (Bool, Size) -> Maybe String -> Symbolic (SBV a)+mkSymSBV mbQ sgnsz mbNm = do         st <- ask-        ctr <- liftIO $ incCtr st-        let nm = maybe ('s':show ctr) id mbNm-            sw = SW sgnsz (NodeId ctr)-        when (isInfPrec sw) $ liftIO $ writeIORef (rInfPrec st) True-        liftIO $ modifyIORef (rinps st) ((q, (sw, nm)):)-        return $ SBV sgnsz $ Right $ cache (const (return sw))+        let q = case (mbQ, runMode st) of+                  (Just x,  _)           -> x   -- user given, just take it+                  (Nothing, Concrete)    -> ALL -- concrete simulation, pick universal+                  (Nothing, Proof True)  -> EX  -- sat mode, pick existential+                  (Nothing, Proof False) -> ALL -- proof mode, pick universal+                  (Nothing, CodeGen)     -> ALL -- code generation, pick universal+        case runMode st of+          Concrete | q == EX -> case mbNm of+                                  Nothing -> error $ "Cannot quick-check in the presence of existential variables, type: " ++ showType (undefined :: SBV a)+                                  Just nm -> error $ "Cannot quick-check in the presence of existential variable " ++ nm ++ " :: " ++ showType (undefined :: SBV a)+          Concrete           -> do v@(SBV _ (Left cw)) <- liftIO randomIO+                                   liftIO $ modifyIORef (rCInfo st) ((maybe "_" id mbNm, cw):)+                                   return v+          _          -> do ctr <- liftIO $ incCtr st+                           let nm = maybe ('s':show ctr) id mbNm+                               sw = SW sgnsz (NodeId ctr)+                           when (isInfPrec sw) $ liftIO $ writeIORef (rInfPrec st) True+                           liftIO $ modifyIORef (rinps st) ((q, (sw, nm)):)+                           return $ SBV sgnsz $ Right $ cache (const (return sw))  sbvToSymSW :: SBV a -> Symbolic SW sbvToSymSW sbv = do@@ -548,14 +589,16 @@         st <- ask         liftIO $ modifyIORef (raxioms st) ((nm, ax) :) --- | Run a symbolic computation and return a 'Result'-runSymbolic :: Symbolic a -> IO Result-runSymbolic c = snd `fmap` runSymbolic' False c+-- | Run a symbolic computation in Proof mode and return a 'Result'. The boolean+-- argument indicates if this is a sat instance or not.+runSymbolic :: Bool -> Symbolic a -> IO Result+runSymbolic b c = snd `fmap` runSymbolic' (Proof b) c  -- | Run a symbolic computation, and return a extra value paired up with the 'Result'-runSymbolic' :: Bool -> Symbolic a -> IO (a, Result)-runSymbolic' cgMode (Symbolic c) = do+runSymbolic' :: SBVRunMode -> Symbolic a -> IO (a, Result)+runSymbolic' currentRunMode (Symbolic c) = do    ctr     <- newIORef (-2) -- start from -2; False and True will always occupy the first two elements+   cInfo   <- newIORef []    pgm     <- newIORef S.empty    emap    <- newIORef Map.empty    cmap    <- newIORef Map.empty@@ -569,28 +612,31 @@    swCache <- newIORef IMap.empty    aiCache <- newIORef IMap.empty    infPrec <- newIORef False-   let st = State { inCodeGenMode = cgMode-                  , rctr          = ctr-                  , rInfPrec      = infPrec-                  , rinps         = inps-                  , routs         = outs-                  , rtblMap       = tables-                  , spgm          = pgm-                  , rconstMap     = cmap-                  , rArrayMap     = arrays-                  , rexprMap      = emap-                  , rUIMap        = uis-                  , rCgMap        = cgs-                  , raxioms       = axioms-                  , rSWCache      = swCache-                  , rAICache      = aiCache+   cstrs   <- newIORef []+   let st = State { runMode      = currentRunMode+                  , rCInfo       = cInfo+                  , rctr         = ctr+                  , rInfPrec     = infPrec+                  , rinps        = inps+                  , routs        = outs+                  , rtblMap      = tables+                  , spgm         = pgm+                  , rconstMap    = cmap+                  , rArrayMap    = arrays+                  , rexprMap     = emap+                  , rUIMap       = uis+                  , rCgMap       = cgs+                  , raxioms      = axioms+                  , rSWCache     = swCache+                  , rAICache     = aiCache+                  , rConstraints = cstrs                   }    _ <- newConst st (mkConstCW (False, Size (Just 1)) (0::Integer)) -- s(-2) == falseSW    _ <- newConst st (mkConstCW (False, Size (Just 1)) (1::Integer)) -- s(-1) == trueSW    r <- runReaderT c st    rpgm  <- readIORef pgm-   inpsR <- readIORef inps-   outsR <- readIORef outs+   inpsO <- reverse `fmap` readIORef inps+   outsO <- reverse `fmap` readIORef outs    let swap (a, b) = (b, a)        cmp  (a, _) (b, _) = a `compare` b    cnsts <- (sortBy cmp . map swap . Map.toList) `fmap` readIORef (rconstMap st)@@ -600,7 +646,9 @@    axs   <- reverse `fmap` readIORef axioms    hasInfPrec <- readIORef infPrec    cgMap <- Map.toList `fmap` readIORef cgs-   return $ (r, Result hasInfPrec cgMap (reverse inpsR) cnsts tbls arrs unint axs rpgm (reverse outsR))+   traceVals <- reverse `fmap` readIORef cInfo+   extraCstrs   <- reverse `fmap` readIORef cstrs+   return $ (r, Result hasInfPrec traceVals cgMap inpsO cnsts tbls arrs unint axs rpgm extraCstrs outsO)  ------------------------------------------------------------------------------- -- * Symbolic Words@@ -611,7 +659,7 @@ -- provide the necessary bits. -- -- Minimal complete definiton: forall, forall_, exists, exists_, literal, fromCW-class Ord a => SymWord a where+class (HasSignAndSize a, Ord a) => SymWord a where   -- | Create a user named input (universal)   forall :: String -> Symbolic (SBV a)   -- | Create an automatically named input@@ -619,17 +667,23 @@   -- | Get a bunch of new words   mkForallVars :: Int -> Symbolic [SBV a]   -- | Create an existential variable-  exists     :: String -> Symbolic (SBV a)+  exists  :: String -> Symbolic (SBV a)   -- | Create an automatically named existential variable-  exists_    :: Symbolic (SBV a)+  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]   -- | Turn a literal constant to symbolic-  literal    :: a -> SBV a+  literal :: a -> SBV a   -- | Extract a literal, if the value is concrete-  unliteral  :: SBV a -> Maybe a+  unliteral :: SBV a -> Maybe a   -- | Extract a literal, from a CW representation-  fromCW     :: CW -> a+  fromCW :: CW -> a   -- | Is the symbolic word concrete?   isConcrete :: SBV a -> Bool   -- | Is the symbolic word really symbolic?@@ -640,9 +694,10 @@   -- to impose "Bounded" on our class as Integer is not Bounded but it is a SymWord   mbMaxBound, mbMinBound :: Maybe a -  -- minimal complete definiton: forall, forall_, exists, exists_, literal, fromCW+  -- minimal complete definiton: forall, forall_, exists, exists_, free, free_, literal, fromCW   mkForallVars n = mapM (const forall_) [1 .. n]   mkExistVars n  = mapM (const exists_) [1 .. n]+  mkFreeVars n   = mapM (const free_)   [1 .. n]   unliteral (SBV _ (Left c))  = Just $ fromCW c   unliteral _                 = Nothing   isConcrete (SBV _ (Left _)) = True@@ -652,6 +707,11 @@     | Just i <- unliteral s = p i     | True                  = False +instance (Random a, SymWord 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"+  random         g = let (v, g') = random g in (literal (v :: a) , g') --------------------------------------------------------------------------------- -- * Symbolic Arrays ---------------------------------------------------------------------------------@@ -770,6 +830,33 @@ mkSFunArray = SFunArray  ---------------------------------------------------------------------------------+-- | Adding arbitrary constraints.+---------------------------------------------------------------------------------+constrain :: SBool -> Symbolic ()+constrain c = do+        st <- ask+        liftIO $ do v <- sbvToSW st c+                    modifyIORef (rConstraints st) (v:)++---------------------------------------------------------------------------------+-- | Adding a probabilistic constraint. The 'Double' argument is the probability+-- threshold. A threshold of '0' would mean the constraint is ignored, while a+-- threshold of '1' means the constraint is always added. Probabilistic constraints+-- are useful for 'genTest' and 'quickCheck' calls where we restrict our attention+-- to /interesting/ parts of the input domain.+---------------------------------------------------------------------------------+pConstrain :: Double -> SBool -> Symbolic ()+pConstrain t c+  | t < 0 || t > 1+  = error $ "SBV: pConstrain: Invalid probability threshold: " ++ show t ++ ", must be in [0, 1]."+  | True+  = do st <- ask+       case runMode st of+         Concrete -> when (t > 0) $ do r <- liftIO $ randomRIO (0, 1)+                                       when (r <= t) $ constrain c+         _        -> error "SBV: pConstrain only allowed in 'genTest' or 'quickCheck' contexts."++--------------------------------------------------------------------------------- -- * Cached values --------------------------------------------------------------------------------- @@ -826,8 +913,8 @@   rnf (CW x y z) = x `seq` y `seq` z `seq` ()  instance NFData Result where-  rnf (Result isInf cgs inps consts tbls arrs uis axs pgm outs)-        = rnf isInf `seq` rnf cgs `seq` rnf inps `seq` rnf consts `seq` rnf tbls `seq` rnf arrs `seq` rnf uis `seq` rnf axs `seq` rnf pgm `seq` rnf outs+  rnf (Result isInf qcInfo cgs inps consts tbls arrs uis axs pgm cstr outs)+        = rnf isInf `seq` rnf qcInfo `seq` rnf cgs `seq` rnf inps `seq` rnf consts `seq` rnf tbls `seq` rnf arrs `seq` rnf uis `seq` rnf axs `seq` rnf pgm `seq` rnf cstr `seq` rnf outs  instance NFData Size instance NFData ArrayContext@@ -840,8 +927,3 @@   rnf (Cached f) = f `seq` () instance NFData a => NFData (SBV a) where   rnf (SBV x y) = rnf x `seq` rnf y `seq` ()---- Quickcheck interface on symbolic-booleans..-instance Testable SBool where-  property (SBV _ (Left b)) = property (cwToBool b)-  property s                = error $ "Cannot quick-check in the presence of uninterpreted constants! (" ++ show s ++ ")"
+ Data/SBV/BitVectors/GenTest.hs view
@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.SBV.BitVectors.GenTest+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test generation from symbolic programs+-----------------------------------------------------------------------------++module Data.SBV.BitVectors.GenTest (genTest) where++import Data.Maybe (fromMaybe)++import Data.SBV.BitVectors.Data++-- | Generate a set of concrete test values from a symbolic program. The output+-- can be rendered as test vectors in different languages as necessary. Use the+-- function 'output' call to indicate what fields should be in the test result.+-- (Also see 'constrain' and 'pConstrain' for filtering acceptable test values.)+genTest :: Int -> Symbolic () -> IO [([CW], [CW])]+genTest n m = gen 0 []+  where gen i sofar+         | i == n = return (reverse sofar)+         | True   = do mbT <- tc+                       case mbT of+                        Nothing -> gen i     sofar+                        Just t  -> gen (i+1) (t:sofar)+        tc = do (_, Result _ tvals _ _ cs _ _ _ _ _ cstrs os) <- runSymbolic' Concrete m+                let cval = fromMaybe (error "Cannot generate tests in the presence of uninterpeted constants!") . (`lookup` cs)+                    cond = all (cwToBool . cval) cstrs+                    io   = (map snd tvals, map cval os)+                if cond+                   then return $ Just io+                   else return Nothing
Data/SBV/BitVectors/Model.hs view
@@ -26,13 +26,20 @@   )   where +import Control.Monad   (when)+ import Data.Array      (Array, Ix, listArray, elems, bounds, rangeSize) import Data.Bits       (Bits(..)) import Data.Int        (Int8, Int16, Int32, Int64)-import Data.List       (genericLength, genericIndex, genericSplitAt, unzip4, unzip5, unzip6, unzip7)+import Data.List       (genericLength, genericIndex, genericSplitAt, unzip4, unzip5, unzip6, unzip7, intercalate)+import Data.Maybe      (fromMaybe) import Data.Word       (Word8, Word16, Word32, Word64)-import Test.QuickCheck (Arbitrary(..)) +import Test.QuickCheck                           (Testable(..), Arbitrary(..))+import qualified Test.QuickCheck         as QC   (whenFail)+import qualified Test.QuickCheck.Monadic as QC   (monadicIO, run, pre)+import System.Random+ import Data.SBV.BitVectors.Data import Data.SBV.Utils.Boolean @@ -91,11 +98,11 @@  -- Symbolic-Word class instances -genFinVar :: Quantifier -> (Bool, Int) -> String -> Symbolic (SBV a)+genFinVar :: (Random a, SymWord a) => Maybe Quantifier -> (Bool, Int) -> String -> Symbolic (SBV a) genFinVar q (sg, sz) = mkSymSBV q (sg, Size (Just sz)) . Just -genFinVar_ :: Quantifier -> (Bool, Int) -> Symbolic (SBV a)-genFinVar_ b (sg, sz) = mkSymSBV b (sg, Size (Just sz)) Nothing+genFinVar_ :: (Random a, SymWord a) => Maybe Quantifier -> (Bool, Int) -> Symbolic (SBV a)+genFinVar_ q (sg, sz) = mkSymSBV q (sg, Size (Just sz)) Nothing  genFinLiteral :: Integral a => (Bool, Int) -> a -> SBV b genFinLiteral (sg, sz)  = SBV s . Left . mkConstCW s@@ -105,100 +112,120 @@ genFromCW x = fromInteger (cwVal x)  instance SymWord Bool where-  forall     = genFinVar  ALL (False, 1)-  forall_    = genFinVar_ ALL (False, 1)-  exists     = genFinVar  EX  (False, 1)-  exists_    = genFinVar_ EX  (False, 1)+  forall     = genFinVar  (Just ALL) (False, 1)+  forall_    = genFinVar_ (Just ALL) (False, 1)+  exists     = genFinVar  (Just EX)  (False, 1)+  exists_    = genFinVar_ (Just EX)  (False, 1)+  free       = genFinVar  Nothing    (False, 1)+  free_      = genFinVar_ Nothing    (False, 1)   literal x  = genFinLiteral (False, 1) (if x then (1::Integer) else 0)   fromCW     = cwToBool   mbMaxBound = Just maxBound   mbMinBound = Just minBound  instance SymWord Word8 where-  forall     = genFinVar   ALL (False, 8)-  forall_    = genFinVar_  ALL (False, 8)-  exists     = genFinVar   EX  (False, 8)-  exists_    = genFinVar_  EX  (False, 8)+  forall     = genFinVar   (Just ALL) (False, 8)+  forall_    = genFinVar_  (Just ALL) (False, 8)+  exists     = genFinVar   (Just EX)  (False, 8)+  exists_    = genFinVar_  (Just EX)  (False, 8)+  free       = genFinVar   Nothing    (False, 8)+  free_      = genFinVar_  Nothing    (False, 8)   literal    = genFinLiteral (False, 8)   fromCW     = genFromCW   mbMaxBound = Just maxBound   mbMinBound = Just minBound  instance SymWord Int8 where-  forall     = genFinVar   ALL (True, 8)-  forall_    = genFinVar_  ALL (True, 8)-  exists     = genFinVar   EX  (True, 8)-  exists_    = genFinVar_  EX  (True, 8)+  forall     = genFinVar   (Just ALL) (True, 8)+  forall_    = genFinVar_  (Just ALL) (True, 8)+  exists     = genFinVar   (Just EX)  (True, 8)+  exists_    = genFinVar_  (Just EX)  (True, 8)+  free       = genFinVar   Nothing    (True, 8)+  free_      = genFinVar_  Nothing    (True, 8)   literal    = genFinLiteral (True, 8)   fromCW     = genFromCW   mbMaxBound = Just maxBound   mbMinBound = Just minBound  instance SymWord Word16 where-  forall     = genFinVar   ALL (False, 16)-  forall_    = genFinVar_  ALL (False, 16)-  exists     = genFinVar   EX  (False, 16)-  exists_    = genFinVar_  EX  (False, 16)+  forall     = genFinVar   (Just ALL) (False, 16)+  forall_    = genFinVar_  (Just ALL) (False, 16)+  exists     = genFinVar   (Just EX)  (False, 16)+  exists_    = genFinVar_  (Just EX)  (False, 16)+  free       = genFinVar   Nothing    (False, 16)+  free_      = genFinVar_  Nothing    (False, 16)   literal    = genFinLiteral (False, 16)   fromCW     = genFromCW   mbMaxBound = Just maxBound   mbMinBound = Just minBound  instance SymWord Int16 where-  forall     = genFinVar   ALL (True, 16)-  forall_    = genFinVar_  ALL (True, 16)-  exists     = genFinVar   EX  (True, 16)-  exists_    = genFinVar_  EX  (True, 16)+  forall     = genFinVar   (Just ALL) (True, 16)+  forall_    = genFinVar_  (Just ALL) (True, 16)+  exists     = genFinVar   (Just EX)  (True, 16)+  exists_    = genFinVar_  (Just EX)  (True, 16)+  free       = genFinVar   Nothing    (True, 16)+  free_      = genFinVar_  Nothing    (True, 16)   literal    = genFinLiteral (True, 16)   fromCW     = genFromCW   mbMaxBound = Just maxBound   mbMinBound = Just minBound  instance SymWord Word32 where-  forall     = genFinVar   ALL (False, 32)-  forall_    = genFinVar_  ALL (False, 32)-  exists     = genFinVar   EX  (False, 32)-  exists_    = genFinVar_  EX  (False, 32)+  forall     = genFinVar   (Just ALL) (False, 32)+  forall_    = genFinVar_  (Just ALL) (False, 32)+  exists     = genFinVar   (Just EX)  (False, 32)+  exists_    = genFinVar_  (Just EX)  (False, 32)+  free       = genFinVar   Nothing    (False, 32)+  free_      = genFinVar_  Nothing    (False, 32)   literal    = genFinLiteral (False, 32)   fromCW     = genFromCW   mbMaxBound = Just maxBound   mbMinBound = Just minBound  instance SymWord Int32 where-  forall     = genFinVar   ALL (True, 32)-  forall_    = genFinVar_  ALL (True, 32)-  exists     = genFinVar   EX  (True, 32)-  exists_    = genFinVar_  EX  (True, 32)+  forall     = genFinVar   (Just ALL) (True, 32)+  forall_    = genFinVar_  (Just ALL) (True, 32)+  exists     = genFinVar   (Just EX)  (True, 32)+  exists_    = genFinVar_  (Just EX)  (True, 32)+  free       = genFinVar   Nothing    (True, 32)+  free_      = genFinVar_  Nothing    (True, 32)   literal    = genFinLiteral (True, 32)   fromCW     = genFromCW   mbMaxBound = Just maxBound   mbMinBound = Just minBound  instance SymWord Word64 where-  forall     = genFinVar   ALL (False, 64)-  forall_    = genFinVar_  ALL (False, 64)-  exists     = genFinVar   EX  (False, 64)-  exists_    = genFinVar_  EX  (False, 64)+  forall     = genFinVar   (Just ALL) (False, 64)+  forall_    = genFinVar_  (Just ALL) (False, 64)+  exists     = genFinVar   (Just EX)  (False, 64)+  exists_    = genFinVar_  (Just EX)  (False, 64)+  free       = genFinVar   Nothing    (False, 64)+  free_      = genFinVar_  Nothing    (False, 64)   literal    = genFinLiteral (False, 64)   fromCW     = genFromCW   mbMaxBound = Just maxBound   mbMinBound = Just minBound  instance SymWord Int64 where-  forall     = genFinVar   ALL (True, 64)-  forall_    = genFinVar_  ALL (True, 64)-  exists     = genFinVar   EX  (True, 64)-  exists_    = genFinVar_  EX  (True, 64)+  forall     = genFinVar   (Just ALL) (True, 64)+  forall_    = genFinVar_  (Just ALL) (True, 64)+  exists     = genFinVar   (Just EX)  (True, 64)+  exists_    = genFinVar_  (Just EX)  (True, 64)+  free       = genFinVar   Nothing    (True, 64)+  free_      = genFinVar_  Nothing    (True, 64)   literal    = genFinLiteral (True, 64)   fromCW     = genFromCW   mbMaxBound = Just maxBound   mbMinBound = Just minBound  instance SymWord Integer where-  forall     = mkSymSBV ALL (True, Size Nothing) . Just-  forall_    = mkSymSBV ALL (True, Size Nothing) Nothing-  exists     = mkSymSBV EX  (True, Size Nothing) . Just-  exists_    = mkSymSBV EX  (True, Size Nothing) Nothing+  forall     = mkSymSBV (Just ALL) (True, Size Nothing) . Just+  forall_    = mkSymSBV (Just ALL) (True, Size Nothing) Nothing+  exists     = mkSymSBV (Just EX)  (True, Size Nothing) . Just+  exists_    = mkSymSBV (Just EX)  (True, Size Nothing) Nothing+  free       = mkSymSBV Nothing    (True, Size Nothing) . Just+  free_      = mkSymSBV Nothing    (True, Size Nothing) Nothing   literal    = SBV (True, Size Nothing) . Left . mkConstCW (True, Size Nothing)   fromCW     = genFromCW   mbMaxBound = Nothing@@ -448,9 +475,8 @@     | y `isConcretely` (== 0)  = x     | True                     = liftSym2 (mkSymOp  XOr) xor x y   complement = liftSym1 (mkSymOp1 Not) complement-  bitSize  (SBV (_, Size (Just s)) _) = s-  bitSize  (SBV (_, Size Nothing)  _) = error "Data.Bits.bitSize(Integer)"-  isSigned (SBV (b, _) _)  = b+  bitSize  _ = intSizeOf (undefined :: a)+  isSigned _ = hasSign   (undefined :: a)   shiftL x y     | y < 0                = shiftR x (-y)     | y == 0               = x@@ -462,11 +488,13 @@   rotateL x y     | y < 0                = rotateR x (-y)     | y == 0               = x-    | True                 = let sz = bitSize x in liftSym1 (mkSymOp1 (Rol (y `mod` sz))) (rot True sz y) x+    | not (isInfPrec x)    = let sz = bitSize x in liftSym1 (mkSymOp1 (Rol (y `mod` sz))) (rot True sz y) x+    | True                 = shiftL x y   -- for unbounded Integers, rotateL is the same as shiftL in Haskell   rotateR x y     | y < 0                = rotateL x (-y)     | y == 0               = x-    | True                 = let sz = bitSize x in liftSym1 (mkSymOp1 (Ror (y `mod` sz))) (rot False sz y) x+    | not (isInfPrec x)    = let sz = bitSize x in liftSym1 (mkSymOp1 (Ror (y `mod` sz))) (rot False sz y) x+    | True                 = shiftR x y   -- for unbounded integers, rotateR is the same as shiftR in Haskell  -- Since the underlying representation is just Integers, rotations has to be careful on the bit-size rot :: Bool -> Int -> Int -> Integer -> Integer@@ -899,7 +927,7 @@      | Just (_, v) <- mbCgData = (mkUFName nm, v)      | True                    = (mkUFName nm, SBV sgnsza $ Right $ cache result)     where sgnsza = (hasSign (undefined :: a), sizeOf (undefined :: a))-          result st | Just (_, v) <- mbCgData, not (inCodeGenMode st) = sbvToSW st v+          result st | Just (_, v) <- mbCgData, inProofMode st = sbvToSW st v                     | True = do newUninterpreted st nm (SBVType [sgnsza]) (fst `fmap` mbCgData)                                 newExpr st sgnsza $ SBVApp (Uninterpreted nm) [] @@ -910,7 +938,7 @@ forceArg (SW (b, s) n) = b `seq` s `seq` n `seq` return ()  -- Functions of one argument-instance (SymWord b, HasSignAndSize b, HasSignAndSize a) => Uninterpreted (SBV b -> SBV a) where+instance (SymWord b, HasSignAndSize a) => Uninterpreted (SBV b -> SBV a) where   sbvUninterpret mbCgData nm = (mkUFName nm, f)     where f arg0            | Just (_, v) <- mbCgData, isConcrete arg0@@ -919,14 +947,14 @@            = SBV sgnsza $ Right $ cache result            where sgnsza = (hasSign (undefined :: a), sizeOf (undefined :: a))                  sgnszb = (hasSign (undefined :: b), sizeOf (undefined :: b))-                 result st | Just (_, v) <- mbCgData, not (inCodeGenMode st) = sbvToSW st (v arg0)+                 result st | Just (_, v) <- mbCgData, inProofMode st = sbvToSW st (v arg0)                            | True = do newUninterpreted st nm (SBVType [sgnszb, sgnsza]) (fst `fmap` mbCgData)                                        sw0 <- sbvToSW st arg0                                        mapM_ forceArg [sw0]                                        newExpr st sgnsza $ SBVApp (Uninterpreted nm) [sw0]  -- Functions of two arguments-instance (SymWord c, SymWord b, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a) => Uninterpreted (SBV c -> SBV b -> SBV a) where+instance (SymWord c, SymWord b, HasSignAndSize a) => Uninterpreted (SBV c -> SBV b -> SBV a) where   sbvUninterpret mbCgData nm = (mkUFName nm, f)     where f arg0 arg1            | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1@@ -936,7 +964,7 @@            where sgnsza = (hasSign (undefined :: a), sizeOf (undefined :: a))                  sgnszb = (hasSign (undefined :: b), sizeOf (undefined :: b))                  sgnszc = (hasSign (undefined :: c), sizeOf (undefined :: c))-                 result st | Just (_, v) <- mbCgData, not (inCodeGenMode st) = sbvToSW st (v arg0 arg1)+                 result st | Just (_, v) <- mbCgData, inProofMode st = sbvToSW st (v arg0 arg1)                            | True = do newUninterpreted st nm (SBVType [sgnszc, sgnszb, sgnsza]) (fst `fmap` mbCgData)                                        sw0 <- sbvToSW st arg0                                        sw1 <- sbvToSW st arg1@@ -944,7 +972,7 @@                                        newExpr st sgnsza $ SBVApp (Uninterpreted nm) [sw0, sw1]  -- Functions of three arguments-instance (SymWord d, SymWord c, SymWord b, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a) => Uninterpreted (SBV d -> SBV c -> SBV b -> SBV a) where+instance (SymWord d, SymWord c, SymWord b, HasSignAndSize a) => Uninterpreted (SBV d -> SBV c -> SBV b -> SBV a) where   sbvUninterpret mbCgData nm = (mkUFName nm, f)     where f arg0 arg1 arg2            | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2@@ -955,7 +983,7 @@                  sgnszb = (hasSign (undefined :: b), sizeOf (undefined :: b))                  sgnszc = (hasSign (undefined :: c), sizeOf (undefined :: c))                  sgnszd = (hasSign (undefined :: d), sizeOf (undefined :: d))-                 result st | Just (_, v) <- mbCgData, not (inCodeGenMode st) = sbvToSW st (v arg0 arg1 arg2)+                 result st | Just (_, v) <- mbCgData, inProofMode st = sbvToSW st (v arg0 arg1 arg2)                            | True = do newUninterpreted st nm (SBVType [sgnszd, sgnszc, sgnszb, sgnsza]) (fst `fmap` mbCgData)                                        sw0 <- sbvToSW st arg0                                        sw1 <- sbvToSW st arg1@@ -964,8 +992,7 @@                                        newExpr st sgnsza $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2]  -- Functions of four arguments-instance (SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize e, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a)-            => Uninterpreted (SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where+instance (SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize a) => Uninterpreted (SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where   sbvUninterpret mbCgData nm = (mkUFName nm, f)     where f arg0 arg1 arg2 arg3            | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3@@ -977,7 +1004,7 @@                  sgnszc = (hasSign (undefined :: c), sizeOf (undefined :: c))                  sgnszd = (hasSign (undefined :: d), sizeOf (undefined :: d))                  sgnsze = (hasSign (undefined :: e), sizeOf (undefined :: e))-                 result st | Just (_, v) <- mbCgData, not (inCodeGenMode st) = sbvToSW st (v arg0 arg1 arg2 arg3)+                 result st | Just (_, v) <- mbCgData, inProofMode st = sbvToSW st (v arg0 arg1 arg2 arg3)                            | True = do newUninterpreted st nm (SBVType [sgnsze, sgnszd, sgnszc, sgnszb, sgnsza]) (fst `fmap` mbCgData)                                        sw0 <- sbvToSW st arg0                                        sw1 <- sbvToSW st arg1@@ -987,8 +1014,7 @@                                        newExpr st sgnsza $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3]  -- Functions of five arguments-instance (SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize f, HasSignAndSize e, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a)-            => Uninterpreted (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where+instance (SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize a) => Uninterpreted (SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where   sbvUninterpret mbCgData nm = (mkUFName nm, f)     where f arg0 arg1 arg2 arg3 arg4            | Just (_, v) <- mbCgData, isConcrete arg0, isConcrete arg1, isConcrete arg2, isConcrete arg3, isConcrete arg4@@ -1001,7 +1027,7 @@                  sgnszd = (hasSign (undefined :: d), sizeOf (undefined :: d))                  sgnsze = (hasSign (undefined :: e), sizeOf (undefined :: e))                  sgnszf = (hasSign (undefined :: f), sizeOf (undefined :: f))-                 result st | Just (_, v) <- mbCgData, not (inCodeGenMode st) = sbvToSW st (v arg0 arg1 arg2 arg3 arg4)+                 result st | Just (_, v) <- mbCgData, inProofMode st = sbvToSW st (v arg0 arg1 arg2 arg3 arg4)                            | True = do newUninterpreted st nm (SBVType [sgnszf, sgnsze, sgnszd, sgnszc, sgnszb, sgnsza]) (fst `fmap` mbCgData)                                        sw0 <- sbvToSW st arg0                                        sw1 <- sbvToSW st arg1@@ -1012,8 +1038,7 @@                                        newExpr st sgnsza $ 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, HasSignAndSize g, HasSignAndSize f, HasSignAndSize e, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a)-            => Uninterpreted (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where+instance (SymWord g, SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize a) => Uninterpreted (SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where   sbvUninterpret mbCgData nm = (mkUFName 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@@ -1027,7 +1052,7 @@                  sgnsze = (hasSign (undefined :: e), sizeOf (undefined :: e))                  sgnszf = (hasSign (undefined :: f), sizeOf (undefined :: f))                  sgnszg = (hasSign (undefined :: g), sizeOf (undefined :: g))-                 result st | Just (_, v) <- mbCgData, not (inCodeGenMode st) = sbvToSW st (v arg0 arg1 arg2 arg3 arg4 arg5)+                 result st | Just (_, v) <- mbCgData, inProofMode st = sbvToSW st (v arg0 arg1 arg2 arg3 arg4 arg5)                            | True = do newUninterpreted st nm (SBVType [sgnszg, sgnszf, sgnsze, sgnszd, sgnszc, sgnszb, sgnsza]) (fst `fmap` mbCgData)                                        sw0 <- sbvToSW st arg0                                        sw1 <- sbvToSW st arg1@@ -1039,7 +1064,7 @@                                        newExpr st sgnsza $ 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, HasSignAndSize h, HasSignAndSize g, HasSignAndSize f, HasSignAndSize e, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a)+instance (SymWord h, SymWord g, SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize a)             => Uninterpreted (SBV h -> SBV g -> SBV f -> SBV e -> SBV d -> SBV c -> SBV b -> SBV a) where   sbvUninterpret mbCgData nm = (mkUFName nm, f)     where f arg0 arg1 arg2 arg3 arg4 arg5 arg6@@ -1055,7 +1080,7 @@                  sgnszf = (hasSign (undefined :: f), sizeOf (undefined :: f))                  sgnszg = (hasSign (undefined :: g), sizeOf (undefined :: g))                  sgnszh = (hasSign (undefined :: h), sizeOf (undefined :: h))-                 result st | Just (_, v) <- mbCgData, not (inCodeGenMode st) = sbvToSW st (v arg0 arg1 arg2 arg3 arg4 arg5 arg6)+                 result st | Just (_, v) <- mbCgData, inProofMode st = sbvToSW st (v arg0 arg1 arg2 arg3 arg4 arg5 arg6)                           | True = do newUninterpreted st nm (SBVType [sgnszh, sgnszg, sgnszf, sgnsze, sgnszd, sgnszc, sgnszb, sgnsza]) (fst `fmap` mbCgData)                                       sw0 <- sbvToSW st arg0                                       sw1 <- sbvToSW st arg1@@ -1068,35 +1093,64 @@                                       newExpr st sgnsza $ SBVApp (Uninterpreted nm) [sw0, sw1, sw2, sw3, sw4, sw5, sw6]  -- Uncurried functions of two arguments-instance (SymWord c, SymWord b, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a) => Uninterpreted ((SBV c, SBV b) -> SBV a) where+instance (SymWord c, SymWord b, HasSignAndSize a) => Uninterpreted ((SBV c, SBV b) -> SBV a) where   sbvUninterpret mbCgData nm = let (h, f) = sbvUninterpret (uc2 `fmap` mbCgData) nm in (h, \(arg0, arg1) -> f arg0 arg1)     where uc2 (cs, fn) = (cs, \a b -> fn (a, b))  -- Uncurried functions of three arguments-instance (SymWord d, SymWord c, SymWord b, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a) => Uninterpreted ((SBV d, SBV c, SBV b) -> SBV a) where+instance (SymWord d, SymWord c, SymWord b, HasSignAndSize a) => Uninterpreted ((SBV d, SBV c, SBV b) -> SBV a) where   sbvUninterpret mbCgData nm = let (h, f) = sbvUninterpret (uc3 `fmap` mbCgData) nm in (h, \(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, HasSignAndSize e, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a)+instance (SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize a)             => Uninterpreted ((SBV e, SBV d, SBV c, SBV b) -> SBV a) where   sbvUninterpret mbCgData nm = let (h, f) = sbvUninterpret (uc4 `fmap` mbCgData) nm in (h, \(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, HasSignAndSize f, HasSignAndSize e, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a)+instance (SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize a)             => Uninterpreted ((SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where   sbvUninterpret mbCgData nm = let (h, f) = sbvUninterpret (uc5 `fmap` mbCgData) nm in (h, \(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, HasSignAndSize g, HasSignAndSize f, HasSignAndSize e, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a)+instance (SymWord g, SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize a)             => Uninterpreted ((SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where   sbvUninterpret mbCgData nm = let (h, f) = sbvUninterpret (uc6 `fmap` mbCgData) nm in (h, \(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, HasSignAndSize h, HasSignAndSize g, HasSignAndSize f, HasSignAndSize e, HasSignAndSize d, HasSignAndSize c, HasSignAndSize b, HasSignAndSize a)+instance (SymWord h, SymWord g, SymWord f, SymWord e, SymWord d, SymWord c, SymWord b, HasSignAndSize a)             => Uninterpreted ((SBV h, SBV g, SBV f, SBV e, SBV d, SBV c, SBV b) -> SBV a) where   sbvUninterpret mbCgData nm = let (h, f) = sbvUninterpret (uc7 `fmap` mbCgData) nm in (h, \(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))++-- Quickcheck interface on symbolic-booleans..+instance Testable SBool where+  property (SBV _ (Left b)) = property (cwToBool b)+  property s                = error $ "Cannot quick-check in the presence of uninterpreted constants! (" ++ show s ++ ")"++instance Testable (Symbolic SBool) where+  property m = QC.whenFail (putStrLn msg) $ QC.monadicIO test+    where test = do mbDie <- QC.run $ do+                                (r, Result _ tvals _ _ cs _ _ _ _ _ cstrs _) <- runSymbolic' Concrete m+                                let cval = fromMaybe (error "Cannot quick-check in the presence of uninterpeted constants!") . (`lookup` cs)+                                    cond = all (cwToBool . cval) cstrs+                                when (isSymbolic r) $ error $ "Cannot quick-check in the presence of uninterpreted constants! (" ++ show r ++ ")"+                                if cond+                                   then if r `isConcretely` id+                                           then return $ Just True+                                           else do putStrLn $ complain tvals+                                                   return Nothing+                                   else return $ Just False+                    case mbDie of+                      Just True  -> return ()           -- test successfull, continue+                      Just False -> QC.pre False        -- precondition failed, ignore+                      Nothing    -> fail "Falsifiable"  -- property failed, die+          msg = "*** SBV: See the custom counter example reported above."+          complain []     = "*** SBV Counter Example: Predicate contains no universally quantified variables."+          complain qcInfo = intercalate "\n" $ "*** SBV Counter Example:" : map (("  " ++) . info) qcInfo+            where maxLen = maximum (0:[length s | (s, _) <- qcInfo])+                  shN s = s ++ replicate (maxLen - length s) ' '+                  info (n, cw) = shN n ++ " = " ++ show cw
Data/SBV/BitVectors/Optimize.hs view
@@ -13,47 +13,96 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} -module Data.SBV.BitVectors.Optimize (optimize, minimize, maximize) where+module Data.SBV.BitVectors.Optimize (OptimizeOpts(..), optimize, optimizeWith, minimize, minimizeWith, maximize, maximizeWith) where +import Data.Maybe (fromJust)+ import Data.SBV.BitVectors.Data-import Data.SBV.BitVectors.Model (OrdSymbolic(..))+import Data.SBV.BitVectors.Model (OrdSymbolic(..), EqSymbolic(..)) import Data.SBV.Provers.Prover   (satWith, z3)-import Data.SBV.SMT.SMT          (SatModel, getModel)+import Data.SBV.SMT.SMT          (SatModel, getModel, SMTConfig(..)) import Data.SBV.Utils.Boolean +-- | Optimizer configuration. Note that iterative and quantified approaches are in general not interchangeable.+-- For instance, iterative solutions will loop infinitely when there is no optimal value, but quantified solutions+-- can handle such problems. Of course, quantified problems are harder for SMT solvers, naturally.+data OptimizeOpts = Iterative  Bool   -- ^ Iteratively search. if True, it will be reporting progress+                  | Quantified        -- ^ Use quantifiers+ -- | Symbolic optimization. Generalization on 'minimize' and 'maximize' that allows arbitrary -- cost functions and comparisons.-optimize :: (SatModel a, SymWord a)-         => (cost -> cost -> SBool)           -- ^ comparator-         -> ([SBV a] -> cost)                 -- ^ cost function-         -> Int                               -- ^ how many elements?-         -> ([SBV a] -> SBool)                -- ^ validity constraint-         -> IO (Maybe [a])-optimize cmp cost n valid = do-        m <- satWith z3 $ do-                xs <- mkExistVars  n-                ys <- mkForallVars n-                return $ valid xs &&& (valid ys ==> cost xs `cmp` cost ys)-        case getModel m of-          Right (False, a) -> return $ Just a-          _                -> return Nothing+optimizeWith :: (SatModel a, SymWord a, Show a, SymWord c, Show c)+             => SMTConfig                         -- ^ SMT configuration+             -> OptimizeOpts                      -- ^ Optimization options+             -> (SBV c -> SBV c -> SBool)         -- ^ comparator+             -> ([SBV a] -> SBV c)                -- ^ cost function+             -> Int                               -- ^ how many elements?+             -> ([SBV a] -> SBool)                -- ^ validity constraint+             -> IO (Maybe [a])+optimizeWith cfg (Iterative chatty) = iterOptimize chatty cfg+optimizeWith cfg Quantified         = quantOptimize cfg +-- | Variant of 'optimizeWith' using z3+optimize :: (SatModel a, SymWord a, Show a, SymWord c, Show c) => OptimizeOpts -> (SBV c -> SBV c -> SBool) -> ([SBV a] -> SBV c) -> Int -> ([SBV a] -> SBool) -> IO (Maybe [a])+optimize = optimizeWith z3++-- | Variant of 'maximize' allowing the use of a user specified solver.+maximizeWith :: (SatModel a, SymWord a, Show a, SymWord c, Show c) => SMTConfig -> OptimizeOpts -> ([SBV a] -> SBV c) -> Int -> ([SBV a] -> SBool) -> IO (Maybe [a])+maximizeWith cfg opts = optimizeWith cfg opts (.>=)+ -- | Maximizes a cost function with respect to a constraint. Examples: -----   >>> maximize sum 3 (bAll (.< (10 :: SInteger)))+--   >>> maximize Quantified sum 3 (bAll (.< (10 :: SInteger))) --   Just [9,9,9]------   >>> maximize sum 3 (bAll (.> (10 :: SInteger)))---   Nothing-maximize :: (SatModel a, SymWord a, OrdSymbolic cost) => ([SBV a] -> cost) -> Int -> ([SBV a] -> SBool) -> IO (Maybe [a])-maximize = optimize (.>=)+maximize :: (SatModel a, SymWord a, Show a, SymWord c, Show c) => OptimizeOpts -> ([SBV a] -> SBV c) -> Int -> ([SBV a] -> SBool) -> IO (Maybe [a])+maximize = maximizeWith z3 +-- | Variant of 'minimize' allowing the use of a user specified solver.+minimizeWith :: (SatModel a, SymWord a, Show a, SymWord c, Show c) => SMTConfig -> OptimizeOpts -> ([SBV a] -> SBV c) -> Int -> ([SBV a] -> SBool) -> IO (Maybe [a])+minimizeWith cfg opts = optimizeWith cfg opts (.<=)+ -- | Minimizes a cost function with respect to a constraint. Examples: -----   >>> minimize sum 3 (bAll (.> (10 :: SInteger)))+--   >>> minimize Quantified sum 3 (bAll (.> (10 :: SInteger))) --   Just [11,11,11]------   >>> minimize sum 3 (bAll (.< (10 :: SInteger)))---   Nothing-minimize :: (SatModel a, SymWord a, OrdSymbolic cost) => ([SBV a] -> cost) -> Int -> ([SBV a] -> SBool) -> IO (Maybe [a])-minimize = optimize (.<=)+minimize :: (SatModel a, SymWord a, Show a, SymWord c, Show c) => OptimizeOpts -> ([SBV a] -> SBV c) -> Int -> ([SBV a] -> SBool) -> IO (Maybe [a])+minimize = minimizeWith z3++-- | Optimization using quantifiers+quantOptimize :: (SatModel a, SymWord a) => SMTConfig -> (SBV c -> SBV c -> SBool) -> ([SBV a] -> SBV c) -> Int -> ([SBV a] -> SBool) -> IO (Maybe [a])+quantOptimize cfg cmp cost n valid = do+           m <- satWith cfg $ do xs <- mkExistVars  n+                                 ys <- mkForallVars n+                                 return $ valid xs &&& (valid ys ==> cost xs `cmp` cost ys)+           case getModel m of+              Right (True, _)  -> error "SBV: Backend solver reported \"unknown\""+              Right (False, a) -> return $ Just a+              Left _           -> return Nothing++-- | Optimization using iteration+iterOptimize :: (SatModel a, Show a, SymWord a, Show c, SymWord c) =>  Bool -> SMTConfig -> (SBV c -> SBV c -> SBool) -> ([SBV a] -> SBV c) -> Int -> ([SBV a] -> SBool) -> IO (Maybe [a])+iterOptimize chatty cfg cmp cost n valid = do+        msg "Trying to find a satisfying solution."+        m <- satWith cfg $ valid `fmap` mkExistVars n+        case getModel m of+          Left _ -> return Nothing+          Right (True, _)  -> error "SBV: Backend solver reported \"unknown\""+          Right (False, a) -> do msg $ "First solution found: " ++ show a+                                 let c = cost (map literal a)+                                 msg $ "Initial value is    : " ++ show (fromJust (unliteral c))+                                 msg "Starting iterative search."+                                 go (1::Int) a c+  where msg m | chatty = putStrLn $ "*** " ++ m+              | True   = return ()+        go i curSol curCost = do+                msg $ "Round " ++ show i ++ " ****************************"+                m <- satWith cfg $ do xs <- mkExistVars n+                                      return $ let c = cost xs in valid xs &&& (c `cmp` curCost &&& c ./= curCost)+                case getModel m of+                  Left _ -> do msg "The current solution is optimal. Terminating search."+                               return $ Just curSol+                  Right (True, _)  -> error "SBV: Backend solver reported \"unknown\""+                  Right (False, a) -> do msg $ "Solution: " ++ show a+                                         let c = cost (map literal a)+                                         msg $ "Value   : " ++ show (fromJust (unliteral c))+                                         go (i+1) a c
Data/SBV/BitVectors/STree.hs view
@@ -62,7 +62,7 @@ mkSTree :: forall i e. HasSignAndSize i => [SBV e] -> STree i e mkSTree ivals   | isInfPrec (undefined :: i)-  = error $ "SBV.STree.mkSTree: Cannot build an infinitely large tree"+  = error "SBV.STree.mkSTree: Cannot build an infinitely large tree"   | reqd /= given   = error $ "SBV.STree.mkSTree: Required " ++ show reqd ++ " elements, received: " ++ show given   | True
Data/SBV/Compilers/C.hs view
@@ -370,8 +370,9 @@  -- | Generate the C program genCProg :: Bool -> Maybe Int -> String -> Doc -> Result -> [(String, CgVal)] -> [(String, CgVal)] -> Maybe SW -> Doc -> [Doc]-genCProg rtc mbISize fn proto (Result hasInfPrec cgs ins preConsts tbls arrs _ _ asgns _) inVars outVars mbRet extDecls+genCProg rtc mbISize fn proto (Result hasInfPrec _ cgs ins preConsts tbls arrs _ _ asgns cstrs _) inVars outVars mbRet extDecls   | isNothing mbISize && hasInfPrec = dieUnbounded+  | not (null cstrs)                = tbd "Explicit constraints"   | not (null arrs)                 = tbd "User specified arrays"   | needsExistentials (map fst ins) = error "SBV->C: Cannot compile functions with existentially quantified variables."   | True                            = [pre, header, post]
Data/SBV/Compilers/CodeGen.hs view
@@ -122,14 +122,14 @@ cgAddLDFlags ss = modify (\s -> s { cgLDFlags = cgLDFlags s ++ ss })  -- | Creates an atomic input in the generated code.-cgInput :: (HasSignAndSize a, SymWord a) => String -> SBVCodeGen (SBV a)+cgInput :: SymWord a => String -> SBVCodeGen (SBV a) cgInput nm = do r <- liftSymbolic forall_                 sw <- cgSBVToSW r                 modify (\s -> s { cgInputs = (nm, CgAtomic sw) : cgInputs s })                 return r  -- | Creates an array input in the generated code.-cgInputArr :: (HasSignAndSize a, SymWord a) => Int -> String -> SBVCodeGen [SBV a]+cgInputArr :: SymWord 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 <- liftSymbolic $ mapM (const forall_) [1..sz]@@ -138,13 +138,13 @@                 return rs  -- | Creates an atomic output in the generated code.-cgOutput :: (HasSignAndSize a, SymWord a) => String -> SBV a -> SBVCodeGen ()+cgOutput :: SymWord a => String -> SBV a -> SBVCodeGen () cgOutput nm v = do _ <- liftSymbolic (output v)                    sw <- cgSBVToSW v                    modify (\s -> s { cgOutputs = (nm, CgAtomic sw) : cgOutputs s })  -- | Creates an array output in the generated code.-cgOutputArr :: (HasSignAndSize a, SymWord a) => String -> [SBV a] -> SBVCodeGen ()+cgOutputArr :: SymWord 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 _ <- liftSymbolic (mapM output vs)@@ -153,13 +153,13 @@   where sz = length vs  -- | Creates a returned (unnamed) value in the generated code.-cgReturn :: (HasSignAndSize a, SymWord a) => SBV a -> SBVCodeGen ()+cgReturn :: SymWord a => SBV a -> SBVCodeGen () cgReturn v = do _ <- liftSymbolic (output v)                 sw <- cgSBVToSW v                 modify (\s -> s { cgReturns = CgAtomic sw : cgReturns s })  -- | Creates a returned (unnamed) array value in the generated code.-cgReturnArr :: (HasSignAndSize a, SymWord a) => [SBV a] -> SBVCodeGen ()+cgReturnArr :: SymWord a => [SBV a] -> SBVCodeGen () cgReturnArr vs   | sz < 1 = error $ "SBV.cgReturnArr: Array returns must have at least one element, received " ++ show sz   | True   = do _ <- liftSymbolic (mapM output vs)@@ -190,7 +190,7 @@  codeGen :: CgTarget l => l -> CgConfig -> String -> SBVCodeGen () -> IO CgPgmBundle codeGen l cgConfig nm (SBVCodeGen comp) = do-   (((), st'), res) <- runSymbolic' True $ runStateT comp initCgState { cgFinalConfig = cgConfig }+   (((), st'), res) <- runSymbolic' CodeGen $ runStateT comp initCgState { cgFinalConfig = cgConfig }    let st = st' { cgInputs       = reverse (cgInputs st')                 , cgOutputs      = reverse (cgOutputs st')                 }
− Data/SBV/Examples/Arrays/Memory.hs 
@@ -1,44 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.Arrays.Memory--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Simple memory abstraction and properties--------------------------------------------------------------------------------module Data.SBV.Examples.Arrays.Memory where--import Data.SBV--type Address = SWord32-type Value   = SWord64-type Memory  = SArray Word32 Word64---- | read-after-write: If you write a value and read it back, you'll get it-raw :: Address -> Value -> Memory -> SBool-raw a v m = readArray (writeArray m a v) a .== v---- | write-after-write: If you write to the same location twice, then the first one is ignored-waw :: Address -> Value -> Value -> Memory -> SBool-waw a v1 v2 m0 = m2 .== m3-  where m1 = writeArray m0 a v1-        m2 = writeArray m1 a v2-        m3 = writeArray m0 a v2---- | Two writes to different locations commute, i.e., can be done in any order-wcommutesGood :: (Address, Value) -> (Address, Value) -> Memory -> SBool-wcommutesGood (a, x) (b, y) m = a ./= b ==> wcommutesBad (a, x) (b, y) m---- | Two writes do not commute if they can be done to the same location-wcommutesBad :: (Address, Value) -> (Address, Value) -> Memory -> SBool-wcommutesBad (a, x) (b, y) m = writeArray (writeArray m a x) b y .== writeArray (writeArray m b y) a x--tests :: IO ()-tests = do print =<< prove raw-           print =<< prove waw-           print =<< prove wcommutesBad-           print =<< prove wcommutesGood
− Data/SBV/Examples/Basics/BasicTests.hs 
@@ -1,47 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.Basics.BasicTests--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Basic tests of the sbv library--------------------------------------------------------------------------------{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Data.SBV.Examples.Basics.BasicTests where--import Data.SBV-import Data.SBV.Internals--test0 :: (forall a. Num a => (a -> a -> a)) -> Word8-test0 f = f (3 :: Word8) 2--test1, test2, test3, test4, test5 :: (forall a. Num a => (a -> a -> a)) -> IO Result-test1 f = runSymbolic $ do let x = literal (3 :: Word8)-                               y = literal (2 :: Word8)-                           output $ f x y-test2 f = runSymbolic $ do let x = literal (3 :: Word8)-                           y :: SWord8 <- forall "y"-                           output $ f x y-test3 f = runSymbolic $ do x :: SWord8 <- forall "x"-                           y :: SWord8 <- forall "y"-                           output $ f x y-test4 f = runSymbolic $ do x :: SWord8 <- forall "x"-                           output $ f x x-test5 f = runSymbolic $ do x :: SWord8 <- forall "x"-                           let r = f x x-                           q :: SWord8 <- forall "q"-                           _ <- output q-                           output r--f1, f2, f3, f4, f5 :: Num a => a -> a -> a-f1 x y = (x+y)*(x-y)-f2 x y = (x*x)-(y*y)-f3 x y = (x+y)*(x+y)-f4 x y = let z = x + y in z * z-f5 x _ = x + 1
− Data/SBV/Examples/Basics/Higher.hs 
@@ -1,50 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.Basics.Higher--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Testing function equality--------------------------------------------------------------------------------module Data.SBV.Examples.Basics.Higher where--import Data.SBV--type B = SWord8--f11 :: B -> B-f11 x = x--f12 :: B -> (B, B)-f12 x = (x, x)--f21 :: (B, B) -> B-f21 (x, y) = x + y--f22 :: (B, B) -> (B, B)-f22 (x, y) = (x, y)--f31 :: B -> B -> B-f31 x y = x + y--f32 :: B -> B -> (B, B)-f32 x y = (x, y)--f33 :: B -> B -> B -> (B, B, B)-f33 x y z = (x, y, z)---t :: IO [ThmResult]-t = sequence [-       f11 === f11-     , f12 === f12-     , f21 === f21-     , f22 === f22-     , f31 === f31-     , f32 === f32-     , f33 === f33-     ]
− Data/SBV/Examples/Basics/Index.hs 
@@ -1,69 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.Basics.Index--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Testing the select function--------------------------------------------------------------------------------module Data.SBV.Examples.Basics.Index where--import Data.SBV---- prove that the "select" primitive is working correctly-test1 :: Int -> IO Bool-test1 n = isTheorem $ do-            elts <- mkForallVars n-            err  <- forall_-            ind  <- forall_-            ind2 <- forall_-            let r1 = (select :: [SWord8] -> SWord8 -> SInt8 -> SWord8) elts err ind-                r2 = (select :: [SWord8] -> SWord8 -> SWord8 -> SWord8) elts err ind2-                r3 = slowSearch elts err ind-                r4 = slowSearch elts err ind2-            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))--test2 :: Int -> IO Bool-test2 n = isTheorem $ do-            elts1 <- mkForallVars n-            elts2 <- mkForallVars n-            let elts = zip elts1 elts2-            err1  <- forall_-            err2  <- forall_-            let err = (err1, err2)-            ind  <- forall_-            ind2 <- forall_-            let r1 = (select :: [(SWord8, SWord8)] -> (SWord8, SWord8) -> SInt8 -> (SWord8, SWord8)) elts err ind-                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- 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))--test3 :: Int -> IO Bool-test3 n = isTheorem $ do-            eltsI <- mkForallVars n-            let elts = map Left eltsI-            errI  <- forall_-            let err = Left errI-            ind  <- forall_-            let r1 = (select :: [Either SWord8 SWord8] -> Either SWord8 SWord8 -> SInt8 -> Either SWord8 SWord8) elts err ind-                r2 = slowSearch elts err ind-            return $ r1 .== r2- 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))--tests :: IO ()-tests = do mapM test1 [0..50] >>= print . and-           mapM test2 [0..50] >>= print . and-           mapM test3 [0..50] >>= print . and
− Data/SBV/Examples/Basics/ProofTests.hs 
@@ -1,48 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.Basics.ProofTests--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Basic proofs--------------------------------------------------------------------------------{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Data.SBV.Examples.Basics.ProofTests where--import Data.SBV--f1, f2, f3, f4 :: Num a => a -> a -> a-f1 x y = (x+y)*(x-y)-f2 x y = (x*x)-(y*y)-f3 x y = (x+y)*(x+y)-f4 x y = x*x + 2*x*y + y*y--f1eqf2 :: Predicate-f1eqf2 = forAll_ $ \x y -> f1 x y .== f2 x (y :: SWord8)--f1eqf3 :: Predicate-f1eqf3 = forAll ["x", "y"] $ \x y -> f1 x y .== f3 x (y :: SWord8)--f3eqf4 :: Predicate-f3eqf4 = forAll_ $ \x y -> f3 x y .== f4 x (y :: SWord8)--f1Single :: Predicate-f1Single = forAll_ $ \x -> f1 x x .== (0 :: SWord16)--queries :: IO ()-queries = do print =<< prove f1eqf2   -- QED-             print =<< prove f1eqf3   -- No-             print =<< prove f3eqf4   -- QED-             print =<< prove f1Single -- QED-             print =<< sat (do x <- exists "x"-                               y <- exists "y"-                               return $ f1 x y .== f2 x (y :: SWord8))  -- yes, any output OK-             print =<< sat (do x <- exists "x"-                               y <- exists "y"-                               return $ f1 x y .== f3 x (y:: SWord8))    -- yes, 0;0
− Data/SBV/Examples/Basics/QRem.hs 
@@ -1,26 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.Basics.QRem--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Testing the qrem (quote-rem) function--------------------------------------------------------------------------------module Data.SBV.Examples.Basics.QRem where--import Data.SBV---- check: if (a, b) = x `quotRem` y then x = y*a + b--- being careful about y = 0. When divisor is 0, then quotient is--- defined to be 0 and the remainder is the numerator-qrem :: (Num a, EqSymbolic a, BVDivisible a) => a -> a -> SBool-qrem x y = ite (y .== 0) ((0, x) .== (a, b)) (x .== y * a + b)-  where (a, b) = x `bvQuotRem` y--check :: IO ()-check = print =<< prove (qrem :: SWord8 -> SWord8 -> SBool)-         -- print =<< prove (qrem :: SWord16 -> SWord16 -> SBool)   -- takes too long!
Data/SBV/Examples/BitPrecise/Legato.hs view
@@ -301,3 +301,6 @@                 let (hi, lo) = runLegato (0, x) (1, y) 2 (initMachine (mkSFunArray (const 0)) (0, 0, 0, false, false))                 cgOutput "hi" hi                 cgOutput "lo" lo++{-# ANN legato "HLint: ignore Redundant $"        #-}+{-# ANN module "HLint: ignore Reduce duplication" #-}
Data/SBV/Examples/BitPrecise/PrefixSum.hs view
@@ -248,6 +248,7 @@ --   s16 :: SWord8 = s6 + s7 --   s17 :: SWord8 = s13 + s16 --   s18 :: SWord8 = s11 + s17+-- CONSTRAINTS -- OUTPUTS --   s0 --   s8@@ -259,8 +260,8 @@ --   s18 ladnerFischerTrace :: Int -> IO () ladnerFischerTrace n = gen >>= print-  where gen = runSymbolic $ do args :: [SWord8] <- mkForallVars n-                               mapM_ output $ lf (0, (+)) args+  where gen = runSymbolic True $ do args :: [SWord8] <- mkForallVars n+                                    mapM_ output $ lf (0, (+)) args  -- | Trace generator for the reference spec. It clearly demonstrates that the reference -- implementation fewer operations, but is not parallelizable at all:@@ -291,6 +292,7 @@ --   s12 :: SWord8 = s5 + s11 --   s13 :: SWord8 = s6 + s12 --   s14 :: SWord8 = s7 + s13+-- CONSTRAINTS -- OUTPUTS --   s0 --   s8@@ -303,5 +305,5 @@ -- scanlTrace :: Int -> IO () scanlTrace n = gen >>= print-  where gen = runSymbolic $ do args :: [SWord8] <- mkForallVars n-                               mapM_ output $ ps (0, (+)) args+  where gen = runSymbolic True $ do args :: [SWord8] <- mkForallVars n+                                    mapM_ output $ ps (0, (+)) args
− Data/SBV/Examples/CRC/CCITT.hs 
@@ -1,61 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.CRC.CCITT--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ CRC checks, hamming distance, etc.--------------------------------------------------------------------------------module Data.SBV.Examples.CRC.CCITT where--import Data.SBV---- We don't have native support for 48 bits in Data.SBV--- So, represent as 32 high-bits and 16 low-type SWord48 = (SWord32, SWord16)--extendData :: SWord48 -> SWord64-extendData (h, l) = h # l # 0--mkFrame :: SWord48 -> SWord64-mkFrame msg@(h, l) = h # l # crc_48_16 msg--crc_48_16 :: SWord48 -> SWord16-crc_48_16 msg = res-  where msg64, divisor :: SWord64-        msg64   = extendData msg-        divisor = polynomial [16, 12, 5, 0]-        crc64 = pMod msg64 divisor-        (_, res) = split (snd (split crc64))--diffCount :: SWord64 -> SWord64 -> SWord8-diffCount x y = count $ zipWith (.==) (blastLE x) (blastLE y)-  where count []     = 0-        count (b:bs) = let r = count bs in ite b r (1+r)---- 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-   where frameSent     = mkFrame sent-         frameReceived = mkFrame received---- How come we get way more than 168 (= 2*84) counter-examples for this? -hw4has84Inhabitants :: SWord48 -> SWord48 -> SBool-hw4has84Inhabitants sent received = fourBitError-   where frameSent     = mkFrame sent-         frameReceived = mkFrame received-         fourBitError  = diffCount frameSent frameReceived .== 4--hw4 :: IO ()-hw4 = do res <- allSat hw4has84Inhabitants-         cnt <- displayModels disp res-         putStrLn $ "Found: " ++ show cnt ++ " solution(s)."-   where disp :: Int -> (Bool, (Word32, Word16, Word32, Word16)) -> IO ()-         disp i (_, (sh, sl, rh, rl)) = do putStrLn $ "Solution #" ++ show i ++ ": "-                                           putStrLn $ "  Sent    : " ++ binS (mkFrame (literal sh, literal sl))-                                           putStrLn $ "  Received: " ++ binS (mkFrame (literal rh, literal rl))
− Data/SBV/Examples/CRC/CCITT_Unidir.hs 
@@ -1,59 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.CRC.CCITT_Unidir--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Similar to CCITT. It shows that the CCITT is still HD 3--- even if we consider only uni-directional errors--------------------------------------------------------------------------------module Data.SBV.Examples.CRC.CCITT_Unidir where--import Data.SBV---- We don't have native support for 48 bits in Data.SBV--- So, represent as 32 high-bits and 16 low-type SWord48 = (SWord32, SWord16)--extendData :: SWord48 -> SWord64-extendData (h, l) = h # l # 0--mkFrame :: SWord48 -> SWord64-mkFrame msg@(h, l) = h # l # crc_48_16 msg--crc_48_16 :: SWord48 -> SWord16-crc_48_16 msg = res-  where msg64, divisor :: SWord64-        msg64   = extendData msg-        divisor = polynomial [16, 12, 5, 0]-        crc64 = pMod msg64 divisor-        (_, res) = split (snd (split crc64))--diffCount :: [SBool] -> [SBool] -> SWord8-diffCount xs ys = count $ zipWith (.==) xs ys-  where count []     = 0-        count (b:bs) = let r = count bs in ite b r (1+r)---- 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--crcUniGood :: SWord8 -> SWord48 -> SWord48 -> SBool-crcUniGood hd sent received =-     sent ./= received ==> nonUnidir frameSent frameReceived ||| diffCount frameSent frameReceived .> hd-   where frameSent     = blastLE $ mkFrame sent-         frameReceived = blastLE $ mkFrame received---- Provable, i.e., HD is 3-ccitHDis3 :: IO ()-ccitHDis3 = print =<< prove (crcUniGood 3)---- False; i.e., HD doesn't go to 4 just because we only look at uni-directional errors-ccitHDis4 :: IO ()-ccitHDis4 = print =<< prove (crcUniGood 4)
− Data/SBV/Examples/CRC/GenPoly.hs 
@@ -1,74 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.CRC.GenPoly--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Finds good polynomials for CRC's--------------------------------------------------------------------------------module Data.SBV.Examples.CRC.GenPoly where--import Data.SBV---- We don't have native support for 48 bits in Data.SBV--- So, represent as 32 high-bits and 16 low-type SWord48 = (SWord32, SWord16)--extendData :: SWord48 -> SWord64-extendData (h, l) = h # l # 0--mkFrame :: SWord64 -> SWord48 -> SWord64-mkFrame poly msg@(h, l) = h # l # crc_48_16 msg poly--crc_48_16 :: SWord48 -> SWord64 -> SWord16-crc_48_16 msg poly = res-  where msg64 = extendData msg-        crc64 = pMod msg64 poly-        (_, res) = split (snd (split crc64))--diffCount :: SWord64 -> SWord64 -> SWord8-diffCount x y = count $ zipWith (.==) (blastLE x) (blastLE y)-  where count []     = 0-        count (b:bs) = let r = count bs in ite b r (1+r)--crcGood :: SWord8 -> SWord16 -> SWord48 -> SWord48 -> SBool-crcGood hd divisor sent received =-     sent ./= received ==> diffCount frameSent frameReceived .> hd-   where frameSent     = mkFrame poly sent-         frameReceived = mkFrame poly received-         poly          = mkPoly divisor--mkPoly :: SWord16 -> SWord64-mkPoly d = 0 # 1 # d---- how long do we wait for each poly.. (seconds)-waitFor :: Int-waitFor = 15--genPoly :: SWord8 -> IO ()-genPoly hd = do putStrLn $ "*** Looking for polynomials with HD = " ++ show hd-                (skipped, res) <- go 0 [] []-                putStrLn $ "*** Good polynomials with HD = " ++ show hd-                mapM_ (\(i, s) -> putStrLn (show i ++ ". " ++ showPoly (mkPoly s)))  (zip [(1::Integer)..] res)-                putStrLn $ "*** Skipped the followings, proof exceeded timeout value of " ++ show waitFor-                mapM_ (\(i, s) -> putStrLn (show i ++ ". " ++ showPoly (mkPoly s)))  (zip [(1::Integer)..] skipped)-                putStrLn "*** Done."-  where go :: SWord16 -> [SWord16] -> [SWord16] -> IO ([SWord16], [SWord16])-        go poly skip acc-         | poly == maxBound = return (skip, acc)-         | True             = do putStr $ "Testing " ++ showPoly  (mkPoly poly) ++ "... "-                                 thm <- isTheoremWithin waitFor $ crcGood hd poly-                                 case thm of-                                   Nothing    -> do putStrLn "Timeout, skipping.."-                                                    go (poly+1) (poly:skip) acc-                                   Just True  -> do putStrLn "Good!"-                                                    go (poly+1) skip (poly:acc)-                                   Just False -> do putStrLn "Bad!"-                                                    go (poly+1) skip acc--findHD3Polynomials :: IO ()-findHD3Polynomials = genPoly 3
− Data/SBV/Examples/CRC/Parity.hs 
@@ -1,36 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.CRC.Parity--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Parity check as CRC's--------------------------------------------------------------------------------module Data.SBV.Examples.CRC.Parity where--import Data.SBV--parity :: SWord64 -> SBool-parity x = bnot (isOdd cnt)-  where cnt :: SWord8-        cnt = count (blastLE x)--isOdd :: SWord8 -> SBool-isOdd x = lsb x .== true---- count the true bits-count :: [SBool] -> SWord8-count []     = 0-count (x:xs) = let c' = count xs in ite x (1+c') c'---- 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-  where cnt = count (zipWith (./=) (blastLE x) (blastLE y))-        px  = parity x-        py  = parity y
− Data/SBV/Examples/CRC/USB5.hs 
@@ -1,50 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.CRC.USB5--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ The USB5 CRC implementation--------------------------------------------------------------------------------module Data.SBV.Examples.CRC.USB5 where--import Data.SBV--newtype SWord11 = S11 SWord16--instance EqSymbolic SWord11 where-  S11 w .== S11 w' = w .== w'--mkSWord11 :: SWord16 -> SWord11-mkSWord11 w = S11 (w .&. 0x07FF)--extendData :: SWord11 -> SWord16-extendData (S11 w) = w `shiftL` 5--mkFrame :: SWord11 -> SWord16-mkFrame w = extendData w .|. crc_11_16 w---- crc returns 16 bits, but the first 11 are always 0-crc_11_16 :: SWord11 -> SWord16-crc_11_16 msg = crc16 .&. 0x1F -- just get the last 5 bits-  where divisor :: SWord16-        divisor = polynomial [5, 2, 0]-        crc16 = pMod (extendData msg) divisor--diffCount :: SWord16 -> SWord16 -> SWord8-diffCount x y = count $ zipWith (.==) (blastLE x) (blastLE y)-  where count []     = 0-        count (b:bs) = let r = count bs in ite b r (1+r)---- 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-   where sent     = mkSWord11 sent16-         received = mkSWord11 received16-         frameSent     = mkFrame sent-         frameReceived = mkFrame received
Data/SBV/Examples/CodeGeneration/Fibonacci.hs view
@@ -118,7 +118,7 @@ -- | Compute the fibonacci numbers statically at /code-generation/ time and -- put them in a table, accessed by the 'select' call.  fib2 :: SWord64 -> SWord64 -> SWord64-fib2 top n = select table 0 n+fib2 top = select table 0   where table = map (fib1 top) [0 .. top]  -- | Once we have 'fib2', we can generate the C code straightforwardly. Below
Data/SBV/Examples/CodeGeneration/PopulationCount.hs view
@@ -24,10 +24,10 @@ -- and add 1 to a running count. This is slow, as it requires 64 iterations, -- but is simple and easy to convince yourself that it is correct. For instance: ----- >>> popCount_Slow 0x0123456789ABCDEF+-- >>> popCountSlow 0x0123456789ABCDEF -- 32 :: SWord8-popCount_Slow :: SWord64 -> SWord8-popCount_Slow inp = go inp 0 0+popCountSlow :: SWord64 -> SWord8+popCountSlow inp = go inp 0 0   where go :: SWord64 -> Int -> SWord8 -> SWord8         go _ 64 c = c         go x i  c = go (x `shiftR` 1) (i+1) (ite (x .&. 1 .== 1) (c+1) c)@@ -50,14 +50,14 @@ -- value, from 0 to 255. Note that we do not \"hard-code\" the values, but -- merely use the slow version to compute them. pop8 :: [SWord8]-pop8 = map popCount_Slow [0 .. 255]+pop8 = map popCountSlow [0 .. 255]  ----------------------------------------------------------------------------- -- * Verification -----------------------------------------------------------------------------  {- $VerificationIntro-We prove that `popCount` and `popCount_Slow` are functionally equivalent.+We prove that `popCount` and `popCountSlow` are functionally equivalent. This is essential as we will automatically generate C code from `popCount`, and we would like to make sure that the fast version is correct with respect to the slower reference version.@@ -69,7 +69,7 @@ -- >>> prove fastPopCountIsCorrect -- Q.E.D. fastPopCountIsCorrect :: SWord64 -> SBool-fastPopCountIsCorrect x = popCount x .== popCount_Slow x+fastPopCountIsCorrect x = popCount x .== popCountSlow x  ----------------------------------------------------------------------------- -- * Code generation
Data/SBV/Examples/CodeGeneration/Uninterpreted.hs view
@@ -35,7 +35,7 @@         -- the Haskell code we'd like SBV to use when running inside Haskell or when         -- translated to SMTLib for verification purposes. This is good old Haskell         -- code, as one would typically write.-        hCode x y = select [x * literal (bit b) | b <- [0.. bitSize x - 1]] (literal 0) y+        hCode x = select [x * literal (bit b) | b <- [0.. bitSize x - 1]] (literal 0)  -- | Test function that uses shiftLeft defined above. When used as a normal Haskell function -- or in verification the definition is fully used, i.e., no uninterpretation happens. To wit,
Data/SBV/Examples/Crypto/AES.hs view
@@ -49,7 +49,7 @@ -- | Exponentiation by a constant in GF(2^8). The implementation uses the usual -- square-and-multiply trick to speed up the computation. gf28Pow :: GF28 -> Int -> GF28-gf28Pow n k = pow k+gf28Pow n = pow   where sq x  = x `gf28Mult` x         pow 0    = 1         pow i@@ -577,3 +577,6 @@ -- somewhat simplistically, so these numbers should be considered very rough estimates.) cgAES128Library :: IO () cgAES128Library = compileToCLib Nothing "aes128Lib" aes128LibComponents++{-# ANN aesRound    "HLint: ignore Use head" #-}+{-# ANN aesInvRound "HLint: ignore Use head" #-}
+ Data/SBV/Examples/Puzzles/Coins.hs view
@@ -0,0 +1,104 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.SBV.Examples.Puzzles.Coins+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Solves the following puzzle:+--+-- @+-- You and a friend pass by a standard coin operated vending machine and you decide to get a candy bar.+-- The price is US $0.95, but after checking your pockets you only have a dollar (US $1) and the machine+-- only takes coins. You turn to your friend and have this conversation:+--   you: Hey, do you have change for a dollar?+--   friend: Let's see. I have 6 US coins but, although they add up to a US $1.15, I can't break a dollar.+--   you: Huh? Can you make change for half a dollar?+--   friend: No.+--   you: How about a quarter?+--   friend: Nope, and before you ask I cant make change for a dime or nickel either.+--   you: Really? and these six coins are all US government coins currently in production? +--   friend: Yes.+--   you: Well can you just put your coins into the vending machine and buy me a candy bar, and I'll pay you back?+--   friend: Sorry, I would like to but I cant with the coins I have.+-- What coins are your friend holding?+-- @+--+-- To be fair, the problem has no solution /mathematically/. But there is a solution when one takes into account that+-- vending machines typically do not take the 50 cent coins!+--+-----------------------------------------------------------------------------++module Data.SBV.Examples.Puzzles.Coins where++import Data.SBV++-- | We will represent coins with 16-bit words (more than enough precision for coins).+type Coin = SWord16++-- | Create a coin. The argument Int argument just used for naming the coin. Note that+-- 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]+              return c++-- | Return all combinations of a sequence of values.+combinations :: [a] -> [[a]]+combinations coins = concat [combs i coins | i <- [1 .. length coins]]+  where combs 0 _      = [[]]+        combs _ []     = []+        combs k (x:xs) = map (x:) (combs (k-1) xs) ++ combs k xs++-- | Constraint 1: Cannot make change for a dollar.+c1 :: [Coin] -> SBool+c1 xs = sum xs ./= 100++-- | Constraint 2: Cannot make change for half a dollar.+c2 :: [Coin] -> SBool+c2 xs = sum xs ./= 50++-- | Constraint 3: Cannot make change for a quarter.+c3 :: [Coin] -> SBool+c3 xs = sum xs ./= 25++-- | Constraint 4: Cannot make change for a dime.+c4 :: [Coin] -> SBool+c4 xs = sum xs ./= 10++-- | Constraint 5: Cannot make change for a nickel+c5 :: [Coin] -> SBool+c5 xs = sum xs ./= 5++-- | Constraint 6: Cannot buy the candy either. Here's where we need to have the extra knowledge+-- that the vending machines do not take 50 cent coins.+c6 :: [Coin] -> SBool+c6 xs = sum (map val xs) ./= 95+   where val x = ite (x .== 50) 0 x++-- | Solve the puzzle. We have:+--+-- >>> puzzle+-- Satisfiable. Model:+--   c1 = 50 :: SWord16+--   c2 = 25 :: SWord16+--   c3 = 10 :: SWord16+--   c4 = 10 :: SWord16+--   c5 = 10 :: SWord16+--   c6 = 10 :: SWord16+--+-- i.e., your friend has 4 dimes, a quarter, and a half dollar.+puzzle :: IO SatResult+puzzle = sat $ do+        cs <- mapM mkCoin [1..6]+        -- Assert each of the constraints for all combinations that has+        -- at least two coins (to make change)+        mapM_ constrain [c s | s <- combinations cs, length s >= 2, c <- [c1, c2, c3, c4, c5, c6]]+        -- 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)+        -- assert that the sum must be 115 cents.+        return $ sum cs .== 115
Data/SBV/Examples/Puzzles/Counts.hs view
@@ -43,7 +43,7 @@                         (upd d1 (upd d2 (upd d3 cnts))))  -- three digits   where (r1, d1)   = n  `bvQuotRem` 10         (d3, d2)   = r1 `bvQuotRem` 10-        upd d vals = zipWith inc [0..] vals+        upd d = zipWith inc [0..]           where inc i c = ite (i .== d) (c+1) c  -- | Encoding of the puzzle. The solution is a sequence of 10 numbers@@ -82,3 +82,4 @@                      ++ ", of 8 is " ++ show (ns !! 8)                      ++ ", of 9 is " ++ show (ns !! 9)                      ++ "."+{-# ANN solve "HLint: ignore Use head" #-}
Data/SBV/Examples/Puzzles/MagicSquare.hs view
@@ -29,8 +29,7 @@  -- | Checks that all elements in a list are within bounds check :: Elem -> Elem -> [Elem] -> SBool-check low high grp = bAll rangeFine grp-  where rangeFine x = x .>= low &&& x .<= high+check low high = bAll $ \x -> x .>= low &&& x .<= high  -- | Get the diagonal of a square matrix diag :: [[a]] -> [a]
− Data/SBV/Examples/Puzzles/PowerSet.hs 
@@ -1,35 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.Puzzles.PowerSet--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Computes the powerset of a givenset--------------------------------------------------------------------------------module Data.SBV.Examples.Puzzles.PowerSet where--import Data.SBV--genPowerSet :: [SBool] -> SBool--- The following definition reveals an issue in Yices's model generation. The--- seemingly vacuous test of checking true-or-false is necessary--- so that Yices will return a satisfying assignment--- otherwise, it just skips the "unused" inputs..-genPowerSet = bAll isBool-  where isBool x = x .== true ||| x .== false--powerSet :: [Word8] -> IO ()-powerSet xs = do putStrLn $ "Finding all subsets of " ++ show xs-                 res <- allSat $ genPowerSet `fmap` mkExistVars n-                 cnt <- displayModels disp res-                 putStrLn $ "Found: " ++ show cnt ++ " subset(s)."-     where n = length xs-           disp i (_, ss)-            | length ss /= n = error $ "Expected " ++ show n ++ " results; got: " ++ show (length ss)-            | True           = putStrLn $ "Subset #" ++ show i ++ ": " ++ show (concat (zipWith pick ss xs))-           pick True a  = [a]-           pick False _ = []
− Data/SBV/Examples/Puzzles/Temperature.hs 
@@ -1,40 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.Puzzles.Temperature--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Puzzle:---   What 2 digit fahrenheit/celcius values are reverses of each other?---   Ignoring the fractions in the conversion--------------------------------------------------------------------------------module Data.SBV.Examples.Puzzles.Temperature where--import Data.SBV--type Temp = SWord16 -- larger than we need actually---- convert celcius to fahrenheit, rounding up/down properly--- we have to be careful here to make sure rounding is done properly..-d2f :: Temp -> Temp-d2f d = 32 + ite (fr .>= 5) (1+fi) fi-  where (fi, fr) = (18 * d) `bvQuotRem` 10---- puzzle: What 2 digit fahrenheit/celcius values are reverses of each other?-revOf :: Temp -> SBool-revOf c = swap (digits c) .== digits (d2f c)-  where digits x = x `bvQuotRem` 10-        swap (a, b) = (b, a)--solve :: IO ()-solve = do res <- allSat $ revOf `fmap` exists_-           cnt <- displayModels disp res-           putStrLn $ "Found " ++ show cnt ++ " solutions."-     where disp :: Int -> (Bool, Word16) -> IO ()-           disp _ (_, x) = putStrLn $ " " ++ show x ++ "C --> " ++ show (round f :: Integer) ++ "F (exact value: " ++ show f ++ "F)"-              where f :: Double-                    f  = 32 + (9 * fromIntegral x) / 5
− Data/SBV/Examples/Uninterpreted/Uninterpreted.hs 
@@ -1,30 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.Uninterpreted.Uninterpreted--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Testing uninterpreted functions--------------------------------------------------------------------------------module Data.SBV.Examples.Uninterpreted.Uninterpreted where--import Data.SBV--f :: SInt8 -> SWord32-f = uninterpret "f"--g :: SInt8 -> SWord16 -> SWord32-g = uninterpret "g"--p0 :: SInt8 -> SInt8 -> SBool-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--p2 :: SInt8 -> SWord16 -> SWord16 -> SBool-p2 x y z = y .== z ==> g x y .== f x    -- Not true
Data/SBV/Internals.hs view
@@ -14,27 +14,19 @@  module Data.SBV.Internals (    -- * Running symbolic programs /manually/-    Result, runSymbolic+    Result, SBVRunMode(..), runSymbolic, runSymbolic'     -- * Other internal structures useful for low-level programming   , SBV(..), HasSignAndSize(..), CW, mkConstCW, genFinVar, genFinVar_   -- * Compilation to C   , compileToC', compileToCLib', CgPgmBundle(..), CgPgmKind(..)     -- * Integrating with the test framework-    -- $testFramework-  , module Data.SBV.Utils.SBVTest   ) where -import Data.SBV.BitVectors.Data   (Result, runSymbolic, SBV(..), HasSignAndSize(..), CW, mkConstCW)+import Data.SBV.BitVectors.Data   (Result, SBVRunMode(..), runSymbolic, runSymbolic', SBV(..), HasSignAndSize(..), CW, mkConstCW) import Data.SBV.BitVectors.Model  (genFinVar, genFinVar_) import Data.SBV.Compilers.C       (compileToC', compileToCLib') import Data.SBV.Compilers.CodeGen (CgPgmBundle(..), CgPgmKind(..))-import Data.SBV.Utils.SBVTest  {- $compileC Lower level access to program bundles, for further processing of program bundles.--}--{- $testFramework-Functionality needed for extending SBV's internal test-suite. Only for developers of further libraries on-top of SBV. -}
Data/SBV/Provers/Prover.hs view
@@ -26,8 +26,9 @@        , prove, proveWith        , sat, satWith        , allSat, allSatWith-       , SatModel(..), getModel, displayModels-       , yices, z3+       , isVacuous, isVacuousWith+       , SatModel(..), Modelable(..), displayModels+       , yices, z3, defaultSMTCfg        , compileToSMTLib        ) where @@ -56,6 +57,10 @@ z3 :: SMTConfig z3 = yices { solver = Z3.z3, useSMTLib2 = True } +-- | The default solver used by SBV. This is currently set to yices.+defaultSMTCfg :: SMTConfig+defaultSMTCfg = yices+ -- | A predicate is a symbolic program that returns a (symbolic) boolean value. For all intents and -- purposes, it can be treated as an n-ary function from symbolic-values to a boolean. The 'Symbolic' -- monad captures the underlying representation, and can/should be ignored by the users of the library,@@ -69,7 +74,7 @@ -- 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 predicate, internally naming the inputs.+  -- | 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:   --@@ -88,14 +93,25 @@   -- 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+  -- | 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+  -- | Version of 'forSome' that allows user defined names+  forSome :: [String] -> a -> Predicate  instance Provable Predicate where-  forAll_  = id-  forAll _ = id+  forAll_    = id+  forAll []  = id+  forAll xs  = error $ "SBV.forAll: Extra unmapped name(s) in predicate construction: " ++ intercalate ", " xs+  forSome_   = id+  forSome [] = id+  forSome xs = error $ "SBV.forSome: Extra unmapped name(s) in predicate construction: " ++ intercalate ", " xs  instance Provable SBool where-  forAll_  = return-  forAll _ = return+  forAll_   = return+  forAll _  = return+  forSome_  = return+  forSome _ = return  {- -- The following works, but it lets us write properties that@@ -103,67 +119,92 @@ -- Running that will throw an exception since Haskell's equality -- is not be supported by symbolic things. (Needs .==). instance Provable Bool where-  forAll_  x = forAll_  (if x then true else false :: SBool)-  forAll s x = forAll s (if x then true else false :: SBool)+  forAll_  x  = forAll_   (if x then true else false :: SBool)+  forAll s x  = forAll s  (if x then true else false :: SBool)+  forSome_  x = forSome_  (if x then true else false :: SBool)+  forSome s x = forSome s (if x then true else false :: SBool) -}  -- Functions instance (SymWord a, Provable p) => Provable (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+  forAll_        k = forall_   >>= \a -> forAll_   $ k a+  forAll (s:ss)  k = forall s  >>= \a -> forAll ss $ k a+  forAll []      k = forAll_ k+  forSome_       k = exists_  >>= \a -> forSome_   $ k a+  forSome (s:ss) k = exists s >>= \a -> forSome ss $ k a+  forSome []     k = forSome_ k --- Arrays (memory)+-- Arrays (memory), only supported universally for the time being instance (HasSignAndSize a, HasSignAndSize b, SymArray array, Provable p) => Provable (array 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+  forSome_      _ = error "SBV.forSome: Existential arrays are not currently supported."+  forSome _     _ = error "SBV.forSome: Existential arrays are not currently supported."  -- 2 Tuple instance (SymWord a, SymWord b, Provable p) => Provable ((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+  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+  forSome_       k = exists_  >>= \a -> forSome_   $ \b -> k (a, b)+  forSome (s:ss) k = exists s >>= \a -> forSome ss $ \b -> k (a, b)+  forSome []     k = forSome_ k  -- 3 Tuple instance (SymWord a, SymWord b, SymWord c, Provable p) => Provable ((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+  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+  forSome_       k = exists_  >>= \a -> forSome_   $ \b c -> k (a, b, c)+  forSome (s:ss) k = exists s >>= \a -> forSome ss $ \b c -> k (a, b, c)+  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-  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+  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+  forSome_       k = exists_  >>= \a -> forSome_   $ \b c d -> k (a, b, c, d)+  forSome (s:ss) k = exists s >>= \a -> forSome ss $ \b c d -> k (a, b, c, d)+  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-  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+  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+  forSome_       k = exists_  >>= \a -> forSome_   $ \b c d e -> k (a, b, c, d, e)+  forSome (s:ss) k = exists s >>= \a -> forSome ss $ \b c d e -> k (a, b, c, d, e)+  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-  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+  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+  forSome_       k = exists_  >>= \a -> forSome_   $ \b c d e f -> k (a, b, c, d, e, f)+  forSome (s:ss) k = exists s >>= \a -> forSome ss $ \b c d e f -> k (a, b, c, d, e, f)+  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-  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+  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+  forSome_       k = exists_  >>= \a -> forSome_   $ \b c d e f g -> k (a, b, c, d, e, f, g)+  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 --- | Prove a predicate, equivalent to @'proveWith' 'yices'@+-- | Prove a predicate, equivalent to @'proveWith' 'defaultSMTCfg'@ prove :: Provable a => a -> IO ThmResult-prove = proveWith yices+prove = proveWith defaultSMTCfg --- | Find a satisfying assignment for a predicate, equivalent to @'satWith' 'yices'@+-- | Find a satisfying assignment for a predicate, equivalent to @'satWith' 'defaultSMTCfg'@ sat :: Provable a => a -> IO SatResult-sat = satWith yices+sat = satWith defaultSMTCfg --- | Return all satisfying assignments for a predicate, equivalent to @'allSatWith' 'yices'@.+-- | Return all satisfying assignments for a predicate, equivalent to @'allSatWith' 'defaultSMTCfg'@. -- Satisfying assignments are constructed lazily, so they will be available as returned by the solver -- and on demand. --@@ -172,8 +213,45 @@ -- 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. allSat :: Provable a => a -> IO AllSatResult-allSat = allSatWith yices+allSat = allSatWith defaultSMTCfg +-- | Check if the given constraints are satisfiable, equivalent to @'isVacuousWith' 'defaultSMTCfg'@. This+-- call can be used to ensure that the specified constraints (via 'constrain') are satisfiable, i.e., that+-- the proof involving these constraints is not passing vacuously. Here is an example. Consider the following+-- predicate:+--+-- >>> let pred = do { x <- forall "x"; constrain $ x .< x; return $ x .>= (5 :: SWord8) }+--+-- This predicate asserts that all 8-bit values are larger than 5, subject to the constraint that the+-- values considered satisfy @x .< x@, i.e., they are less than themselves. Since there are no values that+-- satisfy this constraint, the proof will pass vacuously:+--+-- >>> prove pred+-- Q.E.D.+--+-- We can use 'isVacuous' to make sure to see that the pass was vacuous:+--+-- >>> isVacuous pred+-- True+--+-- While the above example is trivial, things can get complicated if there are multiple constraints with+-- non-straightforward relations; so if constraints are used one should make sure to check the predicate+-- is not vacuously true. Here's an example that is not vacuous:+--+--  >>> let pred' = do { x <- forall "x"; constrain $ x .> 6; return $ x .>= (5 :: SWord8) }+--+-- This time the proof passes as expected:+--+--  >>> prove pred'+--  Q.E.D.+--+-- And the proof is not vacuous:+--+--  >>> isVacuous pred'+--  False+isVacuous :: Provable a => a -> IO Bool+isVacuous = isVacuousWith defaultSMTCfg+ -- Decision procedures (with optional timeout) checkTheorem :: Provable a => Maybe Int -> a -> IO (Maybe Bool) checkTheorem mbTo p = do r <- pr p@@ -182,7 +260,7 @@                            ThmResult (Satisfiable _ _) -> return $ Just False                            ThmResult (TimeOut _)       -> return Nothing                            _                           -> error $ "SBV.isTheorem: Received:\n" ++ show r-   where pr = maybe prove (\i -> proveWith (yices{timeOut = Just i})) mbTo+   where pr = maybe prove (\i -> proveWith (defaultSMTCfg{timeOut = Just i})) mbTo  checkSatisfiable :: Provable a => Maybe Int -> a -> IO (Maybe Bool) checkSatisfiable mbTo p = do r <- s p@@ -191,7 +269,7 @@                                SatResult (Unsatisfiable _) -> return $ Just False                                SatResult (TimeOut _)       -> return Nothing                                _                           -> error $ "SBV.isSatisfiable: Received: " ++ show r-   where s = maybe sat (\i -> satWith yices{timeOut = Just i}) mbTo+   where s = maybe sat (\i -> satWith defaultSMTCfg{timeOut = Just i}) mbTo  -- | Checks theoremhood within the given time limit of @i@ seconds. -- Returns @Nothing@ if times out, or the result wrapped in a @Just@ otherwise.@@ -229,7 +307,7 @@         t <- getClockTime         let comments = ["Created on " ++ show t]             cvt = if smtLib2 then toSMTLib2 else toSMTLib1-        (_, _, _, smtLibPgm) <- simulate cvt yices False comments a+        (_, _, _, smtLibPgm) <- simulate cvt defaultSMTCfg False comments a         return $ show smtLibPgm ++ "\n"  -- | Proves the predicate using the given SMT-solver@@ -242,6 +320,23 @@ satWith config a = simulate cvt config True [] a >>= callSolver True "Checking Satisfiability.." SatResult config   where cvt = if useSMTLib2 config then toSMTLib2 else toSMTLib1 +-- | Determine if the constraints are vacuous using the given SMT-solver+isVacuousWith :: Provable a => SMTConfig -> a -> IO Bool+isVacuousWith config a = do+        Result ub tr uic is cs ts as uis ax asgn cstr _ <- runSymbolic True $ forAll_ a >>= output+        case cstr of+           [] -> return False -- no constraints, no need to check+           _  -> do let is'  = [(EX, i) | (_, i) <- is] -- map all quantifiers to "exists" for the constraint check+                        res' = Result ub tr uic is' cs ts as uis ax asgn cstr [trueSW]+                        cvt  = if useSMTLib2 config then toSMTLib2 else toSMTLib1+                    SatResult result <- runProofOn cvt config True [] res' >>= callSolver True "Checking Satisfiability.." SatResult config+                    case result of+                      Unsatisfiable{} -> return True  -- constraints are unsatisfiable!+                      Satisfiable{}   -> return False -- constraints are satisfiable!+                      Unknown{}       -> error "SBV: isVacuous: Solver returned unknown!"+                      ProofError _ ls -> error $ "SBV: isVacuous: error encountered:\n" ++ unlines ls+                      TimeOut _       -> error "SBV: isVacuous: time-out."+ -- | Find all satisfying assignments using the given SMT-solver allSatWith :: Provable a => SMTConfig -> a -> IO AllSatResult allSatWith config p = do@@ -301,13 +396,18 @@         let msg = when (verbose config) . putStrLn . ("** " ++)             isTiming = timing config         msg "Starting symbolic simulation.."-        res <- timeIf isTiming "problem construction" $ runSymbolic $ forAll_ predicate >>= output+        res <- timeIf isTiming "problem construction" $ runSymbolic isSat $ forAll_ predicate >>= output         msg $ "Generated symbolic trace:\n" ++ show res         msg "Translating to SMT-Lib.."-        case res of-          Result hasInfPrec _codeSegs is consts tbls arrs uis axs pgm [o@(SW (False, Size (Just 1)) _)] ->-             timeIf isTiming "translation" $ do let uiMap     = catMaybes (map arrayUIKind arrs) ++ map unintFnUIKind uis-                                                    skolemMap = skolemize (if isSat then is else map flipQ is)+        runProofOn converter config isSat comments res++runProofOn :: SMTLibConverter -> SMTConfig -> Bool -> [String] -> Result -> IO ([(Quantifier, NamedSymVar)], [(String, UnintKind)], [Either SW (SW, [SW])], SMTLibPgm)+runProofOn converter config isSat comments res =+        let isTiming = timing config+        in case res of+             Result hasInfPrec _qcInfo _codeSegs is consts tbls arrs uis axs pgm cstrs [o@(SW (False, Size (Just 1)) _)] ->+               timeIf isTiming "translation" $ let uiMap     = catMaybes (map arrayUIKind arrs) ++ map unintFnUIKind uis+                                                   skolemMap = skolemize (if isSat then is else map flipQ is)                                                         where flipQ (ALL, x) = (EX, x)                                                               flipQ (EX, x)  = (ALL, x)                                                               skolemize :: [(Quantifier, NamedSymVar)] -> [Either SW (SW, [SW])]@@ -315,14 +415,14 @@                                                                 where go []                   (_,  sofar) = reverse sofar                                                                       go ((ALL, (v, _)):rest) (us, sofar) = go rest (v:us, Left v : sofar)                                                                       go ((EX,  (v, _)):rest) (us, sofar) = go rest (us,   Right (v, reverse us) : sofar)-                                                return (is, uiMap, skolemMap, converter hasInfPrec isSat comments is skolemMap consts tbls arrs uis axs pgm o)-          Result _hasInfPrec _codeSegs _is _consts _tbls _arrs _uis _axs _pgm os -> case length os of-                        0  -> error $ "Impossible happened, unexpected non-outputting result\n" ++ show res-                        1  -> error $ "Impossible happened, non-boolean output in " ++ show os-                                    ++ "\nDetected while generating the trace:\n" ++ show res-                        _  -> error $ "User error: Multiple output values detected: " ++ show os-                                    ++ "\nDetected while generating the trace:\n" ++ show res-                                    ++ "\n*** Check calls to \"output\", they are typically not needed!"+                                               in return (is, uiMap, skolemMap, converter hasInfPrec isSat comments is skolemMap consts tbls arrs uis axs pgm cstrs o)+             Result _hasInfPrec _qcInfo _codeSegs _is _consts _tbls _arrs _uis _axs _pgm _cstrs os -> case length os of+                           0  -> error $ "Impossible happened, unexpected non-outputting result\n" ++ show res+                           1  -> error $ "Impossible happened, non-boolean output in " ++ show os+                                       ++ "\nDetected while generating the trace:\n" ++ show res+                           _  -> error $ "User error: Multiple output values detected: " ++ show os+                                       ++ "\nDetected while generating the trace:\n" ++ show res+                                       ++ "\n*** Check calls to \"output\", they are typically not needed!"  -- | Equality as a proof method. Allows for -- very concise construction of equivalence proofs, which is very typical in
Data/SBV/Provers/SExpr.hs view
@@ -16,9 +16,9 @@ import Data.Char           (isDigit, ord) import Numeric             (readInt, readDec, readHex) -data SExpr = S_Con String-           | S_Num Integer-           | S_App [SExpr]+data SExpr = SCon String+           | SNum Integer+           | SApp [SExpr]  parseSExpr :: String -> Either String SExpr parseSExpr inp = do (sexp, []) <- parse inpToks@@ -33,7 +33,7 @@                      ++ "\n*** Input : <" ++ inp ++ ">"         parse []         = die "ran out of tokens"         parse ("(":toks) = do (f, r) <- parseApp toks []-                              return (S_App f, r)+                              return (SApp f, r)         parse (")":_)    = die "extra tokens after close paren"         parse [tok]      = do t <- pTok tok                               return (t, [])@@ -49,6 +49,6 @@         pTok ('#':'b':r)       = mkNum $ readInt 2 (`elem` "01") (\c -> ord c - ord '0') r         pTok ('#':'x':r)       = mkNum $ readHex r         pTok n | all isDigit n = mkNum $ readDec n-        pTok n                 = return $ S_Con n-        mkNum [(n, "")] = return $ S_Num n+        pTok n                 = return $ SCon n+        mkNum [(n, "")] = return $ SNum n         mkNum _         = die "cannot read number"
Data/SBV/Provers/Yices.hs view
@@ -77,8 +77,8 @@                                  matches -> error $  "SBV.Yices: Cannot uniquely identify value for "                                                   ++ 's':v ++ " in "  ++ show matches         isInput _       = Nothing-        extract (S_App [S_Con "=", S_Con v, S_Num i]) | Just (n, s, nm) <- isInput v = [(n, (nm, mkConstCW (hasSign s, sizeOf s) i))]-        extract (S_App [S_Con "=", S_Num i, S_Con v]) | Just (n, s, nm) <- isInput v = [(n, (nm, mkConstCW (hasSign s, sizeOf s) i))]+        extract (SApp [SCon "=", SCon v, SNum i]) | Just (n, s, nm) <- isInput v = [(n, (nm, mkConstCW (hasSign s, sizeOf s) i))]+        extract (SApp [SCon "=", SNum i, SCon v]) | Just (n, s, nm) <- isInput v = [(n, (nm, mkConstCW (hasSign s, sizeOf s) i))]         extract _                                                                    = []  extractUnints :: [(String, UnintKind)] -> [String] -> [(UnintKind, [String])]@@ -109,20 +109,20 @@   = getDefaultVal knd (dropWhile (/= ' ') s)   | True   = case parseSExpr s of-       Right (S_App [S_Con "=", S_App (S_Con _ : args), S_Num i]) -> getCallVal knd args i-       Right (S_App [S_Con "=", S_Con _, S_Num i])                -> getCallVal knd []   i+       Right (SApp [SCon "=", SApp (SCon _ : args), SNum i]) -> getCallVal knd args i+       Right (SApp [SCon "=", SCon _, SNum i])                -> getCallVal knd []   i        _ -> Nothing  getDefaultVal :: UnintKind -> String -> Maybe (String, [String], String) getDefaultVal knd n = case parseSExpr n of-                        Right (S_Num i) -> Just $ showDefault knd (show i)+                        Right (SNum i) -> Just $ showDefault knd (show i)                         _               -> Nothing  getCallVal :: UnintKind -> [SExpr] -> Integer -> Maybe (String, [String], String) getCallVal knd args res = mapM getArg args >>= \as -> return (showCall knd as (show res))  getArg :: SExpr -> Maybe String-getArg (S_Num i) = Just (show i)+getArg (SNum i) = Just (show i) getArg _         = Nothing  showDefault :: UnintKind -> String -> (String, [String], String)
Data/SBV/Provers/Z3.hs view
@@ -14,7 +14,7 @@  module Data.SBV.Provers.Z3(z3) where -import Data.Char          (isDigit)+import Data.Char          (isDigit, toLower) import Data.List          (sortBy, intercalate, isPrefixOf) import System.Environment (getEnv) import qualified System.Info as S(os)@@ -24,6 +24,13 @@ import Data.SBV.SMT.SMT import Data.SBV.SMT.SMTLib +-- Choose the correct prefix character for passing options+-- TBD: Is there a more foolproof way of determining this?+optionPrefix :: Char+optionPrefix+  | map toLower S.os `elem` ["linux", "darwin"] = '-'+  | True                                        = '/'   -- windows+ -- | The description of the Z3 SMT solver -- The default executable is @\"z3\"@, which must be in your path. You can use the @SBV_Z3@ environment variable to point to the executable on your system. -- The default options are @\"\/in \/smt2\"@, which is valid for Z3 3.2. You can use the @SBV_Z3_OPTIONS@ environment variable to override the options.@@ -31,7 +38,7 @@ z3 = SMTSolver {            name       = "z3"          , executable = "z3"-         , options    = if S.os == "linux" then ["-in", "-smt2"] else ["/in", "/smt2"]+         , options    = map (optionPrefix:) ["in", "smt2"]          , engine     = \cfg isSat qinps modelMap skolemMap pgm -> do                                 execName <-               getEnv "SBV_Z3"          `catch` (\_ -> return (executable (solver cfg)))                                 execOpts <- (words `fmap` getEnv "SBV_Z3_OPTIONS") `catch` (\_ -> return (options (solver cfg)))@@ -92,8 +99,8 @@                                  matches -> error $  "SBV.SMTLib2: Cannot uniquely identify value for "                                                   ++ 's':v ++ " in "  ++ show matches         isInput _       = Nothing-        extract (S_App [S_App [S_Con v, S_Num i]])+        extract (SApp [SApp [SCon v, SNum i]])                 | Just (n, s, nm) <- isInput v = [(n, (nm, mkConstCW (hasSign s, sizeOf s) i))]-        extract (S_App [S_App [S_Con v, S_App [S_Con "-", S_Num i]]])+        extract (SApp [SApp [SCon v, SApp [SCon "-", SNum i]]])                 | Just (n, s, nm) <- isInput v = [(n, (nm, mkConstCW (hasSign s, sizeOf s) (-i)))]         extract _                              = []
Data/SBV/SMT/SMT.hs view
@@ -159,6 +159,10 @@   | hasSign x == signed && sizeOf x == size = Just (fromIntegral (cwVal x),r) genParse _ _ = Nothing +-- base case, that comes in handy if there are no real variables+instance SatModel () where+  parseCWs xs = return ((), xs)+ instance SatModel Bool where   parseCWs xs = do (x,r) <- genParse (False, Size (Just 1)) xs                    return ((x :: Integer) /= 0, r)@@ -230,17 +234,40 @@                    ((b, c, d, e, f, g), hs) <- parseCWs bs                    return ((a, b, c, d, e, f, g), hs) --- | Given an 'SMTResult', extract an arbitrarily typed model from it, given a 'SatModel' instance--- The first argument is "True" if this is an alleged model-getModel :: SatModel a => SatResult -> Either String (Bool, a)-getModel (SatResult (Unsatisfiable _)) = Left "SBV.getModel: Unsatisfiable result"-getModel (SatResult (Unknown _ m))     = Right (True, extractModel m)-getModel (SatResult (ProofError _ s))  = error $ unlines $ "Backend solver complains: " : s-getModel (SatResult (TimeOut _))       = Left "Timeout"-getModel (SatResult (Satisfiable _ m)) = Right (False, extractModel m)+-- | Various SMT results that we can extract models out of.+class Modelable a where+  -- | Is there a model?+  modelExists :: a -> Bool+  -- | 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.)+  getModel :: SatModel b => a -> Either String (Bool, b) -extractModel :: SatModel a => SMTModel -> a-extractModel m = case parseCWs [c | (_, c) <- modelAssocs m] of+  -- | A simpler variant of 'getModel' to get a model out without the fuss.+  extractModel :: SatModel b => a -> Maybe b+  extractModel a = case getModel a of+                     Right (_, b) -> Just b+                     _            -> Nothing++instance Modelable ThmResult where+  getModel    (ThmResult r) = getModel r+  modelExists (ThmResult r) = modelExists r++instance Modelable SatResult where+  getModel    (SatResult r) = getModel r+  modelExists (SatResult r) = modelExists r++instance Modelable SMTResult where+  getModel (Unsatisfiable _) = Left "SBV.getModel: Unsatisfiable result"+  getModel (Unknown _ m)     = Right (True, parseModelOut m)+  getModel (ProofError _ s)  = error $ unlines $ "Backend solver complains: " : s+  getModel (TimeOut _)       = Left "Timeout"+  getModel (Satisfiable _ m) = Right (False, parseModelOut m)+  modelExists (Satisfiable{}) = True+  modelExists (Unknown{})     = False -- don't risk it+  modelExists _               = False++parseModelOut :: SatModel a => SMTModel -> a+parseModelOut m = case parseCWs [c | (_, c) <- modelAssocs m] of                    Just (x, []) -> x                    Just (_, ys) -> error $ "SBV.getModel: Partially constructed model; remaining elements: " ++ show ys                    Nothing      -> error $ "SBV.getModel: Cannot construct a model from: " ++ show m@@ -274,7 +301,7 @@         arrs      = modelArrays m  shCW :: SMTConfig -> CW -> String-shCW cfg v = sh (printBase cfg) v+shCW = sh . printBase   where sh 2  = binS         sh 10 = show         sh 16 = hexS
Data/SBV/SMT/SMTLib.hs view
@@ -28,15 +28,16 @@                      -> [(String, SBVType)]                         -- ^ uninterpreted functions/constants                      -> [(String, [String])]                        -- ^ user given axioms                      -> Pgm                                         -- ^ assignments+                     -> [SW]                                        -- ^ extra constraints                      -> SW                                          -- ^ output variable                      -> SMTLibPgm  toSMTLib1, toSMTLib2 :: SMTLibConverter (toSMTLib1, toSMTLib2) = (cvt SMTLib1, cvt SMTLib2)-  where cvt v hasInfPrec isSat comments qinps skolemMap consts tbls arrs uis axs asgnsSeq out = SMTLibPgm v (aliasTable, pre, post)+  where cvt v hasInfPrec isSat comments qinps skolemMap consts tbls arrs uis axs asgnsSeq cstrs out = SMTLibPgm v (aliasTable, pre, post)          where aliasTable  = map (\(_, (x, y)) -> (y, x)) qinps                converter   = if v == SMTLib1 then SMT1.cvt else SMT2.cvt-               (pre, post) = converter hasInfPrec isSat comments qinps skolemMap consts tbls arrs uis axs asgnsSeq out+               (pre, post) = converter hasInfPrec isSat comments qinps skolemMap consts tbls arrs uis axs asgnsSeq cstrs out  addNonEqConstraints :: [(Quantifier, NamedSymVar)] -> [[(String, CW)]] -> SMTLibPgm -> Maybe String addNonEqConstraints _qinps cs p@(SMTLibPgm SMTLib1 _) = SMT1.addNonEqConstraints cs p
Data/SBV/SMT/SMTLib1.hs view
@@ -50,9 +50,10 @@     -> [(String, SBVType)]                         -- ^ uninterpreted functions/constants     -> [(String, [String])]                        -- ^ user given axioms     -> Pgm                                         -- ^ assignments+    -> [SW]                                        -- ^ extra constraints     -> SW                                          -- ^ output variable     -> ([String], [String])-cvt hasInf isSat comments qinps _skolemInps consts tbls arrs uis axs asgnsSeq out+cvt hasInf isSat comments qinps _skolemInps consts tbls arrs uis axs asgnsSeq cstrs out   | hasInf   = error "SBV: The chosen solver does not support infinite precision values. (Use z3 instead.)"   | not ((isSat && allExistential) || (not isSat && allUniversal))@@ -89,10 +90,13 @@               ++ map declAx axs               ++ [ " ; --- assignments ---" ]               ++ map cvtAsgn asgns-        post =    [ " ; --- formula ---" ]+        post =    [ " ; --- constraints ---" ]+               ++ map mkCstr cstrs+               ++ [ " ; --- formula ---" ]                ++ [mkFormula isSat out]                ++ [")"]         asgns = F.toList asgnsSeq+        mkCstr s = ":assumption (= " ++ show s ++ " bv1[1])"  -- TODO: Does this work for SMT-Lib when the index/element types are signed? -- Currently we ignore the signedness of the arguments, as there appears to be no way@@ -206,19 +210,20 @@   = error $ "SBV.SMT.SMTLib1.cvtExp: impossible happened; can't translate: " ++ show inp   where lift2  o _ [x, y] = "(" ++ o ++ " " ++ x ++ " " ++ y ++ ")"         lift2  o _ sbvs   = error $ "SBV.SMTLib1.cvtExp.lift2: Unexpected arguments: "   ++ show (o, sbvs)-        lift2B oU oS sgn sbvs+        lift2B oU oS sgn sbvs = "(ite " ++ lift2S oU oS sgn sbvs ++ " bv1[1] bv0[1])"+        lift2S oU oS sgn sbvs           | sgn-          = "(ite " ++ lift2 oS sgn sbvs ++ " bv1[1] bv0[1])"+          = lift2 oS sgn sbvs           | True-          = "(ite " ++ lift2 oU sgn sbvs ++ " bv1[1] bv0[1])"+          = lift2 oU sgn sbvs         lift2N o sgn sbvs = "(bvnot " ++ lift2 o sgn sbvs ++ ")"         lift1  o _ [x]    = "(" ++ o ++ " " ++ x ++ ")"         lift1  o _ sbvs   = error $ "SBV.SMT.SMTLib1.cvtExp.lift1: Unexpected arguments: "   ++ show (o, sbvs)         smtOpTable = [ (Plus,          lift2   "bvadd")                      , (Minus,         lift2   "bvsub")                      , (Times,         lift2   "bvmul")-                     , (Quot,          lift2   "bvudiv")-                     , (Rem,           lift2   "bvurem")+                     , (Quot,          lift2S  "bvudiv" "bvsdiv")+                     , (Rem,           lift2S  "bvurem" "bvsrem")                      , (Equal,         lift2   "bvcomp")                      , (NotEqual,      lift2N  "bvcomp")                      , (LessThan,      lift2B  "bvult" "bvslt")
Data/SBV/SMT/SMTLib2.hs view
@@ -13,6 +13,7 @@  module Data.SBV.SMT.SMTLib2(cvt, addNonEqConstraints) where +import Data.Bits (bit) import qualified Data.Foldable as F (toList) import qualified Data.Map      as M import qualified Data.IntMap   as IM@@ -64,9 +65,10 @@     -> [(String, SBVType)]                         -- ^ uninterpreted functions/constants     -> [(String, [String])]                        -- ^ user given axioms     -> Pgm                                         -- ^ assignments+    -> [SW]                                        -- ^ extra constraints     -> SW                                          -- ^ output variable     -> ([String], [String])-cvt hasInf isSat comments _inps skolemInps consts tbls arrs uis axs asgnsSeq out = (pre, [])+cvt hasInf isSat comments _inps skolemInps consts tbls arrs uis axs asgnsSeq cstrs out = (pre, [])   where -- the logic is an over-approaximation         logic           | hasInf = ["; Has unbounded Integers; no logic specified."]   -- combination, let the solver pick@@ -118,8 +120,14 @@           | null delayedEqualities = s           | True                   = "     " ++ s         align n s = replicate n ' ' ++ s-        assertOut | isSat = "(= " ++ show out ++ " #b1)"-                  | True  = "(= " ++ show out ++ " #b0)"+        -- if sat,   we assert cstrs /\ out+        -- if prove, we assert ~(cstrs => out) = cstrs /\ not out+        assertOut+           | null cstrs = o+           | True       = "(and " ++ unwords (map mkConj cstrs ++ [o]) ++ ")"+           where mkConj x = "(= " ++ cvtSW skolemMap x ++ " #b1)"+                 o | isSat =            mkConj out+                   | True  = "(not " ++ mkConj out ++ ")"         skolemMap = M.fromList [(s, ss) | Right (s, ss) <- skolemInps, not (null ss)]         tableMap  = IM.fromList $ map mkConstTable constTables ++ map mkSkTable skolemTables           where mkConstTable (((t, _, _), _), _) = (t, "table" ++ show t)@@ -261,15 +269,15 @@         ensureBV       = not hasInfPrecArgs || unbounded expr         lift2  o _ [x, y] = "(" ++ o ++ " " ++ x ++ " " ++ y ++ ")"         lift2  o _ sbvs   = error $ "SBV.SMTLib2.sh.lift2: Unexpected arguments: "   ++ show (o, sbvs)-        lift2B oU oS sgn sbvs+        lift2B oU oS sgn sbvs = "(ite " ++ lift2S oU oS sgn sbvs ++ " #b1 #b0)"+        lift2S oU oS sgn sbvs           | sgn-          = "(ite " ++ lift2 oS sgn sbvs ++ " #b1 #b0)"+          = lift2 oS sgn sbvs           | True-          = "(ite " ++ lift2 oU sgn sbvs ++ " #b1 #b0)"+          = lift2 oU sgn sbvs         lift2N o sgn sbvs = "(bvnot " ++ lift2 o sgn sbvs ++ ")"         lift1  o _ [x]    = "(" ++ o ++ " " ++ x ++ ")"         lift1  o _ sbvs   = error $ "SBV.SMT.SMTLib2.sh.lift1: Unexpected arguments: "   ++ show (o, sbvs)-        -- Group 1: Same translation, regardless BV/Int         sh (SBVApp Ite [a, b, c]) = "(ite (= #b1 " ++ ssw a ++ ") " ++ ssw b ++ " " ++ ssw c ++ ")"         sh (SBVApp (LkUp (t, (_, atSz), _, l) i e) [])           | needsCheck = "(ite " ++ cond ++ ssw e ++ " " ++ lkUp ++ ")"@@ -289,16 +297,28 @@         sh (SBVApp (ArrRead i) [a]) = "(select array_" ++ show i ++ " " ++ ssw a ++ ")"         sh (SBVApp (Uninterpreted nm) [])   = "uninterpreted_" ++ nm         sh (SBVApp (Uninterpreted nm) args) = "(uninterpreted_" ++ nm ++ " " ++ unwords (map ssw args) ++ ")"-        -- Group 2: Only supported for BV-        sh (SBVApp (Rol i) [a])       | ensureBV = rot  ssw "rotate_left"  i a-        sh (SBVApp (Ror i) [a])       | ensureBV = rot  ssw "rotate_right" i a-        sh (SBVApp (Shl i) [a])       | ensureBV = shft ssw "bvshl"  "bvshl"  i a-        sh (SBVApp (Shr i) [a])       | ensureBV = shft ssw "bvlshr" "bvashr" i a         sh (SBVApp (Extract i j) [a]) | ensureBV = "((_ extract " ++ show i ++ " " ++ show j ++ ") " ++ ssw a ++ ")"+        sh (SBVApp (Rol i) [a])+           | not hasInfPrecArgs = rot  ssw "rotate_left"  i a+           | True               = sh (SBVApp (Shl i) [a])     -- Haskell treats rotateL as shiftL for unbounded values+        sh (SBVApp (Ror i) [a])+           | not hasInfPrecArgs = rot  ssw "rotate_right" i a+           | True               = sh (SBVApp (Shr i) [a])     -- Haskell treats rotateR as shiftR for unbounded values+        sh (SBVApp (Shl i) [a])+           | not hasInfPrecArgs = shft ssw "bvshl"  "bvshl"  i a+           | i < 0              = sh (SBVApp (Shr (-i)) [a])  -- flip sign/direction+           | True               = "(* " ++ ssw a ++ " " ++ show (bit i :: Integer) ++ ")"  -- Implement shiftL by multiplication by 2^i+        sh (SBVApp (Shr i) [a])+           | not hasInfPrecArgs = shft ssw "bvlshr" "bvashr" i a+           | i < 0              = sh (SBVApp (Shl (-i)) [a])  -- flip sign/direction+           | True               = "(div " ++ ssw a ++ " " ++ show (bit i :: Integer) ++ ")"  -- Implement shiftR by division by 2^i         sh (SBVApp op args)           | Just f <- lookup op smtBVOpTable, ensureBV           = f (any hasSign args) (map ssw args)-          where smtBVOpTable = [ (And,  lift2 "bvand")+          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.+                smtBVOpTable = [ (And,  lift2 "bvand")                                , (Or,   lift2 "bvor")                                , (XOr,  lift2 "bvxor")                                , (Not,  lift1 "bvnot")@@ -316,8 +336,8 @@           where smtOpBVTable  = [ (Plus,          lift2   "bvadd")                                 , (Minus,         lift2   "bvsub")                                 , (Times,         lift2   "bvmul")-                                , (Quot,          lift2   "bvudiv")-                                , (Rem,           lift2   "bvurem")+                                , (Quot,          lift2S  "bvudiv" "bvsdiv")+                                , (Rem,           lift2S  "bvurem" "bvsrem")                                 , (Equal,         lift2   "bvcomp")                                 , (NotEqual,      lift2N  "bvcomp")                                 , (LessThan,      lift2B  "bvult" "bvslt")
− Data/SBV/TestSuite/Arrays/Memory.hs 
@@ -1,26 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Arrays.Memory--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Arrays.Memory--------------------------------------------------------------------------------module Data.SBV.TestSuite.Arrays.Memory(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Arrays.Memory---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-     "memory-raw"           ~: assert       =<< isTheorem raw-   , "memory-waw"           ~: assert       =<< isTheorem waw-   , "memory-wcommute-bad"  ~: assert . not =<< isTheorem wcommutesBad-   , "memory-wcommute-good" ~: assert       =<< isTheorem wcommutesGood-   ]
− Data/SBV/TestSuite/Basics/Arithmetic.hs 
@@ -1,178 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Basics.Arithmetic--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for basic concrete arithmetic--------------------------------------------------------------------------------{-# LANGUAGE Rank2Types #-}--module Data.SBV.TestSuite.Basics.Arithmetic(testSuite) where--import Data.SBV-import Data.SBV.Internals---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test $-        genBinTest "+"                (+)-     ++ genBinTest "-"                (-)-     ++ genBinTest "*"                (*)-     ++ genUnTest  "negate"           negate-     ++ genUnTest  "abs"              abs-     ++ genUnTest  "signum"           signum-     ++ genBinTest ".&."              (.&.)-     ++ genBinTest ".|."              (.|.)-     ++ genBinTest "xor"              xor-     ++ genUnTest  "complement"       complement-     ++ genIntTest "shift"            shift-     ++ genIntTest "rotate"           rotate-     ++ genIntTest "setBit"           setBit-     ++ genIntTest "clearBit"         clearBit-     ++ genIntTest "complementBit"    complementBit-     ++ genIntTest "shiftL"           shiftL-     ++ genIntTest "shiftR"           shiftR-     ++ genIntTest "rotateL"          rotateL-     ++ genIntTest "rotateR"          rotateR-     ++ genBlasts-     ++ genCasts--genBinTest :: String -> (forall a. Bits a => a -> a -> a) -> [Test]-genBinTest nm op = map mkTest $-        zipWith pair [(show x, show y, x `op` y) | x <- w8s,  y <- w8s ] [x `op` y | x <- sw8s,  y <- sw8s]-     ++ zipWith pair [(show x, show y, x `op` y) | x <- w16s, y <- w16s] [x `op` y | x <- sw16s, y <- sw16s]-     ++ zipWith pair [(show x, show y, x `op` y) | x <- w32s, y <- w32s] [x `op` y | x <- sw32s, y <- sw32s]-     ++ zipWith pair [(show x, show y, x `op` y) | x <- w64s, y <- w64s] [x `op` y | x <- sw64s, y <- sw64s]-     ++ zipWith pair [(show x, show y, x `op` y) | x <- i8s,  y <- i8s ] [x `op` y | x <- si8s,  y <- si8s]-     ++ zipWith pair [(show x, show y, x `op` y) | x <- i16s, y <- i16s] [x `op` y | x <- si16s, y <- si16s]-     ++ zipWith pair [(show x, show y, x `op` y) | x <- i32s, y <- i32s] [x `op` y | x <- si32s, y <- si32s]-     ++ zipWith pair [(show x, show y, x `op` y) | x <- i64s, y <- i64s] [x `op` y | x <- si64s, y <- si64s]-  where pair (x, y, a) b   = (x, y, show (fromIntegral a `asTypeOf` b) == show b)-        mkTest (x, y, s) = "arithmetic-" ++ nm ++ "." ++ x ++ "_" ++ y  ~: s `showsAs` "True"--genUnTest :: String -> (forall a. Bits a => a -> a) -> [Test]-genUnTest nm op = map mkTest $-        zipWith pair [(show x, op x) | x <- w8s ] [op x | x <- sw8s ]-     ++ zipWith pair [(show x, op x) | x <- w16s] [op x | x <- sw16s]-     ++ zipWith pair [(show x, op x) | x <- w32s] [op x | x <- sw32s]-     ++ zipWith pair [(show x, op x) | x <- w64s] [op x | x <- sw64s]-     ++ zipWith pair [(show x, op x) | x <- i8s ] [op x | x <- si8s ]-     ++ zipWith pair [(show x, op x) | x <- i16s] [op x | x <- si16s]-     ++ zipWith pair [(show x, op x) | x <- i32s] [op x | x <- si32s]-     ++ zipWith pair [(show x, op x) | x <- i64s] [op x | x <- si64s]-  where pair (x, a) b   = (x, show (fromIntegral a `asTypeOf` b) == show b)-        mkTest (x, s) = "arithmetic-" ++ nm ++ "." ++ x ~: s `showsAs` "True"--genIntTest :: String -> (forall a. Bits a => a -> Int -> a) -> [Test]-genIntTest nm op = map mkTest $-        zipWith pair [("u8",  show x, show y, x `op` y) | x <- w8s,  y <- is] [x `op` y | x <- sw8s,  y <- is]-     ++ zipWith pair [("u16", show x, show y, x `op` y) | x <- w16s, y <- is] [x `op` y | x <- sw16s, y <- is]-     ++ zipWith pair [("u32", show x, show y, x `op` y) | x <- w32s, y <- is] [x `op` y | x <- sw32s, y <- is]-     ++ zipWith pair [("u64", show x, show y, x `op` y) | x <- w64s, y <- is] [x `op` y | x <- sw64s, y <- is]-     ++ zipWith pair [("s8",  show x, show y, x `op` y) | x <- i8s,  y <- is] [x `op` y | x <- si8s,  y <- is]-     ++ zipWith pair [("s16", show x, show y, x `op` y) | x <- i16s, y <- is] [x `op` y | x <- si16s, y <- is]-     ++ zipWith pair [("s32", show x, show y, x `op` y) | x <- i32s, y <- is] [x `op` y | x <- si32s, y <- is]-     ++ zipWith pair [("s64", show x, show y, x `op` y) | x <- i64s, y <- is] [x `op` y | x <- si64s, y <- is]-  where pair (t, x, y, a) b       = (t, x, y, show a, show b, show (fromIntegral a `asTypeOf` b) == show b)-        mkTest (t, x, y, a, b, s) = "arithmetic-" ++ nm ++ "." ++ t ++ "_" ++ x ++ "_" ++ y ++ "_" ++ a ++ "_" ++ b ~: s `showsAs` "True"-        is = [-10 .. 10]--genBlasts :: [Test]-genBlasts = map mkTest $-             [(show x, fromBitsLE (blastLE x) .== x) | x <- sw8s ]-          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- sw8s ]-          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- si8s ]-          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- si8s ]-          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- sw16s]-          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- sw16s]-          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- si16s]-          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- si16s]-          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- sw32s]-          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- sw32s]-          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- si32s]-          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- si32s]-          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- sw64s]-          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- sw64s]-          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- si64s]-          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- si64s]-  where mkTest (x, r) = "blast-" ++ show x ~: r `showsAs` "True"--genCasts :: [Test]-genCasts = map mkTest $-            [(show x, unsignCast (signCast x) .== x) | x <- sw8s ]-         ++ [(show x, unsignCast (signCast x) .== x) | x <- sw16s]-         ++ [(show x, unsignCast (signCast x) .== x) | x <- sw32s]-         ++ [(show x, unsignCast (signCast x) .== x) | x <- sw64s]-         ++ [(show x, signCast (unsignCast x) .== x) | x <- si8s ]-         ++ [(show x, signCast (unsignCast x) .== x) | x <- si16s]-         ++ [(show x, signCast (unsignCast x) .== x) | x <- si8s ]-         ++ [(show x, signCast (unsignCast x) .== x) | x <- si16s]-         ++ [(show x, signCast (unsignCast x) .== x) | x <- si32s]-         ++ [(show x, signCast (unsignCast x) .== x) | x <- si64s]-         ++ [(show x, signCast x .== fromBitsLE (blastLE x))   | x <- sw8s ]-         ++ [(show x, signCast x .== fromBitsLE (blastLE x))   | x <- sw16s]-         ++ [(show x, signCast x .== fromBitsLE (blastLE x))   | x <- sw32s]-         ++ [(show x, signCast x .== fromBitsLE (blastLE x))   | x <- sw64s]-         ++ [(show x, unsignCast x .== fromBitsLE (blastLE x)) | x <- si8s ]-         ++ [(show x, unsignCast x .== fromBitsLE (blastLE x)) | x <- si16s]-         ++ [(show x, unsignCast x .== fromBitsLE (blastLE x)) | x <- si32s]-         ++ [(show x, unsignCast x .== fromBitsLE (blastLE x)) | x <- si64s]-  where mkTest (x, r) = "cast-" ++ show x ~: r `showsAs` "True"---- Concrete test data-xsSigned, xsUnsigned :: (Num a, Enum a, Bounded a) => [a]-xsUnsigned = take 5 (iterate (1+) minBound) ++ take 5 (iterate (\x -> x-1) maxBound)-xsSigned   = xsUnsigned ++ [-5 .. 5]--w8s :: [Word8]-w8s = xsUnsigned--sw8s :: [SWord8]-sw8s = xsUnsigned--w16s :: [Word16]-w16s = xsUnsigned--sw16s :: [SWord16]-sw16s = xsUnsigned--w32s :: [Word32]-w32s = xsUnsigned--sw32s :: [SWord32]-sw32s = xsUnsigned--w64s :: [Word64]-w64s = xsUnsigned--sw64s :: [SWord64]-sw64s = xsUnsigned--i8s :: [Int8]-i8s = xsSigned--si8s :: [SInt8]-si8s = xsSigned--i16s :: [Int16]-i16s = xsSigned--si16s :: [SInt16]-si16s = xsSigned--i32s :: [Int32]-i32s = xsSigned--si32s :: [SInt32]-si32s = xsSigned--i64s :: [Int64]-i64s = xsSigned--si64s :: [SInt64]-si64s = xsSigned
− Data/SBV/TestSuite/Basics/BasicTests.hs 
@@ -1,51 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Basics.BasicTests--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Basics.BasicTests--------------------------------------------------------------------------------module Data.SBV.TestSuite.Basics.BasicTests(testSuite) where--import Data.SBV.Internals-import Data.SBV.Examples.Basics.BasicTests---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "basic-0.1" ~: test0 f1 `showsAs` "5"- , "basic-0.2" ~: test0 f2 `showsAs` "5"- , "basic-0.3" ~: test0 f3 `showsAs` "25"- , "basic-0.4" ~: test0 f4 `showsAs` "25"- , "basic-0.5" ~: test0 f5 `showsAs` "4"- , "basic-1.1" ~: test1 f1 `goldCheck` "basic-1_1.gold"- , "basic-1.2" ~: test1 f2 `goldCheck` "basic-1_2.gold"- , "basic-1.3" ~: test1 f3 `goldCheck` "basic-1_3.gold"- , "basic-1.4" ~: test1 f4 `goldCheck` "basic-1_4.gold"- , "basic-1.5" ~: test1 f5 `goldCheck` "basic-1_5.gold"- , "basic-2.1" ~: test2 f1 `goldCheck` "basic-2_1.gold"- , "basic-2.2" ~: test2 f2 `goldCheck` "basic-2_2.gold"- , "basic-2.3" ~: test2 f3 `goldCheck` "basic-2_3.gold"- , "basic-2.4" ~: test2 f4 `goldCheck` "basic-2_4.gold"- , "basic-2.5" ~: test2 f5 `goldCheck` "basic-2_5.gold"- , "basic-3.1" ~: test3 f1 `goldCheck` "basic-3_1.gold"- , "basic-3.2" ~: test3 f2 `goldCheck` "basic-3_2.gold"- , "basic-3.3" ~: test3 f3 `goldCheck` "basic-3_3.gold"- , "basic-3.4" ~: test3 f4 `goldCheck` "basic-3_4.gold"- , "basic-3.5" ~: test3 f5 `goldCheck` "basic-3_5.gold"- , "basic-4.1" ~: test4 f1 `goldCheck` "basic-4_1.gold"- , "basic-4.2" ~: test4 f2 `goldCheck` "basic-4_2.gold"- , "basic-4.3" ~: test4 f3 `goldCheck` "basic-4_3.gold"- , "basic-4.4" ~: test4 f4 `goldCheck` "basic-4_4.gold"- , "basic-4.5" ~: test4 f5 `goldCheck` "basic-4_5.gold"- , "basic-5.1" ~: test5 f1 `goldCheck` "basic-5_1.gold"- , "basic-5.2" ~: test5 f2 `goldCheck` "basic-5_2.gold"- , "basic-5.3" ~: test5 f3 `goldCheck` "basic-5_3.gold"- , "basic-5.4" ~: test5 f4 `goldCheck` "basic-5_4.gold"- , "basic-5.5" ~: test5 f5 `goldCheck` "basic-5_5.gold"- ]
− Data/SBV/TestSuite/Basics/Higher.hs 
@@ -1,34 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Basics.Higher--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Basics.Higher--------------------------------------------------------------------------------module Data.SBV.TestSuite.Basics.Higher(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Basics.Higher---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "higher-1"  ~: (f11 === f11)   `goldCheck` "higher-1.gold"- , "higher-2"  ~: (f12 === f12)   `goldCheck` "higher-2.gold"- , "higher-3"  ~: (f21 === f21)   `goldCheck` "higher-3.gold"- , "higher-4"  ~: (f22 === f22)   `goldCheck` "higher-4.gold"- , "higher-5"  ~: (f31 === f31)   `goldCheck` "higher-5.gold"- , "higher-6"  ~: (f32 === f32)   `goldCheck` "higher-6.gold"- , "higher-7"  ~: (f33 === f33)   `goldCheck` "higher-7.gold"- , "higher-8"  ~: double          `goldCheck` "higher-8.gold"- , "higher-9"  ~: onlyFailsFor128 `goldCheck` "higher-9.gold"- ]- where double          = (2*) === (\x -> x+(x::SWord8))-       onlyFailsFor128 = (2*) === (\x -> ite (x .== 128) 5 (x+(x::SWord8)))-
− Data/SBV/TestSuite/Basics/Index.hs 
@@ -1,21 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Basics.Index--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Basics.Index--------------------------------------------------------------------------------module Data.SBV.TestSuite.Basics.Index(testSuite) where--import Data.SBV.Internals-import Data.SBV.Examples.Basics.Index---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test $ zipWith tst [f x | f <- [test1, test2, test3], x <- [0..13]] [(0::Int)..]-  where tst t i = "index-" ++ show i ~: t `ioShowsAs` "True"
− Data/SBV/TestSuite/Basics/ProofTests.hs 
@@ -1,34 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Basics.ProofTests--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Basics.ProofTests--------------------------------------------------------------------------------module Data.SBV.TestSuite.Basics.ProofTests(testSuite)  where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Basics.ProofTests---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "proofs-1"  ~: assert       =<< isTheorem f1eqf2- , "proofs-2"  ~: assert . not =<< isTheorem f1eqf3- , "proofs-3"  ~: assert       =<< isTheorem f3eqf4- , "proofs-4"  ~: assert       =<< isTheorem f1Single- , "proofs-5"  ~: assert       =<< isSatisfiable (f1 `xyEq` f2)- , "proofs-6"  ~: assert       =<< isSatisfiable (f1 `xyEq` f3)- , "proofs-7"  ~: assert . not =<< isSatisfiable (exists "x" >>= \x -> return (x .== x + (1 :: SWord16)))- , "proofs-8"  ~: assert       =<< isSatisfiable (exists "x" >>= \x -> return (x :: SBool))- , "proofs-9"  ~: assert       =<< isSatisfiable (exists "x" >>= \x -> return x :: Predicate)- ]- where func1 `xyEq` func2 = do x <- exists_-                               y <- exists_-                               return $ func1 x y .== func2 x (y :: SWord8)
− Data/SBV/TestSuite/Basics/QRem.hs 
@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Basics.QRem--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Basics.QRem--------------------------------------------------------------------------------module Data.SBV.TestSuite.Basics.QRem(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Basics.QRem---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "qrem" ~: assert =<< isTheorem (qrem :: SWord8 -> SWord8 -> SBool)- ]
− Data/SBV/TestSuite/BitPrecise/BitTricks.hs 
@@ -1,27 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.BitPrecise.BitTricks--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.BitPrecise.BitTricks--------------------------------------------------------------------------------module Data.SBV.TestSuite.BitPrecise.BitTricks(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.BitPrecise.BitTricks---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "fast min"              ~: assert =<< isTheorem fastMinCorrect- , "fast max"              ~: assert =<< isTheorem fastMaxCorrect- , "opposite signs"        ~: assert =<< isTheorem oppositeSignsCorrect- , "conditional set clear" ~: assert =<< isTheorem conditionalSetClearCorrect- , "power of two"          ~: assert =<< isTheorem powerOfTwoCorrect- ]
− Data/SBV/TestSuite/BitPrecise/Legato.hs 
@@ -1,34 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.BitPrecise.Legato--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.BitPrecise.Legato--------------------------------------------------------------------------------module Data.SBV.TestSuite.BitPrecise.Legato(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.BitPrecise.Legato---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "legato-1" ~: legatoPgm `goldCheck` "legato.gold"- , "legato-2" ~: legatoC `goldCheck` "legato_c.gold"- ]- where legatoPgm = runSymbolic $ forAll ["mem", "addrX", "x", "addrY", "y", "addrLow", "regX", "regA", "memVals", "flagC", "flagZ"] legatoIsCorrect-                                 >>= output-       legatoC = compileToC' "legatoMult" $ do-                    cgSetDriverValues [87, 92]-                    cgPerformRTCs True-                    x <- cgInput "x"-                    y <- cgInput "y"-                    let (hi, lo) = runLegato (0, x) (1, y) 2 (initMachine (mkSFunArray (const 0)) (0, 0, 0, false, false))-                    cgOutput "hi" hi-                    cgOutput "lo" lo
− Data/SBV/TestSuite/BitPrecise/PrefixSum.hs 
@@ -1,25 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.BitPrecise.PrefixSum--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.PrefixSum.PrefixSum--------------------------------------------------------------------------------module Data.SBV.TestSuite.BitPrecise.PrefixSum(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.BitPrecise.PrefixSum---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-    "prefixSum1" ~: assert =<< isTheorem (flIsCorrect  8 (0, (+)))-  , "prefixSum2" ~: assert =<< isTheorem (flIsCorrect 16 (0, smax))-  , "prefixSum3" ~: runSymbolic (genPrefixSumInstance 16 >>= output) `goldCheck` "prefixSum_16.gold"-  ]
− Data/SBV/TestSuite/CRC/CCITT.hs 
@@ -1,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CRC.CCITT--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CRC.CCITT--------------------------------------------------------------------------------module Data.SBV.TestSuite.CRC.CCITT(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CRC.CCITT---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-  "ccitt" ~: crcPgm `goldCheck` "ccitt.gold"- ]- where crcPgm = runSymbolic $ forAll_ crcGood >>= output
− Data/SBV/TestSuite/CRC/CCITT_Unidir.hs 
@@ -1,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CRC.CCITT_Unidir--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CRC.CCITT_Unidir--------------------------------------------------------------------------------module Data.SBV.TestSuite.CRC.CCITT_Unidir(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CRC.CCITT_Unidir---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "ccitHDis3" ~: assert       =<< isTheorem (crcUniGood 3)- , "ccitHDis4" ~: assert . not =<< isTheorem (crcUniGood 4)- ]
− Data/SBV/TestSuite/CRC/GenPoly.hs 
@@ -1,29 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CRC.GenPoly--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CRC.GenPoly--------------------------------------------------------------------------------module Data.SBV.TestSuite.CRC.GenPoly(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CRC.GenPoly---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "crcGood" ~: assert       =<< isSatisfiable crcGoodE- , "crcGood" ~: assert . not =<< isTheorem (crcGood 3 12)- ]- where crcGoodE = do x1 <- exists_-                     x2 <- exists_-                     y1 <- exists_-                     y2 <- exists_-                     return (crcGood 3 0 (x1,x2) (y1,y2))
− Data/SBV/TestSuite/CRC/Parity.hs 
@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CRC.Parity--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CRC.Parity--------------------------------------------------------------------------------module Data.SBV.TestSuite.CRC.Parity(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CRC.Parity---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "parity" ~: assert =<< isTheorem parityOK- ]
− Data/SBV/TestSuite/CRC/USB5.hs 
@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CRC.USB5--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CRC.USB5--------------------------------------------------------------------------------module Data.SBV.TestSuite.CRC.USB5(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CRC.USB5---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "usbGood" ~: assert =<< isTheorem usbGood- ]
− Data/SBV/TestSuite/CodeGeneration/AddSub.hs 
@@ -1,31 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CodeGeneration.AddSub--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CodeGeneration.AddSub--------------------------------------------------------------------------------module Data.SBV.TestSuite.CodeGeneration.AddSub(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CodeGeneration.AddSub---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "addSub" ~: code `goldCheck` "addSub.gold"- ]- where code = compileToC' "addSub" $ do-                cgSetDriverValues [76, 92]-                cgPerformRTCs True-                x <- cgInput "x"-                y <- cgInput "y"-                let (s, d) = addSub x y-                cgOutput "sum" s-                cgOutput "dif" d
− Data/SBV/TestSuite/CodeGeneration/CRC_USB5.hs 
@@ -1,28 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CodeGeneration.CRC_USB5--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CodeGeneration.CRC_USB5--------------------------------------------------------------------------------module Data.SBV.TestSuite.CodeGeneration.CRC_USB5(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CodeGeneration.CRC_USB5---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "crcUSB5-1" ~: genC crcUSB  `goldCheck` "crcUSB5_1.gold"- , "crcUSB5-2" ~: genC crcUSB' `goldCheck` "crcUSB5_2.gold"- ]- where genC f = compileToC' "crcUSB5" $ do-                   cgSetDriverValues [0xFEDC]-                   msg <- cgInput "msg"-                   cgReturn $ f msg
− Data/SBV/TestSuite/CodeGeneration/CgTests.hs 
@@ -1,41 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CodeGeneration.CgTests--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for code-generation features--------------------------------------------------------------------------------{-# LANGUAGE ScopedTypeVariables #-}--module Data.SBV.TestSuite.CodeGeneration.CgTests(testSuite) where--import Data.SBV-import Data.SBV.Internals---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "selChecked"   ~: genSelect True  "selChecked"   `goldCheck` "selChecked.gold"- , "selUnchecked" ~: genSelect False "selUnChecked" `goldCheck` "selUnchecked.gold"- , "codegen1"     ~: foo `goldCheck` "codeGen1.gold"- ]- where genSelect b n = compileToC' n $ do-                         cgSetDriverValues [65]-                         cgPerformRTCs b-                         let sel :: SWord8 -> SWord8-                             sel x = select [1, x+2] 3 x-                         x <- cgInput "x"-                         cgReturn $ sel x-       foo = compileToC' "foo" $ do-                        cgSetDriverValues $ repeat 0-                        (x::SInt16)    <- cgInput "x"-                        (ys::[SInt64]) <- cgInputArr 45 "xArr"-                        cgOutput "z" (5 :: SWord16)-                        cgOutputArr "zArr" (replicate 7 (x+1))-                        cgOutputArr "yArr" ys-                        cgReturn (x*2)
− Data/SBV/TestSuite/CodeGeneration/Fibonacci.hs 
@@ -1,28 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CodeGeneration.Fibonacci--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CodeGeneration.Fibonacci--------------------------------------------------------------------------------module Data.SBV.TestSuite.CodeGeneration.Fibonacci(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CodeGeneration.Fibonacci---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "fib1" ~: tst [12] "fib1" (fib1 64) `goldCheck` "fib1.gold"- , "fib2" ~: tst [20] "fib2" (fib2 64) `goldCheck` "fib2.gold"- ]- where tst vs nm f = compileToC' nm $ do cgPerformRTCs True-                                         cgSetDriverValues vs-                                         n <- cgInput "n"-                                         cgReturn $ f n
− Data/SBV/TestSuite/CodeGeneration/GCD.hs 
@@ -1,28 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CodeGeneration.GCD--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CodeGeneration.GCD--------------------------------------------------------------------------------module Data.SBV.TestSuite.CodeGeneration.GCD(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CodeGeneration.GCD---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "gcd" ~: gcdC `goldCheck` "gcd.gold"- ]- where gcdC = compileToC' "sgcd" $ do-                cgSetDriverValues [55,154]-                x <- cgInput "x"-                y <- cgInput "y"-                cgReturn $ sgcd x y
− Data/SBV/TestSuite/CodeGeneration/PopulationCount.hs 
@@ -1,29 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CodeGeneration.PopulationCount--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CodeGeneration.PopulationCount--------------------------------------------------------------------------------module Data.SBV.TestSuite.CodeGeneration.PopulationCount(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CodeGeneration.PopulationCount---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "popCount-1" ~: genC False `goldCheck` "popCount1.gold"- , "popCount-2" ~: genC True  `goldCheck` "popCount2.gold"- ]- where genC b = compileToC' "popCount" $ do-                  cgSetDriverValues [0x0123456789ABCDEF]-                  cgPerformRTCs b-                  x <- cgInput "x"-                  cgReturn $ popCount x
− Data/SBV/TestSuite/CodeGeneration/Uninterpreted.hs 
@@ -1,26 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.CodeGeneration.Uninterpreted--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.CodeGeneration.Uninterpreted-------------------------------------------------------------------------------module Data.SBV.TestSuite.CodeGeneration.Uninterpreted(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.CodeGeneration.Uninterpreted---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "cgUninterpret" ~: genC `goldCheck` "cgUninterpret.gold"- ]- where genC = compileToC' "tstShiftLeft" $ do-                  cgSetDriverValues [1, 2, 3]-                  [x, y, z] <- cgInputArr 3 "vs"-                  cgReturn $ tstShiftLeft x y z
− Data/SBV/TestSuite/Crypto/AES.hs 
@@ -1,34 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Crypto.AES--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Crypto.AES--------------------------------------------------------------------------------module Data.SBV.TestSuite.Crypto.AES(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Crypto.AES---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "aes128Enc" ~: compileToC'    "aes128Enc" (aes128EncDec True)  `goldCheck` "aes128Enc.gold"- , "aes128Dec" ~: compileToC'    "aes128Dec" (aes128EncDec False) `goldCheck` "aes128Dec.gold"- , "aes128Lib" ~: compileToCLib' "aes128Lib" aes128Comps          `goldCheck` "aes128Lib.gold"- ]- where aes128EncDec d = do pt  <- cgInputArr 4 "pt"-                           key <- cgInputArr 4 "key"-                           cgSetDriverValues $ repeat 0-                           let (encKs, decKs) = aesKeySchedule key-                               res | d    = aesEncrypt pt encKs-                                   | True = aesDecrypt pt decKs-                           cgOutputArr "ct" res-       aes128Comps = [(f, setVals c) | (f, c) <- aes128LibComponents]-       setVals c = cgSetDriverValues (repeat 0) >> c
− Data/SBV/TestSuite/Crypto/RC4.hs 
@@ -1,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Crypto.RC4--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Crypto.RC4--------------------------------------------------------------------------------module Data.SBV.TestSuite.Crypto.RC4(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Crypto.RC4---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "rc4swap" ~: assert =<< isTheorem readWrite- ]- where readWrite i j = readSTree (writeSTree initS i j) i .== j
− Data/SBV/TestSuite/Existentials/CRCPolynomial.hs 
@@ -1,32 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Existentials.CRCPolynomial--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Existentials.CRCPolynomial--------------------------------------------------------------------------------module Data.SBV.TestSuite.Existentials.CRCPolynomial(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Existentials.CRCPolynomial---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-  "crcPolyExist" ~: pgm `goldCheck` "crcPolyExist.gold"- ]- where pgm = runSymbolic $ do-                p <- exists "poly"-                s <- do sh <- forall "sh"-                        sl <- forall "sl"-                        return (sh, sl)-                r <- do rh <- forall "rh"-                        rl <- forall "rl"-                        return (rh, rl)-                output $ bitValue p 0 &&& crcGood 4 p s r
− Data/SBV/TestSuite/Polynomials/Polynomials.hs 
@@ -1,25 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Polynomials.Polynomials--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Polynomials.Polynomials--------------------------------------------------------------------------------module Data.SBV.TestSuite.Polynomials.Polynomials(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Polynomials.Polynomials---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "polynomial-1" ~: assert =<< isTheorem multUnit- , "polynomial-2" ~: assert =<< isTheorem multComm- , "polynomial-3" ~: assert =<< isTheorem polyDivMod- ]
− Data/SBV/TestSuite/Puzzles/Counts.hs 
@@ -1,25 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Puzzles.Counts--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Puzzles.Counts--------------------------------------------------------------------------------module Data.SBV.TestSuite.Puzzles.Counts(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Puzzles.Counts---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-  "counts" ~: countPgm `goldCheck` "counts.gold"- ]- where countPgm = runSymbolic $ forAll_ puzzle' >>= output-       puzzle' d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 = puzzle [d0, d1, d2, d3, d4, d5, d6, d7, d8, d9]
− Data/SBV/TestSuite/Puzzles/DogCatMouse.hs 
@@ -1,27 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Puzzles.DogCatMouse--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Puzzles.DogCatMouse--------------------------------------------------------------------------------module Data.SBV.TestSuite.Puzzles.DogCatMouse(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Puzzles.DogCatMouse---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-  "dog cat mouse" ~: allSat p `goldCheck` "dogCatMouse.gold"- ]- where p = do d <- exists "d"-              c <- exists "c"-              m <- exists "m"-              return $ puzzle d c m
− Data/SBV/TestSuite/Puzzles/Euler185.hs 
@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Puzzles.Euler185--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Puzzles.Euler185--------------------------------------------------------------------------------module Data.SBV.TestSuite.Puzzles.Euler185(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Puzzles.Euler185---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-  "euler185" ~: allSat euler185 `goldCheck` "euler185.gold"- ]
− Data/SBV/TestSuite/Puzzles/MagicSquare.hs 
@@ -1,25 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Puzzles.MagicSquare--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Puzzles.MagicSquare--------------------------------------------------------------------------------module Data.SBV.TestSuite.Puzzles.MagicSquare(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Puzzles.MagicSquare---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "magic 2" ~: assert . not =<< isSatisfiable (mkMagic 2)- , "magic 3" ~: assert       =<< isSatisfiable (mkMagic 3)- ]- where mkMagic n = (isMagic . chunk n) `fmap` mkExistVars (n*n)
− Data/SBV/TestSuite/Puzzles/NQueens.hs 
@@ -1,32 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Puzzles.NQueens--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Puzzles.NQueens--------------------------------------------------------------------------------module Data.SBV.TestSuite.Puzzles.NQueens(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Puzzles.NQueens---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   -- number of *distinct* solutions is given in http://en.wikipedia.org/wiki/Eight_queens_puzzle-   "nQueens 1" ~: assert $ (==  1) `fmap` numberOfModels (mkQueens 1)- , "nQueens 2" ~: assert $ (==  0) `fmap` numberOfModels (mkQueens 2)- , "nQueens 3" ~: assert $ (==  0) `fmap` numberOfModels (mkQueens 3)- , "nQueens 4" ~: assert $ (==  2) `fmap` numberOfModels (mkQueens 4)- , "nQueens 5" ~: assert $ (== 10) `fmap` numberOfModels (mkQueens 5)- , "nQueens 6" ~: assert $ (==  4) `fmap` numberOfModels (mkQueens 6)- , "nQueens 7" ~: assert $ (== 40) `fmap` numberOfModels (mkQueens 7)- , "nQueens 8" ~: assert $ (== 92) `fmap` numberOfModels (mkQueens 8)- ]- where mkQueens n = isValid n `fmap` mkExistVars n
− Data/SBV/TestSuite/Puzzles/PowerSet.hs 
@@ -1,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Puzzles.PowerSet--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Puzzles.PowerSet--------------------------------------------------------------------------------module Data.SBV.TestSuite.Puzzles.PowerSet(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Puzzles.PowerSet---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [ "powerSet " ++ show i ~: assert (pSet i) | i <- [0 .. 7] ]- where pSet :: Int -> IO Bool-       pSet n = do cnt <- numberOfModels $ genPowerSet `fmap` mkExistVars n-                   return (cnt == 2^n)
− Data/SBV/TestSuite/Puzzles/Sudoku.hs 
@@ -1,25 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Puzzles.Sudoku--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Puzzles.Sudoku--------------------------------------------------------------------------------module Data.SBV.TestSuite.Puzzles.Sudoku(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Puzzles.Sudoku---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-  "sudoku " ++ show n ~: assert (checkPuzzle s)-     | (n, s) <- zip [(0::Int)..] [puzzle0, puzzle1, puzzle2, puzzle3, puzzle4, puzzle5, puzzle6]- ]- where checkPuzzle (i, f) = isSatisfiable $ (valid . f) `fmap` mkExistVars i
− Data/SBV/TestSuite/Puzzles/Temperature.hs 
@@ -1,23 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Puzzles.Temperature--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Puzzles.Temperature--------------------------------------------------------------------------------module Data.SBV.TestSuite.Puzzles.Temperature(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Puzzles.Temperature---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-  "temperature" ~: sat (revOf `fmap` exists_) `goldCheck` "temperature.gold"- ]
− Data/SBV/TestSuite/Puzzles/U2Bridge.hs 
@@ -1,31 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Puzzles.U2Bridge--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Puzzles.U2Bridge--------------------------------------------------------------------------------module Data.SBV.TestSuite.Puzzles.U2Bridge(testSuite) where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Puzzles.U2Bridge---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "U2Bridge-1" ~: assert $ (0 ==) `fmap` count 1- , "U2Bridge-2" ~: assert $ (0 ==) `fmap` count 2- , "U2Bridge-3" ~: assert $ (0 ==) `fmap` count 3- , "U2Bridge-4" ~: assert $ (0 ==) `fmap` count 4- , "U2Bridge-5" ~: solve 5 `goldCheck` "U2Bridge.gold"- , "U2Bridge-6" ~: assert $ (0 ==) `fmap` count 6- ]- where act     = do b <- exists_; p1 <- exists_; p2 <- exists_; return (b, p1, p2)-       count n = numberOfModels $ isValid `fmap` mapM (const act) [1..(n::Int)]-       solve n = sat $ isValid `fmap` mapM (const act) [1..(n::Int)]
− Data/SBV/TestSuite/Uninterpreted/AUF.hs 
@@ -1,26 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Uninterpreted.AUF--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Uninterpreted.AUF--------------------------------------------------------------------------------module Data.SBV.TestSuite.Uninterpreted.AUF where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Uninterpreted.AUF---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \goldCheck -> test [-   "auf-0" ~: assert =<< isTheorem thm1- , "auf-1" ~: assert =<< isTheorem thm2- , "auf-2" ~: pgm `goldCheck` "auf-1.gold"- ]- where pgm = runSymbolic $ forAll ["x", "y", "a", "initVal"] thm1 >>= output
− Data/SBV/TestSuite/Uninterpreted/Function.hs 
@@ -1,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.TestSuite.Uninterpreted.Function--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Testsuite for Data.SBV.Examples.Uninterpreted.Function--------------------------------------------------------------------------------module Data.SBV.TestSuite.Uninterpreted.Function where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Uninterpreted.Function---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "aufunc-0" ~: assert       =<< isTheorem thmGood- , "aufunc-1" ~: assert . not =<< isTheorem thmBad- ]
− Data/SBV/TestSuite/Uninterpreted/Uninterpreted.hs 
@@ -1,25 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Examples.TestSuite.Uninterpreted--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Test suite for Data.SBV.Examples.Uninterpreted.Uninterpreted--------------------------------------------------------------------------------module Data.SBV.TestSuite.Uninterpreted.Uninterpreted where--import Data.SBV-import Data.SBV.Internals-import Data.SBV.Examples.Uninterpreted.Uninterpreted---- Test suite-testSuite :: SBVTestSuite-testSuite = mkTestSuite $ \_ -> test [-   "uninterpreted-0" ~: assert       =<< isTheorem p0- , "uninterpreted-1" ~: assert       =<< isTheorem p1- , "uninterpreted-2" ~: assert . not =<< isTheorem p2- ]
− Data/SBV/Utils/SBVTest.hs 
@@ -1,45 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.SBV.Utils.SBVTest--- Copyright   :  (c) Levent Erkok--- License     :  BSD3--- Maintainer  :  erkokl@gmail.com--- Stability   :  experimental--- Portability :  portable------ Integration with HUnit-based test suite for SBV--------------------------------------------------------------------------------{-# LANGUAGE RankNTypes #-}-module Data.SBV.Utils.SBVTest(generateGoldCheck, showsAs, ioShowsAs, mkTestSuite, SBVTestSuite(..), module Test.HUnit) where--import System.FilePath ((</>))-import Test.HUnit      (Test(..), Assertion, assert, (~:), test)---- | A Test-suite, parameterized by the gold-check generator/checker-data SBVTestSuite = SBVTestSuite ((forall a. Show a => (IO a -> FilePath -> IO ())) -> Test)---- | Wrap over 'SBVTestSuite', avoids exporting the constructor-mkTestSuite :: ((forall a. (Show a) => IO a -> FilePath -> IO ()) -> Test) -> SBVTestSuite-mkTestSuite = SBVTestSuite---- | Checks that a particular result shows as @s@-showsAs :: Show a => a -> String -> Assertion-showsAs r s = assert $ show r == s---- | Run an IO computation and check that it's result shows as @s@-ioShowsAs :: Show a => IO a -> String -> Assertion-ioShowsAs r s = do v <- r-                   assert $ show v == s---- | Create a gold file for the test case-generateGoldCheck :: FilePath -> Bool -> (forall a. Show a => IO a -> FilePath -> IO ())-generateGoldCheck goldDir shouldCreate action goldFile-  | shouldCreate = do v <- action-                      writeFile gf (show v)-                      putStrLn $ "\nCreated Gold File: " ++ show gf-                      assert True-  | True         = do v <- action-                      g <- readFile gf-                      assert $ show v == g- where gf = goldDir </> goldFile
README view
@@ -4,6 +4,7 @@ Express properties about bit-precise Haskell programs and automatically prove them using SMT solvers. +```haskell         $ ghci -XScopedTypeVariables         Prelude> :m Data.SBV         Prelude Data.SBV> prove $ \(x::SWord8) -> x `shiftL` 2 .== 4*x@@ -11,10 +12,13 @@         Prelude Data.SBV> prove $ forAll ["x"] $ \(x::SWord8) -> x `shiftL` 2 .== x         Falsifiable. Counter-example:           x = 128 :: SWord8+```  The function `prove` has the following type:     +```haskell         prove :: Provable a => a -> IO ThmResult+```  The class `Provable` comes with instances for n-ary predicates, for arbitrary n. The predicates are just regular Haskell functions over symbolic signed and unsigned@@ -58,6 +62,7 @@   - used in synthesis (the `sat` function with existentials)   - optimized with respect to cost functions (the 'optimize', 'maximize', and 'minimize' functions)   - quick-checked+  - used in concrete test case generation (the 'genTest' function)  If a predicate is not valid, `prove` will return a counterexample: An  assignment to inputs such that the predicate fails. The `sat` function will@@ -72,26 +77,27 @@ The sbv library uses third-party SMT solvers via the standard SMT-Lib interface:  [http://goedel.cs.uiowa.edu/smtlib/](http://goedel.cs.uiowa.edu/smtlib/) -The SBV library is designed to work with any SMT-Lib compliant SMT-solver. -Currently, we support the Yices SMT solver from SRI:-[http://yices.csl.sri.com/](http://yices.csl.sri.com/) and the Z3 SMT solver-from Microsoft: [http://research.microsoft.com/en-us/um/redmond/projects/z3/](http://research.microsoft.com/en-us/um/redmond/projects/z3/)+The SBV library is designed to work with any SMT-Lib compliant SMT-solver, although integration with+individual solvers require some library work.+Currently, we fully support the [Yices](http://yices.csl.sri.com) SMT solver from SRI,+and the [Z3](http://research.microsoft.com/en-us/um/redmond/projects/z3/)+SMT solver from Microsoft.+Both solvers are available for Windows, Linux, and Mac OSX.  Prerequisites =============-You **should** download and install Yices (version 2.X) on your machine, and+You **should** [download](http://yices.csl.sri.com/download-yices2.shtml)+and install Yices (version 2.X) on your machine, and make sure the "yices" executable is in your path before using the sbv library, as it is the current default solver. Alternatively, you can specify the location of yices executable in the environment variable `SBV_YICES` and the options to yices in `SBV_YICES_OPTIONS`. The default for the latter is `"-m -f"`. -If quantified bit-vectors are to be used, you should also install-Microsoft's z3 SMT solver. Again, the environment variables -`SBV_Z3` and `SBV_Z3_OPTIONS` can be used for choosing executable location-and custom options.  The default for the latter is `"/in /smt2"`. Microsoft-releases Z3 natively on Windows, and Linux for SMT-Comp purposes, and you can-also run it on Mac via Wine or similar emulators. You should download at least-version 3.2.+SBV can also use Microsoft's Z3 SMT solver as a+backend [(download)](http://research.microsoft.com/en-us/um/redmond/projects/z3/download.html).+The environment variables `SBV_Z3` and `SBV_Z3_OPTIONS` can be used for choosing executable location+and custom options.  The default for the latter is `"/in /smt2"` on Windows and `"-in -smt2"`+on Mac and Linux. You should download Z3 version 3.2 or later.  Examples =========
+ RELEASENOTES view
@@ -0,0 +1,274 @@+Hackage: <http://hackage.haskell.org/package/sbv>+GitHub:  <http://github.com/LeventErkok/sbv>++======================================================================+Version 0.9.24, 2011-12-28++  Library:+   * Add "forSome," analogous to "forAll." (The name "exists" would've+     been better, but it's already taken.) This is not as useful as+     one might think as forAll and forSome do not nest, as an inner+     application of one pushes its argument to a Predicate, making+     the outer one useless, but it's nonetheless useful by itself.+   * Add a "Modelable" class, which simplifies model extraction.+   * Add support for quick-check at the "Symbolic SBool" level. Previously+     SBV only allowed functions returning SBool to be quick-checked, which+     forced a certain style of coding. In particular with the addition+     of quantifiers, the new coding style mostly puts the top-level+     expressions in the Symbolic monad, which were not quick-checkable+     before. With new support, the quickCheck, prove, sat, and allSat+     commands are all interchangeable with obvious meanings.+   * Add support for concrete test case generation, see the genTest function.+   * Improve optimize routines and add support for iterative optimization.+   * Add "constrain", simplifying conjunctive constraints, especially+     useful for adding constraints at variable generation time via+     forall/exists. Note that the interpretation of such constraints+     is different for genTest and quickCheck functions, where constraints+     will be used for appropriately filtering acceptable test values+     in those two cases.+   * Add "pConstrain", which probabilistically adds constraints. This+     is useful for quickCheck and genTest functions for filtering acceptable+     test values. (Calls to pConstrain will be rejected for sat/prove calls.)+   * Add "isVacuous" which can be used to check that the constraints added+     via constrain are satisfable. This is useful to prevent vacuous passes,+     i.e., when a proof is not just passing because the constraints imposed+     are inconsistent. (Also added accompanying isVacuousWith.)+   * Add "free" and "free_", analogous to "forall/forall_" and "exists/exists_"+     The difference is that free behaves universally in a proof context, while+     it behaves existentially in a sat context. This allows us to express+     properties more succinctly, since the intended semantics is usually this+     way depending on the context. (i.e., in a proof, we want our variables+     universal, in a sat call existential.) Of course, exists/forall are still+     available when mixed quantifiers are needed, or when the user wants to+     be explicit about the quantifiers.+  Examples+   * Add Data/SBV/Examples/Puzzles/Coins.hs. (Shows the usage of "constrain".)+  Dependencies+   * Bump up random package dependency to 1.0.1.1 (from 1.0.0.2)+  Internal+   * Major reorganization of files to and build infrastructure to+     decrease build times and better layout+   * Get rid of custom Setup.hs, just use simple build. The extra work+     was not worth the complexity.++======================================================================+Version 0.9.23, 2011-12-05+  +  Library:+   * Add support for SInteger, the type of signed unbounded integer+     values. SBV can now prove theorems about unbounded numbers,+     following the semantics of Haskell's Integer type. (Requires z3 to+     be used as the backend solver.)+   * Add functions 'optimize', 'maximize', and 'minimize' that can+     be used to find optimal solutions to given constraints with+     respect to a given cost function.+   * Add 'cgUninterpret', which simplifies code generation when we want+     to use an alternate definition in the target language (i.e., C). This+     is important for efficient code generation, when we want to+     take advantage of native libraries available in the target platform.+  Other:+   * Change getModel to return a tuple in the success case, where+     the first component is a boolean indicating whether the model+     is "potential." This is used to indicate that the solver+     actually returned "unknown" for the problem and the model+     might therefore be bogus. Note that we did not need this before+     since we only supported bounded bit-vectors, which has a decidable+     theory. With the addition of unbounded Integer's and quantifiers, the+     solvers can now return unknown. This should still be rare in practice,+     but can happen with the use of non-linear constructs. (i.e.,+     multiplication of two variables.)++======================================================================+Version 0.9.22, 2011-11-13+   +  The major change in this release is the support for quantifiers. The+  SBV library *no* longer assumes all variables are universals in a proof,+  (and correspondingly existential in a sat) call. Instead, the user+  marks free-variables appropriately using forall/exists functions, and the+  solver translates them accordingly. Note that this is a non-backwards+  compatible change in sat calls, as the semantics of formulas is essentially+  changing. While this is unfortunate, it's more uniform and simpler to understand+  in general.++  This release also adds support for the Z3 solver, which is the main+  SMT-solver used for solving formulas involving quantifiers. More formally,+  we use the new AUFBV/ABV/UFBV logics when quantifiers are involved. Also, +  the communication with Z3 is now done via SMT-Lib2 format. Eventually+  the SMTLib1 connection will be severed.++  The other main change is the support for C code generation with+  uninterpreted functions enabling users to interface with external+  C functions defined elsewhere. See below for details.++  Other changes:+    Code:+     * Change getModel, so it returns an Either value to indicate+       something went wrong; instead of throwing an error+     * Add support for computing CRCs directly (without needing+       polynomial division).+    Code generation:+     * Add "cgGenerateDriver" function, which can be used to turn+       on/off driver program generation. Default is to generate+       a driver. (Issue "cgGenerateDriver False" to skip the driver.)+       For a library, a driver will be generated if any of the+       constituent parts has a driver. Otherwise it'll be skipped.+     * Fix a bug in C code generation where "Not" over booleans were+       incorrectly getting translated due to need for masking.+     * Add support for compilation with uninterpreted functions. Users+       can now specify the corresponding C code and SBV will simply+       call the "native" functions instead of generating it. This+       enables interfacing with other C programs. See the functions:+       cgAddPrototype, cgAddDecl, and cgAddLDFlags.+    Examples:+     * Add CRC polynomial generation example via existentials+     * Add USB CRC code generation example, both via polynomials and+       using the internal CRC functionality++======================================================================+Version 0.9.21, 2011-08-05+   +   Code generation:+    * Allow for inclusion of user makefiles+    * Allow for CCFLAGS to be set by the user+    * Other minor clean-up++======================================================================+Version 0.9.20, 2011-06-05+   +    * Regression on 0.9.19; add missing file to cabal++======================================================================+Version 0.9.19, 2011-06-05+    +   Code:+    * Add SignCast class for conversion between signed/unsigned+      quantities for same-sized bit-vectors+    * Add full-binary trees that can be indexed symbolically (STree). The+      advantage of this type is that the reads and writes take+      logarithmic time. Suitable for implementing faster symbolic look-up.+    * Expose HasSignAndSize class through Data.SBV.Internals+    * Many minor improvements, file re-orgs+   Examples:+    * Add sentence-counting example+    * Add an implementation of RC4++======================================================================+Version 0.9.18, 2011-04-07++  Code:+    * Re-engineer code-generation, and compilation to C.+      In particular, allow arrays of inputs to be specified,+      both as function arguments and output reference values.+    * Add support for generation of generation of C-libraries,+      allowing code generation for a set of functions that+      work together.+  Examples:+    * Update code-generation examples to use the new API.+    * Include a library-generation example for doing 128-bit+      AES encryption++======================================================================+Version 0.9.17, 2011-03-29+   +  Code:+    * Simplify and reorganize the test suite+  Examples:+    * Improve AES decryption example, by using+      table-lookups in InvMixColumns.+  +======================================================================+Version 0.9.16, 2011-03-28++  Code:+    * Further optimizations on Bits instance of SBV+  Examples:+    * Add AES algorithm as an example, showing how+      encryption algorithms are particularly suitable+      for use with the code-generator++======================================================================+Version 0.9.15, 2011-03-24+   +  Bug fixes:+    * Fix rotateL/rotateR instances on concrete+      words. Previous versions was bogus since+      it relied on the Integer instance, which+      does the wrong thing after normalization.+    * Fix conversion of signed numbers from bits,+      previous version did not handle two's+      complement layout correctly+  Testing:+    * Add a sleuth of concrete test cases on+      arithmetic to catch bugs. (There are many+      of them, ~30K, but they run quickly.)++======================================================================+Version 0.9.14, 2011-03-19+    +  - Reimplement sharing using Stable names, inspired+    by the Data.Reify techniques. This avoids tricks+    with unsafe memory stashing, and hence is safe.+    Thus, issues with respect to CAFs are now resolved.++======================================================================+Version 0.9.13, 2011-03-16+    +  Bug fixes:+    * Make sure SBool short-cut evaluations are done+      as early as possible, as these help with coding+      recursion-depth based algorithms, when dealing+      with symbolic termination issues.+  Examples:+    * Add fibonacci code-generation example, original+      code by Lee Pike.+    * Add a GCD code-generation/verification example++======================================================================+Version 0.9.12, 2011-03-10+  +  New features:+    * Add support for compilation to C+    * Add a mechanism for offline saving of SMT-Lib files++  Bug fixes:+    * Output naming bug, reported by Josef Svenningsson+    * Specification bug in Legato's multipler example++======================================================================+Version 0.9.11, 2011-02-16+  +  * Make ghc-7.0 happy, minor re-org on the cabal file/Setup.hs++======================================================================+Version 0.9.10, 2011-02-15++  * Integrate commits from Iavor: Generalize SBV's to keep+    track the integer directly without resorting to different+    leaf types+  * Remove the unnecessary CLC instruction from the Legato example+  * More tests++======================================================================+Version 0.9.9, 2011-01-23++  * Support for user-defined SMT-Lib axioms to be+    specified for uninterpreted constants/functions+  * Move to using doctest style inline tests++======================================================================+Version 0.9.8, 2011-01-22++  * Better support for uninterpreted-functions+  * Support counter-examples with SArray's+  * Ladner-Fischer scheme example+  * Documentation updates++======================================================================+Version 0.9.7, 2011-01-18++  * First stable public hackage release++======================================================================+Versions 0.0.0 - 0.9.6, Mid 2010 through early 2011++  * Basic infrastructure, design exploration
+ SBVUnitTest/Examples/Arrays/Memory.hs view
@@ -0,0 +1,44 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.Arrays.Memory+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Simple memory abstraction and properties+-----------------------------------------------------------------------------++module Examples.Arrays.Memory where++import Data.SBV++type Address = SWord32+type Value   = SWord64+type Memory  = SArray Word32 Word64++-- | read-after-write: If you write a value and read it back, you'll get it+raw :: Address -> Value -> Memory -> SBool+raw a v m = readArray (writeArray m a v) a .== v++-- | write-after-write: If you write to the same location twice, then the first one is ignored+waw :: Address -> Value -> Value -> Memory -> SBool+waw a v1 v2 m0 = m2 .== m3+  where m1 = writeArray m0 a v1+        m2 = writeArray m1 a v2+        m3 = writeArray m0 a v2++-- | Two writes to different locations commute, i.e., can be done in any order+wcommutesGood :: (Address, Value) -> (Address, Value) -> Memory -> SBool+wcommutesGood (a, x) (b, y) m = a ./= b ==> wcommutesBad (a, x) (b, y) m++-- | Two writes do not commute if they can be done to the same location+wcommutesBad :: (Address, Value) -> (Address, Value) -> Memory -> SBool+wcommutesBad (a, x) (b, y) m = writeArray (writeArray m a x) b y .== writeArray (writeArray m b y) a x++tests :: IO ()+tests = do print =<< prove raw+           print =<< prove waw+           print =<< prove wcommutesBad+           print =<< prove wcommutesGood
+ SBVUnitTest/Examples/Basics/BasicTests.hs view
@@ -0,0 +1,47 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.Basics.BasicTests+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Basic tests of the sbv library+-----------------------------------------------------------------------------++{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Examples.Basics.BasicTests where++import Data.SBV+import Data.SBV.Internals++test0 :: (forall a. Num a => (a -> a -> a)) -> Word8+test0 f = f (3 :: Word8) 2++test1, test2, test3, test4, test5 :: (forall a. Num a => (a -> a -> a)) -> IO Result+test1 f = runSymbolic True $ do let x = literal (3 :: Word8)+                                    y = literal (2 :: Word8)+                                output $ f x y+test2 f = runSymbolic True $ do let x = literal (3 :: Word8)+                                y :: SWord8 <- forall "y"+                                output $ f x y+test3 f = runSymbolic True $ do x :: SWord8 <- forall "x"+                                y :: SWord8 <- forall "y"+                                output $ f x y+test4 f = runSymbolic True $ do x :: SWord8 <- forall "x"+                                output $ f x x+test5 f = runSymbolic True $ do x :: SWord8 <- forall "x"+                                let r = f x x+                                q :: SWord8 <- forall "q"+                                _ <- output q+                                output r++f1, f2, f3, f4, f5 :: Num a => a -> a -> a+f1 x y = (x+y)*(x-y)+f2 x y = (x*x)-(y*y)+f3 x y = (x+y)*(x+y)+f4 x y = let z = x + y in z * z+f5 x _ = x + 1
+ SBVUnitTest/Examples/Basics/Higher.hs view
@@ -0,0 +1,50 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.Basics.Higher+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Testing function equality+-----------------------------------------------------------------------------++module Examples.Basics.Higher where++import Data.SBV++type B = SWord8++f11 :: B -> B+f11 x = x++f12 :: B -> (B, B)+f12 x = (x, x)++f21 :: (B, B) -> B+f21 (x, y) = x + y++f22 :: (B, B) -> (B, B)+f22 (x, y) = (x, y)++f31 :: B -> B -> B+f31 x y = x + y++f32 :: B -> B -> (B, B)+f32 x y = (x, y)++f33 :: B -> B -> B -> (B, B, B)+f33 x y z = (x, y, z)+++t :: IO [ThmResult]+t = sequence [+       f11 === f11+     , f12 === f12+     , f21 === f21+     , f22 === f22+     , f31 === f31+     , f32 === f32+     , f33 === f33+     ]
+ SBVUnitTest/Examples/Basics/Index.hs view
@@ -0,0 +1,69 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.Basics.Index+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Testing the select function+-----------------------------------------------------------------------------++module Examples.Basics.Index where++import Data.SBV++-- prove that the "select" primitive is working correctly+test1 :: Int -> IO Bool+test1 n = isTheorem $ do+            elts <- mkForallVars n+            err  <- forall_+            ind  <- forall_+            ind2 <- forall_+            let r1 = (select :: [SWord8] -> SWord8 -> SInt8 -> SWord8) elts err ind+                r2 = (select :: [SWord8] -> SWord8 -> SWord8 -> SWord8) elts err ind2+                r3 = slowSearch elts err ind+                r4 = slowSearch elts err ind2+            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))++test2 :: Int -> IO Bool+test2 n = isTheorem $ do+            elts1 <- mkForallVars n+            elts2 <- mkForallVars n+            let elts = zip elts1 elts2+            err1  <- forall_+            err2  <- forall_+            let err = (err1, err2)+            ind  <- forall_+            ind2 <- forall_+            let r1 = (select :: [(SWord8, SWord8)] -> (SWord8, SWord8) -> SInt8 -> (SWord8, SWord8)) elts err ind+                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+ 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))++test3 :: Int -> IO Bool+test3 n = isTheorem $ do+            eltsI <- mkForallVars n+            let elts = map Left eltsI+            errI  <- forall_+            let err = Left errI+            ind  <- forall_+            let r1 = (select :: [Either SWord8 SWord8] -> Either SWord8 SWord8 -> SInt8 -> Either SWord8 SWord8) elts err ind+                r2 = slowSearch elts err ind+            return $ r1 .== r2+ 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))++tests :: IO ()+tests = do mapM test1 [0..50] >>= print . and+           mapM test2 [0..50] >>= print . and+           mapM test3 [0..50] >>= print . and
+ SBVUnitTest/Examples/Basics/ProofTests.hs view
@@ -0,0 +1,48 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.Basics.ProofTests+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Basic proofs+-----------------------------------------------------------------------------++{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Examples.Basics.ProofTests where++import Data.SBV++f1, f2, f3, f4 :: Num a => a -> a -> a+f1 x y = (x+y)*(x-y)+f2 x y = (x*x)-(y*y)+f3 x y = (x+y)*(x+y)+f4 x y = x*x + 2*x*y + y*y++f1eqf2 :: Predicate+f1eqf2 = forAll_ $ \x y -> f1 x y .== f2 x (y :: SWord8)++f1eqf3 :: Predicate+f1eqf3 = forAll ["x", "y"] $ \x y -> f1 x y .== f3 x (y :: SWord8)++f3eqf4 :: Predicate+f3eqf4 = forAll_ $ \x y -> f3 x y .== f4 x (y :: SWord8)++f1Single :: Predicate+f1Single = forAll_ $ \x -> f1 x x .== (0 :: SWord16)++queries :: IO ()+queries = do print =<< prove f1eqf2   -- QED+             print =<< prove f1eqf3   -- No+             print =<< prove f3eqf4   -- QED+             print =<< prove f1Single -- QED+             print =<< sat (do x <- exists "x"+                               y <- exists "y"+                               return $ f1 x y .== f2 x (y :: SWord8))  -- yes, any output OK+             print =<< sat (do x <- exists "x"+                               y <- exists "y"+                               return $ f1 x y .== f3 x (y:: SWord8))    -- yes, 0;0
+ SBVUnitTest/Examples/Basics/QRem.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.Basics.QRem+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Testing the qrem (quote-rem) function+-----------------------------------------------------------------------------++module Examples.Basics.QRem where++import Data.SBV++-- check: if (a, b) = x `quotRem` y then x = y*a + b+-- being careful about y = 0. When divisor is 0, then quotient is+-- defined to be 0 and the remainder is the numerator+qrem :: (Num a, EqSymbolic a, BVDivisible a) => a -> a -> SBool+qrem x y = ite (y .== 0) ((0, x) .== (a, b)) (x .== y * a + b)+  where (a, b) = x `bvQuotRem` y++check :: IO ()+check = print =<< prove (qrem :: SWord8 -> SWord8 -> SBool)+         -- print =<< prove (qrem :: SWord16 -> SWord16 -> SBool)   -- takes too long!
+ SBVUnitTest/Examples/CRC/CCITT.hs view
@@ -0,0 +1,63 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.CRC.CCITT+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- CRC checks, hamming distance, etc.+-----------------------------------------------------------------------------++module Examples.CRC.CCITT where++import Data.SBV++-- We don't have native support for 48 bits in Data.SBV+-- So, represent as 32 high-bits and 16 low+type SWord48 = (SWord32, SWord16)++extendData :: SWord48 -> SWord64+extendData (h, l) = h # l # 0++mkFrame :: SWord48 -> SWord64+mkFrame msg@(h, l) = h # l # crc_48_16 msg++crc_48_16 :: SWord48 -> SWord16+crc_48_16 msg = res+  where msg64, divisor :: SWord64+        msg64   = extendData msg+        divisor = polynomial [16, 12, 5, 0]+        crc64 = pMod msg64 divisor+        (_, res) = split (snd (split crc64))++diffCount :: SWord64 -> SWord64 -> SWord8+diffCount x y = count $ zipWith (.==) (blastLE x) (blastLE y)+  where count []     = 0+        count (b:bs) = let r = count bs in ite b r (1+r)++-- 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+   where frameSent     = mkFrame sent+         frameReceived = mkFrame received++-- How come we get way more than 168 (= 2*84) counter-examples for this? +hw4has84Inhabitants :: SWord48 -> SWord48 -> SBool+hw4has84Inhabitants sent received = fourBitError+   where frameSent     = mkFrame sent+         frameReceived = mkFrame received+         fourBitError  = diffCount frameSent frameReceived .== 4++hw4 :: IO ()+hw4 = do res <- allSat hw4has84Inhabitants+         cnt <- displayModels disp res+         putStrLn $ "Found: " ++ show cnt ++ " solution(s)."+   where disp :: Int -> (Bool, (Word32, Word16, Word32, Word16)) -> IO ()+         disp i (_, (sh, sl, rh, rl)) = do putStrLn $ "Solution #" ++ show i ++ ": "+                                           putStrLn $ "  Sent    : " ++ binS (mkFrame (literal sh, literal sl))+                                           putStrLn $ "  Received: " ++ binS (mkFrame (literal rh, literal rl))++{-# ANN crc_48_16 "HLint: ignore Use camelCase" #-}
+ SBVUnitTest/Examples/CRC/CCITT_Unidir.hs view
@@ -0,0 +1,61 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.CRC.CCITT_Unidir+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Similar to CCITT. It shows that the CCITT is still HD 3+-- even if we consider only uni-directional errors+-----------------------------------------------------------------------------++module Examples.CRC.CCITT_Unidir where++import Data.SBV++-- We don't have native support for 48 bits in Data.SBV+-- So, represent as 32 high-bits and 16 low+type SWord48 = (SWord32, SWord16)++extendData :: SWord48 -> SWord64+extendData (h, l) = h # l # 0++mkFrame :: SWord48 -> SWord64+mkFrame msg@(h, l) = h # l # crc_48_16 msg++crc_48_16 :: SWord48 -> SWord16+crc_48_16 msg = res+  where msg64, divisor :: SWord64+        msg64   = extendData msg+        divisor = polynomial [16, 12, 5, 0]+        crc64 = pMod msg64 divisor+        (_, res) = split (snd (split crc64))++diffCount :: [SBool] -> [SBool] -> SWord8+diffCount xs ys = count $ zipWith (.==) xs ys+  where count []     = 0+        count (b:bs) = let r = count bs in ite b r (1+r)++-- 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++crcUniGood :: SWord8 -> SWord48 -> SWord48 -> SBool+crcUniGood hd sent received =+     sent ./= received ==> nonUnidir frameSent frameReceived ||| diffCount frameSent frameReceived .> hd+   where frameSent     = blastLE $ mkFrame sent+         frameReceived = blastLE $ mkFrame received++-- Provable, i.e., HD is 3+ccitHDis3 :: IO ()+ccitHDis3 = print =<< prove (crcUniGood 3)++-- False; i.e., HD doesn't go to 4 just because we only look at uni-directional errors+ccitHDis4 :: IO ()+ccitHDis4 = print =<< prove (crcUniGood 4)++{-# ANN crc_48_16 "HLint: ignore Use camelCase" #-}
+ SBVUnitTest/Examples/CRC/GenPoly.hs view
@@ -0,0 +1,76 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.CRC.GenPoly+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Finds good polynomials for CRC's+-----------------------------------------------------------------------------++module Examples.CRC.GenPoly where++import Data.SBV++-- We don't have native support for 48 bits in Data.SBV+-- So, represent as 32 high-bits and 16 low+type SWord48 = (SWord32, SWord16)++extendData :: SWord48 -> SWord64+extendData (h, l) = h # l # 0++mkFrame :: SWord64 -> SWord48 -> SWord64+mkFrame poly msg@(h, l) = h # l # crc_48_16 msg poly++crc_48_16 :: SWord48 -> SWord64 -> SWord16+crc_48_16 msg poly = res+  where msg64 = extendData msg+        crc64 = pMod msg64 poly+        (_, res) = split (snd (split crc64))++diffCount :: SWord64 -> SWord64 -> SWord8+diffCount x y = count $ zipWith (.==) (blastLE x) (blastLE y)+  where count []     = 0+        count (b:bs) = let r = count bs in ite b r (1+r)++crcGood :: SWord8 -> SWord16 -> SWord48 -> SWord48 -> SBool+crcGood hd divisor sent received =+     sent ./= received ==> diffCount frameSent frameReceived .> hd+   where frameSent     = mkFrame poly sent+         frameReceived = mkFrame poly received+         poly          = mkPoly divisor++mkPoly :: SWord16 -> SWord64+mkPoly d = 0 # 1 # d++-- how long do we wait for each poly.. (seconds)+waitFor :: Int+waitFor = 15++genPoly :: SWord8 -> IO ()+genPoly hd = do putStrLn $ "*** Looking for polynomials with HD = " ++ show hd+                (skipped, res) <- go 0 [] []+                putStrLn $ "*** Good polynomials with HD = " ++ show hd+                mapM_ (\(i, s) -> putStrLn (show i ++ ". " ++ showPoly (mkPoly s)))  (zip [(1::Integer)..] res)+                putStrLn $ "*** Skipped the followings, proof exceeded timeout value of " ++ show waitFor+                mapM_ (\(i, s) -> putStrLn (show i ++ ". " ++ showPoly (mkPoly s)))  (zip [(1::Integer)..] skipped)+                putStrLn "*** Done."+  where go :: SWord16 -> [SWord16] -> [SWord16] -> IO ([SWord16], [SWord16])+        go poly skip acc+         | poly == maxBound = return (skip, acc)+         | True             = do putStr $ "Testing " ++ showPoly  (mkPoly poly) ++ "... "+                                 thm <- isTheoremWithin waitFor $ crcGood hd poly+                                 case thm of+                                   Nothing    -> do putStrLn "Timeout, skipping.."+                                                    go (poly+1) (poly:skip) acc+                                   Just True  -> do putStrLn "Good!"+                                                    go (poly+1) skip (poly:acc)+                                   Just False -> do putStrLn "Bad!"+                                                    go (poly+1) skip acc++findHD3Polynomials :: IO ()+findHD3Polynomials = genPoly 3++{-# ANN crc_48_16 "HLint: ignore Use camelCase" #-}
+ SBVUnitTest/Examples/CRC/Parity.hs view
@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.CRC.Parity+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Parity check as CRC's+-----------------------------------------------------------------------------++module Examples.CRC.Parity where++import Data.SBV++parity :: SWord64 -> SBool+parity x = bnot (isOdd cnt)+  where cnt :: SWord8+        cnt = count (blastLE x)++isOdd :: SWord8 -> SBool+isOdd x = lsb x .== true++-- count the true bits+count :: [SBool] -> SWord8+count []     = 0+count (x:xs) = let c' = count xs in ite x (1+c') c'++-- 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+  where cnt = count (zipWith (./=) (blastLE x) (blastLE y))+        px  = parity x+        py  = parity y
+ SBVUnitTest/Examples/CRC/USB5.hs view
@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.CRC.USB5+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- The USB5 CRC implementation+-----------------------------------------------------------------------------++module Examples.CRC.USB5 where++import Data.SBV++newtype SWord11 = S11 SWord16++instance EqSymbolic SWord11 where+  S11 w .== S11 w' = w .== w'++mkSWord11 :: SWord16 -> SWord11+mkSWord11 w = S11 (w .&. 0x07FF)++extendData :: SWord11 -> SWord16+extendData (S11 w) = w `shiftL` 5++mkFrame :: SWord11 -> SWord16+mkFrame w = extendData w .|. crc_11_16 w++-- crc returns 16 bits, but the first 11 are always 0+crc_11_16 :: SWord11 -> SWord16+crc_11_16 msg = crc16 .&. 0x1F -- just get the last 5 bits+  where divisor :: SWord16+        divisor = polynomial [5, 2, 0]+        crc16 = pMod (extendData msg) divisor++diffCount :: SWord16 -> SWord16 -> SWord8+diffCount x y = count $ zipWith (.==) (blastLE x) (blastLE y)+  where count []     = 0+        count (b:bs) = let r = count bs in ite b r (1+r)++-- 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+   where sent     = mkSWord11 sent16+         received = mkSWord11 received16+         frameSent     = mkFrame sent+         frameReceived = mkFrame received++{-# ANN crc_11_16 "HLint: ignore Use camelCase" #-}
+ SBVUnitTest/Examples/Puzzles/PowerSet.hs view
@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.Puzzles.PowerSet+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Computes the powerset of a givenset+-----------------------------------------------------------------------------++module Examples.Puzzles.PowerSet where++import Data.SBV++genPowerSet :: [SBool] -> SBool+-- The following definition reveals an issue in Yices's model generation. The+-- seemingly vacuous test of checking true-or-false is necessary+-- so that Yices will return a satisfying assignment+-- otherwise, it just skips the "unused" inputs..+genPowerSet = bAll isBool+  where isBool x = x .== true ||| x .== false++powerSet :: [Word8] -> IO ()+powerSet xs = do putStrLn $ "Finding all subsets of " ++ show xs+                 res <- allSat $ genPowerSet `fmap` mkExistVars n+                 cnt <- displayModels disp res+                 putStrLn $ "Found: " ++ show cnt ++ " subset(s)."+     where n = length xs+           disp i (_, ss)+            | length ss /= n = error $ "Expected " ++ show n ++ " results; got: " ++ show (length ss)+            | True           = putStrLn $ "Subset #" ++ show i ++ ": " ++ show (concat (zipWith pick ss xs))+           pick True a  = [a]+           pick False _ = []
+ SBVUnitTest/Examples/Puzzles/Temperature.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.Puzzles.Temperature+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Puzzle:+--   What 2 digit fahrenheit/celcius values are reverses of each other?+--   Ignoring the fractions in the conversion+-----------------------------------------------------------------------------++module Examples.Puzzles.Temperature where++import Data.SBV++type Temp = SWord16 -- larger than we need actually++-- convert celcius to fahrenheit, rounding up/down properly+-- we have to be careful here to make sure rounding is done properly..+d2f :: Temp -> Temp+d2f d = 32 + ite (fr .>= 5) (1+fi) fi+  where (fi, fr) = (18 * d) `bvQuotRem` 10++-- puzzle: What 2 digit fahrenheit/celcius values are reverses of each other?+revOf :: Temp -> SBool+revOf c = swap (digits c) .== digits (d2f c)+  where digits x = x `bvQuotRem` 10+        swap (a, b) = (b, a)++solve :: IO ()+solve = do res <- allSat $ revOf `fmap` exists_+           cnt <- displayModels disp res+           putStrLn $ "Found " ++ show cnt ++ " solutions."+     where disp :: Int -> (Bool, Word16) -> IO ()+           disp _ (_, x) = putStrLn $ " " ++ show x ++ "C --> " ++ show (round f :: Integer) ++ "F (exact value: " ++ show f ++ "F)"+              where f :: Double+                    f  = 32 + (9 * fromIntegral x) / 5
+ SBVUnitTest/Examples/Uninterpreted/Uninterpreted.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.Uninterpreted.Uninterpreted+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Testing uninterpreted functions+-----------------------------------------------------------------------------++module Examples.Uninterpreted.Uninterpreted where++import Data.SBV++f :: SInt8 -> SWord32+f = uninterpret "f"++g :: SInt8 -> SWord16 -> SWord32+g = uninterpret "g"++p0 :: SInt8 -> SInt8 -> SBool+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++p2 :: SInt8 -> SWord16 -> SWord16 -> SBool+p2 x y z = y .== z ==> g x y .== f x    -- Not true
SBVUnitTest/GoldFiles/auf-1.gold view
@@ -27,5 +27,6 @@   s15 :: SWord64 = uninterpreted_f s14   s16 :: SBool = s11 == s15   s17 :: SBool = s6 | s16+CONSTRAINTS OUTPUTS   s17
SBVUnitTest/GoldFiles/basic-2_1.gold view
@@ -13,5 +13,6 @@   s2 :: SWord8 = s0 + s1   s3 :: SWord8 = s1 - s0   s4 :: SWord8 = s2 * s3+CONSTRAINTS OUTPUTS   s4
SBVUnitTest/GoldFiles/basic-2_2.gold view
@@ -12,5 +12,6 @@ DEFINE   s2 :: SWord8 = s0 * s0   s3 :: SWord8 = s1 - s2+CONSTRAINTS OUTPUTS   s3
SBVUnitTest/GoldFiles/basic-2_3.gold view
@@ -12,5 +12,6 @@ DEFINE   s2 :: SWord8 = s0 + s1   s3 :: SWord8 = s2 * s2+CONSTRAINTS OUTPUTS   s3
SBVUnitTest/GoldFiles/basic-2_4.gold view
@@ -12,5 +12,6 @@ DEFINE   s2 :: SWord8 = s0 + s1   s3 :: SWord8 = s2 * s2+CONSTRAINTS OUTPUTS   s3
SBVUnitTest/GoldFiles/basic-3_1.gold view
@@ -13,5 +13,6 @@   s2 :: SWord8 = s0 + s1   s3 :: SWord8 = s0 - s1   s4 :: SWord8 = s2 * s3+CONSTRAINTS OUTPUTS   s4
SBVUnitTest/GoldFiles/basic-3_2.gold view
@@ -13,5 +13,6 @@   s2 :: SWord8 = s0 * s0   s3 :: SWord8 = s1 * s1   s4 :: SWord8 = s2 - s3+CONSTRAINTS OUTPUTS   s4
SBVUnitTest/GoldFiles/basic-3_3.gold view
@@ -12,5 +12,6 @@ DEFINE   s2 :: SWord8 = s0 + s1   s3 :: SWord8 = s2 * s2+CONSTRAINTS OUTPUTS   s3
SBVUnitTest/GoldFiles/basic-3_4.gold view
@@ -12,5 +12,6 @@ DEFINE   s2 :: SWord8 = s0 + s1   s3 :: SWord8 = s2 * s2+CONSTRAINTS OUTPUTS   s3
SBVUnitTest/GoldFiles/basic-3_5.gold view
@@ -12,5 +12,6 @@ AXIOMS DEFINE   s3 :: SWord8 = s0 + s2+CONSTRAINTS OUTPUTS   s3
SBVUnitTest/GoldFiles/basic-4_1.gold view
@@ -12,5 +12,6 @@   s1 :: SWord8 = s0 + s0   s2 :: SWord8 = s0 - s0   s3 :: SWord8 = s1 * s2+CONSTRAINTS OUTPUTS   s3
SBVUnitTest/GoldFiles/basic-4_2.gold view
@@ -11,5 +11,6 @@ DEFINE   s1 :: SWord8 = s0 * s0   s2 :: SWord8 = s1 - s1+CONSTRAINTS OUTPUTS   s2
SBVUnitTest/GoldFiles/basic-4_3.gold view
@@ -11,5 +11,6 @@ DEFINE   s1 :: SWord8 = s0 + s0   s2 :: SWord8 = s1 * s1+CONSTRAINTS OUTPUTS   s2
SBVUnitTest/GoldFiles/basic-4_4.gold view
@@ -11,5 +11,6 @@ DEFINE   s1 :: SWord8 = s0 + s0   s2 :: SWord8 = s1 * s1+CONSTRAINTS OUTPUTS   s2
SBVUnitTest/GoldFiles/basic-4_5.gold view
@@ -11,5 +11,6 @@ AXIOMS DEFINE   s2 :: SWord8 = s0 + s1+CONSTRAINTS OUTPUTS   s2
SBVUnitTest/GoldFiles/basic-5_1.gold view
@@ -13,6 +13,7 @@   s2 :: SWord8 = s0 + s0   s3 :: SWord8 = s0 - s0   s4 :: SWord8 = s2 * s3+CONSTRAINTS OUTPUTS   s1   s4
SBVUnitTest/GoldFiles/basic-5_2.gold view
@@ -12,6 +12,7 @@ DEFINE   s2 :: SWord8 = s0 * s0   s3 :: SWord8 = s2 - s2+CONSTRAINTS OUTPUTS   s1   s3
SBVUnitTest/GoldFiles/basic-5_3.gold view
@@ -12,6 +12,7 @@ DEFINE   s2 :: SWord8 = s0 + s0   s3 :: SWord8 = s2 * s2+CONSTRAINTS OUTPUTS   s1   s3
SBVUnitTest/GoldFiles/basic-5_4.gold view
@@ -12,6 +12,7 @@ DEFINE   s2 :: SWord8 = s0 + s0   s3 :: SWord8 = s2 * s2+CONSTRAINTS OUTPUTS   s1   s3
SBVUnitTest/GoldFiles/basic-5_5.gold view
@@ -12,6 +12,7 @@ AXIOMS DEFINE   s3 :: SWord8 = s0 + s2+CONSTRAINTS OUTPUTS   s1   s3
SBVUnitTest/GoldFiles/ccitt.gold view
@@ -1825,5 +1825,6 @@   s1813 :: SWord8 = if s1369 then s1811 else s1812   s1815 :: SBool = s1813 > s1814   s1816 :: SBool = s8 | s1815+CONSTRAINTS OUTPUTS   s1816
+ SBVUnitTest/GoldFiles/coins.gold view
@@ -0,0 +1,915 @@+INPUTS+  s0 :: SWord16, existential, aliasing "c1"+  s18 :: SWord16, existential, aliasing "c2"+  s30 :: SWord16, existential, aliasing "c3"+  s42 :: SWord16, existential, aliasing "c4"+  s54 :: SWord16, existential, aliasing "c5"+  s66 :: SWord16, existential, aliasing "c6"+CONSTANTS+  s_2 = False+  s_1 = True+  s1 = 1 :: SWord16+  s3 = 5 :: SWord16+  s5 = 10 :: SWord16+  s7 = 25 :: SWord16+  s9 = 50 :: SWord16+  s11 = 100 :: SWord16+  s84 = 0 :: SWord16+  s88 = 95 :: SWord16+  s551 = 115 :: SWord16+TABLES+ARRAYS+UNINTERPRETED CONSTANTS+USER GIVEN CODE SEGMENTS+AXIOMS+DEFINE+  s2 :: SBool = s0 == s1+  s4 :: SBool = s0 == s3+  s6 :: SBool = s0 == s5+  s8 :: SBool = s0 == s7+  s10 :: SBool = s0 == s9+  s12 :: SBool = s0 == s11+  s13 :: SBool = s10 | s12+  s14 :: SBool = s8 | s13+  s15 :: SBool = s6 | s14+  s16 :: SBool = s4 | s15+  s17 :: SBool = s2 | s16+  s19 :: SBool = s1 == s18+  s20 :: SBool = s3 == s18+  s21 :: SBool = s5 == s18+  s22 :: SBool = s7 == s18+  s23 :: SBool = s9 == s18+  s24 :: SBool = s11 == s18+  s25 :: SBool = s23 | s24+  s26 :: SBool = s22 | s25+  s27 :: SBool = s21 | s26+  s28 :: SBool = s20 | s27+  s29 :: SBool = s19 | s28+  s31 :: SBool = s1 == s30+  s32 :: SBool = s3 == s30+  s33 :: SBool = s5 == s30+  s34 :: SBool = s7 == s30+  s35 :: SBool = s9 == s30+  s36 :: SBool = s11 == s30+  s37 :: SBool = s35 | s36+  s38 :: SBool = s34 | s37+  s39 :: SBool = s33 | s38+  s40 :: SBool = s32 | s39+  s41 :: SBool = s31 | s40+  s43 :: SBool = s1 == s42+  s44 :: SBool = s3 == s42+  s45 :: SBool = s5 == s42+  s46 :: SBool = s7 == s42+  s47 :: SBool = s9 == s42+  s48 :: SBool = s11 == s42+  s49 :: SBool = s47 | s48+  s50 :: SBool = s46 | s49+  s51 :: SBool = s45 | s50+  s52 :: SBool = s44 | s51+  s53 :: SBool = s43 | s52+  s55 :: SBool = s1 == s54+  s56 :: SBool = s3 == s54+  s57 :: SBool = s5 == s54+  s58 :: SBool = s7 == s54+  s59 :: SBool = s9 == s54+  s60 :: SBool = s11 == s54+  s61 :: SBool = s59 | s60+  s62 :: SBool = s58 | s61+  s63 :: SBool = s57 | s62+  s64 :: SBool = s56 | s63+  s65 :: SBool = s55 | s64+  s67 :: SBool = s1 == s66+  s68 :: SBool = s3 == s66+  s69 :: SBool = s5 == s66+  s70 :: SBool = s7 == s66+  s71 :: SBool = s9 == s66+  s72 :: SBool = s11 == s66+  s73 :: SBool = s71 | s72+  s74 :: SBool = s70 | s73+  s75 :: SBool = s69 | s74+  s76 :: SBool = s68 | s75+  s77 :: SBool = s67 | s76+  s78 :: SWord16 = s0 + s18+  s79 :: SBool = s11 /= s78+  s80 :: SBool = s9 /= s78+  s81 :: SBool = s7 /= s78+  s82 :: SBool = s5 /= s78+  s83 :: SBool = s3 /= s78+  s85 :: SWord16 = if s10 then s84 else s0+  s86 :: SWord16 = if s23 then s84 else s18+  s87 :: SWord16 = s85 + s86+  s89 :: SBool = s87 /= s88+  s90 :: SWord16 = s0 + s30+  s91 :: SBool = s11 /= s90+  s92 :: SBool = s9 /= s90+  s93 :: SBool = s7 /= s90+  s94 :: SBool = s5 /= s90+  s95 :: SBool = s3 /= s90+  s96 :: SWord16 = if s35 then s84 else s30+  s97 :: SWord16 = s85 + s96+  s98 :: SBool = s88 /= s97+  s99 :: SWord16 = s0 + s42+  s100 :: SBool = s11 /= s99+  s101 :: SBool = s9 /= s99+  s102 :: SBool = s7 /= s99+  s103 :: SBool = s5 /= s99+  s104 :: SBool = s3 /= s99+  s105 :: SWord16 = if s47 then s84 else s42+  s106 :: SWord16 = s85 + s105+  s107 :: SBool = s88 /= s106+  s108 :: SWord16 = s0 + s54+  s109 :: SBool = s11 /= s108+  s110 :: SBool = s9 /= s108+  s111 :: SBool = s7 /= s108+  s112 :: SBool = s5 /= s108+  s113 :: SBool = s3 /= s108+  s114 :: SWord16 = if s59 then s84 else s54+  s115 :: SWord16 = s85 + s114+  s116 :: SBool = s88 /= s115+  s117 :: SWord16 = s0 + s66+  s118 :: SBool = s11 /= s117+  s119 :: SBool = s9 /= s117+  s120 :: SBool = s7 /= s117+  s121 :: SBool = s5 /= s117+  s122 :: SBool = s3 /= s117+  s123 :: SWord16 = if s71 then s84 else s66+  s124 :: SWord16 = s85 + s123+  s125 :: SBool = s88 /= s124+  s126 :: SWord16 = s18 + s30+  s127 :: SBool = s11 /= s126+  s128 :: SBool = s9 /= s126+  s129 :: SBool = s7 /= s126+  s130 :: SBool = s5 /= s126+  s131 :: SBool = s3 /= s126+  s132 :: SWord16 = s86 + s96+  s133 :: SBool = s88 /= s132+  s134 :: SWord16 = s18 + s42+  s135 :: SBool = s11 /= s134+  s136 :: SBool = s9 /= s134+  s137 :: SBool = s7 /= s134+  s138 :: SBool = s5 /= s134+  s139 :: SBool = s3 /= s134+  s140 :: SWord16 = s86 + s105+  s141 :: SBool = s88 /= s140+  s142 :: SWord16 = s18 + s54+  s143 :: SBool = s11 /= s142+  s144 :: SBool = s9 /= s142+  s145 :: SBool = s7 /= s142+  s146 :: SBool = s5 /= s142+  s147 :: SBool = s3 /= s142+  s148 :: SWord16 = s86 + s114+  s149 :: SBool = s88 /= s148+  s150 :: SWord16 = s18 + s66+  s151 :: SBool = s11 /= s150+  s152 :: SBool = s9 /= s150+  s153 :: SBool = s7 /= s150+  s154 :: SBool = s5 /= s150+  s155 :: SBool = s3 /= s150+  s156 :: SWord16 = s86 + s123+  s157 :: SBool = s88 /= s156+  s158 :: SWord16 = s30 + s42+  s159 :: SBool = s11 /= s158+  s160 :: SBool = s9 /= s158+  s161 :: SBool = s7 /= s158+  s162 :: SBool = s5 /= s158+  s163 :: SBool = s3 /= s158+  s164 :: SWord16 = s96 + s105+  s165 :: SBool = s88 /= s164+  s166 :: SWord16 = s30 + s54+  s167 :: SBool = s11 /= s166+  s168 :: SBool = s9 /= s166+  s169 :: SBool = s7 /= s166+  s170 :: SBool = s5 /= s166+  s171 :: SBool = s3 /= s166+  s172 :: SWord16 = s96 + s114+  s173 :: SBool = s88 /= s172+  s174 :: SWord16 = s30 + s66+  s175 :: SBool = s11 /= s174+  s176 :: SBool = s9 /= s174+  s177 :: SBool = s7 /= s174+  s178 :: SBool = s5 /= s174+  s179 :: SBool = s3 /= s174+  s180 :: SWord16 = s96 + s123+  s181 :: SBool = s88 /= s180+  s182 :: SWord16 = s42 + s54+  s183 :: SBool = s11 /= s182+  s184 :: SBool = s9 /= s182+  s185 :: SBool = s7 /= s182+  s186 :: SBool = s5 /= s182+  s187 :: SBool = s3 /= s182+  s188 :: SWord16 = s105 + s114+  s189 :: SBool = s88 /= s188+  s190 :: SWord16 = s42 + s66+  s191 :: SBool = s11 /= s190+  s192 :: SBool = s9 /= s190+  s193 :: SBool = s7 /= s190+  s194 :: SBool = s5 /= s190+  s195 :: SBool = s3 /= s190+  s196 :: SWord16 = s105 + s123+  s197 :: SBool = s88 /= s196+  s198 :: SWord16 = s54 + s66+  s199 :: SBool = s11 /= s198+  s200 :: SBool = s9 /= s198+  s201 :: SBool = s7 /= s198+  s202 :: SBool = s5 /= s198+  s203 :: SBool = s3 /= s198+  s204 :: SWord16 = s114 + s123+  s205 :: SBool = s88 /= s204+  s206 :: SWord16 = s30 + s78+  s207 :: SBool = s11 /= s206+  s208 :: SBool = s9 /= s206+  s209 :: SBool = s7 /= s206+  s210 :: SBool = s5 /= s206+  s211 :: SBool = s3 /= s206+  s212 :: SWord16 = s87 + s96+  s213 :: SBool = s88 /= s212+  s214 :: SWord16 = s42 + s78+  s215 :: SBool = s11 /= s214+  s216 :: SBool = s9 /= s214+  s217 :: SBool = s7 /= s214+  s218 :: SBool = s5 /= s214+  s219 :: SBool = s3 /= s214+  s220 :: SWord16 = s87 + s105+  s221 :: SBool = s88 /= s220+  s222 :: SWord16 = s54 + s78+  s223 :: SBool = s11 /= s222+  s224 :: SBool = s9 /= s222+  s225 :: SBool = s7 /= s222+  s226 :: SBool = s5 /= s222+  s227 :: SBool = s3 /= s222+  s228 :: SWord16 = s87 + s114+  s229 :: SBool = s88 /= s228+  s230 :: SWord16 = s66 + s78+  s231 :: SBool = s11 /= s230+  s232 :: SBool = s9 /= s230+  s233 :: SBool = s7 /= s230+  s234 :: SBool = s5 /= s230+  s235 :: SBool = s3 /= s230+  s236 :: SWord16 = s87 + s123+  s237 :: SBool = s88 /= s236+  s238 :: SWord16 = s42 + s90+  s239 :: SBool = s11 /= s238+  s240 :: SBool = s9 /= s238+  s241 :: SBool = s7 /= s238+  s242 :: SBool = s5 /= s238+  s243 :: SBool = s3 /= s238+  s244 :: SWord16 = s97 + s105+  s245 :: SBool = s88 /= s244+  s246 :: SWord16 = s54 + s90+  s247 :: SBool = s11 /= s246+  s248 :: SBool = s9 /= s246+  s249 :: SBool = s7 /= s246+  s250 :: SBool = s5 /= s246+  s251 :: SBool = s3 /= s246+  s252 :: SWord16 = s97 + s114+  s253 :: SBool = s88 /= s252+  s254 :: SWord16 = s66 + s90+  s255 :: SBool = s11 /= s254+  s256 :: SBool = s9 /= s254+  s257 :: SBool = s7 /= s254+  s258 :: SBool = s5 /= s254+  s259 :: SBool = s3 /= s254+  s260 :: SWord16 = s97 + s123+  s261 :: SBool = s88 /= s260+  s262 :: SWord16 = s54 + s99+  s263 :: SBool = s11 /= s262+  s264 :: SBool = s9 /= s262+  s265 :: SBool = s7 /= s262+  s266 :: SBool = s5 /= s262+  s267 :: SBool = s3 /= s262+  s268 :: SWord16 = s106 + s114+  s269 :: SBool = s88 /= s268+  s270 :: SWord16 = s66 + s99+  s271 :: SBool = s11 /= s270+  s272 :: SBool = s9 /= s270+  s273 :: SBool = s7 /= s270+  s274 :: SBool = s5 /= s270+  s275 :: SBool = s3 /= s270+  s276 :: SWord16 = s106 + s123+  s277 :: SBool = s88 /= s276+  s278 :: SWord16 = s66 + s108+  s279 :: SBool = s11 /= s278+  s280 :: SBool = s9 /= s278+  s281 :: SBool = s7 /= s278+  s282 :: SBool = s5 /= s278+  s283 :: SBool = s3 /= s278+  s284 :: SWord16 = s115 + s123+  s285 :: SBool = s88 /= s284+  s286 :: SWord16 = s42 + s126+  s287 :: SBool = s11 /= s286+  s288 :: SBool = s9 /= s286+  s289 :: SBool = s7 /= s286+  s290 :: SBool = s5 /= s286+  s291 :: SBool = s3 /= s286+  s292 :: SWord16 = s105 + s132+  s293 :: SBool = s88 /= s292+  s294 :: SWord16 = s54 + s126+  s295 :: SBool = s11 /= s294+  s296 :: SBool = s9 /= s294+  s297 :: SBool = s7 /= s294+  s298 :: SBool = s5 /= s294+  s299 :: SBool = s3 /= s294+  s300 :: SWord16 = s114 + s132+  s301 :: SBool = s88 /= s300+  s302 :: SWord16 = s66 + s126+  s303 :: SBool = s11 /= s302+  s304 :: SBool = s9 /= s302+  s305 :: SBool = s7 /= s302+  s306 :: SBool = s5 /= s302+  s307 :: SBool = s3 /= s302+  s308 :: SWord16 = s123 + s132+  s309 :: SBool = s88 /= s308+  s310 :: SWord16 = s54 + s134+  s311 :: SBool = s11 /= s310+  s312 :: SBool = s9 /= s310+  s313 :: SBool = s7 /= s310+  s314 :: SBool = s5 /= s310+  s315 :: SBool = s3 /= s310+  s316 :: SWord16 = s114 + s140+  s317 :: SBool = s88 /= s316+  s318 :: SWord16 = s66 + s134+  s319 :: SBool = s11 /= s318+  s320 :: SBool = s9 /= s318+  s321 :: SBool = s7 /= s318+  s322 :: SBool = s5 /= s318+  s323 :: SBool = s3 /= s318+  s324 :: SWord16 = s123 + s140+  s325 :: SBool = s88 /= s324+  s326 :: SWord16 = s66 + s142+  s327 :: SBool = s11 /= s326+  s328 :: SBool = s9 /= s326+  s329 :: SBool = s7 /= s326+  s330 :: SBool = s5 /= s326+  s331 :: SBool = s3 /= s326+  s332 :: SWord16 = s123 + s148+  s333 :: SBool = s88 /= s332+  s334 :: SWord16 = s54 + s158+  s335 :: SBool = s11 /= s334+  s336 :: SBool = s9 /= s334+  s337 :: SBool = s7 /= s334+  s338 :: SBool = s5 /= s334+  s339 :: SBool = s3 /= s334+  s340 :: SWord16 = s114 + s164+  s341 :: SBool = s88 /= s340+  s342 :: SWord16 = s66 + s158+  s343 :: SBool = s11 /= s342+  s344 :: SBool = s9 /= s342+  s345 :: SBool = s7 /= s342+  s346 :: SBool = s5 /= s342+  s347 :: SBool = s3 /= s342+  s348 :: SWord16 = s123 + s164+  s349 :: SBool = s88 /= s348+  s350 :: SWord16 = s66 + s166+  s351 :: SBool = s11 /= s350+  s352 :: SBool = s9 /= s350+  s353 :: SBool = s7 /= s350+  s354 :: SBool = s5 /= s350+  s355 :: SBool = s3 /= s350+  s356 :: SWord16 = s123 + s172+  s357 :: SBool = s88 /= s356+  s358 :: SWord16 = s66 + s182+  s359 :: SBool = s11 /= s358+  s360 :: SBool = s9 /= s358+  s361 :: SBool = s7 /= s358+  s362 :: SBool = s5 /= s358+  s363 :: SBool = s3 /= s358+  s364 :: SWord16 = s123 + s188+  s365 :: SBool = s88 /= s364+  s366 :: SWord16 = s42 + s206+  s367 :: SBool = s11 /= s366+  s368 :: SBool = s9 /= s366+  s369 :: SBool = s7 /= s366+  s370 :: SBool = s5 /= s366+  s371 :: SBool = s3 /= s366+  s372 :: SWord16 = s105 + s212+  s373 :: SBool = s88 /= s372+  s374 :: SWord16 = s54 + s206+  s375 :: SBool = s11 /= s374+  s376 :: SBool = s9 /= s374+  s377 :: SBool = s7 /= s374+  s378 :: SBool = s5 /= s374+  s379 :: SBool = s3 /= s374+  s380 :: SWord16 = s114 + s212+  s381 :: SBool = s88 /= s380+  s382 :: SWord16 = s66 + s206+  s383 :: SBool = s11 /= s382+  s384 :: SBool = s9 /= s382+  s385 :: SBool = s7 /= s382+  s386 :: SBool = s5 /= s382+  s387 :: SBool = s3 /= s382+  s388 :: SWord16 = s123 + s212+  s389 :: SBool = s88 /= s388+  s390 :: SWord16 = s54 + s214+  s391 :: SBool = s11 /= s390+  s392 :: SBool = s9 /= s390+  s393 :: SBool = s7 /= s390+  s394 :: SBool = s5 /= s390+  s395 :: SBool = s3 /= s390+  s396 :: SWord16 = s114 + s220+  s397 :: SBool = s88 /= s396+  s398 :: SWord16 = s66 + s214+  s399 :: SBool = s11 /= s398+  s400 :: SBool = s9 /= s398+  s401 :: SBool = s7 /= s398+  s402 :: SBool = s5 /= s398+  s403 :: SBool = s3 /= s398+  s404 :: SWord16 = s123 + s220+  s405 :: SBool = s88 /= s404+  s406 :: SWord16 = s66 + s222+  s407 :: SBool = s11 /= s406+  s408 :: SBool = s9 /= s406+  s409 :: SBool = s7 /= s406+  s410 :: SBool = s5 /= s406+  s411 :: SBool = s3 /= s406+  s412 :: SWord16 = s123 + s228+  s413 :: SBool = s88 /= s412+  s414 :: SWord16 = s54 + s238+  s415 :: SBool = s11 /= s414+  s416 :: SBool = s9 /= s414+  s417 :: SBool = s7 /= s414+  s418 :: SBool = s5 /= s414+  s419 :: SBool = s3 /= s414+  s420 :: SWord16 = s114 + s244+  s421 :: SBool = s88 /= s420+  s422 :: SWord16 = s66 + s238+  s423 :: SBool = s11 /= s422+  s424 :: SBool = s9 /= s422+  s425 :: SBool = s7 /= s422+  s426 :: SBool = s5 /= s422+  s427 :: SBool = s3 /= s422+  s428 :: SWord16 = s123 + s244+  s429 :: SBool = s88 /= s428+  s430 :: SWord16 = s66 + s246+  s431 :: SBool = s11 /= s430+  s432 :: SBool = s9 /= s430+  s433 :: SBool = s7 /= s430+  s434 :: SBool = s5 /= s430+  s435 :: SBool = s3 /= s430+  s436 :: SWord16 = s123 + s252+  s437 :: SBool = s88 /= s436+  s438 :: SWord16 = s66 + s262+  s439 :: SBool = s11 /= s438+  s440 :: SBool = s9 /= s438+  s441 :: SBool = s7 /= s438+  s442 :: SBool = s5 /= s438+  s443 :: SBool = s3 /= s438+  s444 :: SWord16 = s123 + s268+  s445 :: SBool = s88 /= s444+  s446 :: SWord16 = s54 + s286+  s447 :: SBool = s11 /= s446+  s448 :: SBool = s9 /= s446+  s449 :: SBool = s7 /= s446+  s450 :: SBool = s5 /= s446+  s451 :: SBool = s3 /= s446+  s452 :: SWord16 = s114 + s292+  s453 :: SBool = s88 /= s452+  s454 :: SWord16 = s66 + s286+  s455 :: SBool = s11 /= s454+  s456 :: SBool = s9 /= s454+  s457 :: SBool = s7 /= s454+  s458 :: SBool = s5 /= s454+  s459 :: SBool = s3 /= s454+  s460 :: SWord16 = s123 + s292+  s461 :: SBool = s88 /= s460+  s462 :: SWord16 = s66 + s294+  s463 :: SBool = s11 /= s462+  s464 :: SBool = s9 /= s462+  s465 :: SBool = s7 /= s462+  s466 :: SBool = s5 /= s462+  s467 :: SBool = s3 /= s462+  s468 :: SWord16 = s123 + s300+  s469 :: SBool = s88 /= s468+  s470 :: SWord16 = s66 + s310+  s471 :: SBool = s11 /= s470+  s472 :: SBool = s9 /= s470+  s473 :: SBool = s7 /= s470+  s474 :: SBool = s5 /= s470+  s475 :: SBool = s3 /= s470+  s476 :: SWord16 = s123 + s316+  s477 :: SBool = s88 /= s476+  s478 :: SWord16 = s66 + s334+  s479 :: SBool = s11 /= s478+  s480 :: SBool = s9 /= s478+  s481 :: SBool = s7 /= s478+  s482 :: SBool = s5 /= s478+  s483 :: SBool = s3 /= s478+  s484 :: SWord16 = s123 + s340+  s485 :: SBool = s88 /= s484+  s486 :: SWord16 = s54 + s366+  s487 :: SBool = s11 /= s486+  s488 :: SBool = s9 /= s486+  s489 :: SBool = s7 /= s486+  s490 :: SBool = s5 /= s486+  s491 :: SBool = s3 /= s486+  s492 :: SWord16 = s114 + s372+  s493 :: SBool = s88 /= s492+  s494 :: SWord16 = s66 + s366+  s495 :: SBool = s11 /= s494+  s496 :: SBool = s9 /= s494+  s497 :: SBool = s7 /= s494+  s498 :: SBool = s5 /= s494+  s499 :: SBool = s3 /= s494+  s500 :: SWord16 = s123 + s372+  s501 :: SBool = s88 /= s500+  s502 :: SWord16 = s66 + s374+  s503 :: SBool = s11 /= s502+  s504 :: SBool = s9 /= s502+  s505 :: SBool = s7 /= s502+  s506 :: SBool = s5 /= s502+  s507 :: SBool = s3 /= s502+  s508 :: SWord16 = s123 + s380+  s509 :: SBool = s88 /= s508+  s510 :: SWord16 = s66 + s390+  s511 :: SBool = s11 /= s510+  s512 :: SBool = s9 /= s510+  s513 :: SBool = s7 /= s510+  s514 :: SBool = s5 /= s510+  s515 :: SBool = s3 /= s510+  s516 :: SWord16 = s123 + s396+  s517 :: SBool = s88 /= s516+  s518 :: SWord16 = s66 + s414+  s519 :: SBool = s11 /= s518+  s520 :: SBool = s9 /= s518+  s521 :: SBool = s7 /= s518+  s522 :: SBool = s5 /= s518+  s523 :: SBool = s3 /= s518+  s524 :: SWord16 = s123 + s420+  s525 :: SBool = s88 /= s524+  s526 :: SWord16 = s66 + s446+  s527 :: SBool = s11 /= s526+  s528 :: SBool = s9 /= s526+  s529 :: SBool = s7 /= s526+  s530 :: SBool = s5 /= s526+  s531 :: SBool = s3 /= s526+  s532 :: SWord16 = s123 + s452+  s533 :: SBool = s88 /= s532+  s534 :: SWord16 = s66 + s486+  s535 :: SBool = s11 /= s534+  s536 :: SBool = s9 /= s534+  s537 :: SBool = s7 /= s534+  s538 :: SBool = s5 /= s534+  s539 :: SBool = s3 /= s534+  s540 :: SWord16 = s123 + s492+  s541 :: SBool = s88 /= s540+  s542 :: SBool = s0 > s18+  s543 :: SBool = s18 > s30+  s544 :: SBool = s30 > s42+  s545 :: SBool = s42 > s54+  s546 :: SBool = s54 > s66+  s547 :: SBool = s545 & s546+  s548 :: SBool = s544 & s547+  s549 :: SBool = s543 & s548+  s550 :: SBool = s542 & s549+  s552 :: SBool = s534 == s551+CONSTRAINTS+  s17+  s29+  s41+  s53+  s65+  s77+  s79+  s80+  s81+  s82+  s83+  s89+  s91+  s92+  s93+  s94+  s95+  s98+  s100+  s101+  s102+  s103+  s104+  s107+  s109+  s110+  s111+  s112+  s113+  s116+  s118+  s119+  s120+  s121+  s122+  s125+  s127+  s128+  s129+  s130+  s131+  s133+  s135+  s136+  s137+  s138+  s139+  s141+  s143+  s144+  s145+  s146+  s147+  s149+  s151+  s152+  s153+  s154+  s155+  s157+  s159+  s160+  s161+  s162+  s163+  s165+  s167+  s168+  s169+  s170+  s171+  s173+  s175+  s176+  s177+  s178+  s179+  s181+  s183+  s184+  s185+  s186+  s187+  s189+  s191+  s192+  s193+  s194+  s195+  s197+  s199+  s200+  s201+  s202+  s203+  s205+  s207+  s208+  s209+  s210+  s211+  s213+  s215+  s216+  s217+  s218+  s219+  s221+  s223+  s224+  s225+  s226+  s227+  s229+  s231+  s232+  s233+  s234+  s235+  s237+  s239+  s240+  s241+  s242+  s243+  s245+  s247+  s248+  s249+  s250+  s251+  s253+  s255+  s256+  s257+  s258+  s259+  s261+  s263+  s264+  s265+  s266+  s267+  s269+  s271+  s272+  s273+  s274+  s275+  s277+  s279+  s280+  s281+  s282+  s283+  s285+  s287+  s288+  s289+  s290+  s291+  s293+  s295+  s296+  s297+  s298+  s299+  s301+  s303+  s304+  s305+  s306+  s307+  s309+  s311+  s312+  s313+  s314+  s315+  s317+  s319+  s320+  s321+  s322+  s323+  s325+  s327+  s328+  s329+  s330+  s331+  s333+  s335+  s336+  s337+  s338+  s339+  s341+  s343+  s344+  s345+  s346+  s347+  s349+  s351+  s352+  s353+  s354+  s355+  s357+  s359+  s360+  s361+  s362+  s363+  s365+  s367+  s368+  s369+  s370+  s371+  s373+  s375+  s376+  s377+  s378+  s379+  s381+  s383+  s384+  s385+  s386+  s387+  s389+  s391+  s392+  s393+  s394+  s395+  s397+  s399+  s400+  s401+  s402+  s403+  s405+  s407+  s408+  s409+  s410+  s411+  s413+  s415+  s416+  s417+  s418+  s419+  s421+  s423+  s424+  s425+  s426+  s427+  s429+  s431+  s432+  s433+  s434+  s435+  s437+  s439+  s440+  s441+  s442+  s443+  s445+  s447+  s448+  s449+  s450+  s451+  s453+  s455+  s456+  s457+  s458+  s459+  s461+  s463+  s464+  s465+  s466+  s467+  s469+  s471+  s472+  s473+  s474+  s475+  s477+  s479+  s480+  s481+  s482+  s483+  s485+  s487+  s488+  s489+  s490+  s491+  s493+  s495+  s496+  s497+  s498+  s499+  s501+  s503+  s504+  s505+  s506+  s507+  s509+  s511+  s512+  s513+  s514+  s515+  s517+  s519+  s520+  s521+  s522+  s523+  s525+  s527+  s528+  s529+  s530+  s531+  s533+  s535+  s536+  s537+  s538+  s539+  s541+  s550+OUTPUTS+  s552
SBVUnitTest/GoldFiles/counts.gold view
@@ -1699,5 +1699,6 @@   s1688 :: SBool = s554 & s1687   s1689 :: SBool = s394 & s1688   s1690 :: SBool = s234 & s1689+CONSTRAINTS OUTPUTS   s1690
SBVUnitTest/GoldFiles/crcPolyExist.gold view
@@ -3529,5 +3529,6 @@   s3518 :: SBool = s3516 > s3517   s3519 :: SBool = s13 | s3518   s3520 :: SBool = s8 & s3519+CONSTRAINTS OUTPUTS   s3520
SBVUnitTest/GoldFiles/legato.gold view
@@ -8954,5 +8954,6 @@   s8943 :: SWord16 = s8941 * s8942   s8944 :: SBool = s8940 == s8943   s8945 :: SBool = s15 | s8944+CONSTRAINTS OUTPUTS   s8945
SBVUnitTest/GoldFiles/prefixSum_16.gold view
@@ -114,5 +114,6 @@   s89 :: SBool = s24 & s88   s90 :: SBool = s21 & s89   s91 :: SBool = s18 & s90+CONSTRAINTS OUTPUTS   s91
+ SBVUnitTest/SBVTest.hs view
@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  SBVTest+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Integration with HUnit-based test suite for SBV+-----------------------------------------------------------------------------++{-# LANGUAGE RankNTypes #-}+module SBVTest(generateGoldCheck, showsAs, ioShowsAs, mkTestSuite, SBVTestSuite(..), module Test.HUnit) where++import System.FilePath ((</>))+import Test.HUnit      (Test(..), Assertion, assert, (~:), test)++-- | A Test-suite, parameterized by the gold-check generator/checker+data SBVTestSuite = SBVTestSuite ((forall a. Show a => (IO a -> FilePath -> IO ())) -> Test)++-- | Wrap over 'SBVTestSuite', avoids exporting the constructor+mkTestSuite :: ((forall a. (Show a) => IO a -> FilePath -> IO ()) -> Test) -> SBVTestSuite+mkTestSuite = SBVTestSuite++-- | Checks that a particular result shows as @s@+showsAs :: Show a => a -> String -> Assertion+showsAs r s = assert $ show r == s++-- | Run an IO computation and check that it's result shows as @s@+ioShowsAs :: Show a => IO a -> String -> Assertion+ioShowsAs r s = do v <- r+                   assert $ show v == s++-- | Create a gold file for the test case+generateGoldCheck :: FilePath -> Bool -> (forall a. Show a => IO a -> FilePath -> IO ())+generateGoldCheck goldDir shouldCreate action goldFile+  | shouldCreate = do v <- action+                      writeFile gf (show v)+                      putStrLn $ "\nCreated Gold File: " ++ show gf+                      assert True+  | True         = do v <- action+                      g <- readFile gf+                      assert $ show v == g+ where gf = goldDir </> goldFile
SBVUnitTest/SBVUnitTest.hs view
@@ -10,64 +10,64 @@ -- SBV library unit-test program ----------------------------------------------------------------------------- -module Main(main, createGolds) where--import Control.Monad           (unless, when)-import System.Directory        (doesDirectoryExist, findExecutable)-import System.Environment      (getArgs, getEnv)-import System.Exit             (exitWith, ExitCode(..))-import System.FilePath         ((</>))-import System.Process          (readProcessWithExitCode)-import Test.HUnit              (Test(..), Counts(..), runTestTT)+module Main(main) where -import Data.List               (isPrefixOf)-import Data.SBV                (yices, SMTSolver(..))-import Data.SBV.Utils.SBVTest  (SBVTestSuite(..), generateGoldCheck)-import Paths_sbv               (getDataDir)+import Control.Monad        (unless, when)+import System.Directory     (doesDirectoryExist, findExecutable)+import System.Environment   (getArgs, getEnv)+import System.Exit          (exitWith, ExitCode(..))+import System.FilePath      ((</>))+import System.Process       (readProcessWithExitCode)+import Test.HUnit           (Test(..), Counts(..), runTestTT) -import SBVUnitTest.SBVUnitTestBuildTime (buildTime)+import Data.List            (isPrefixOf)+import Data.SBV             (yices, SMTSolver(..), SMTConfig(..))+import Data.Version         (showVersion)+import SBVTest              (SBVTestSuite(..), generateGoldCheck)+import Paths_sbv            (getDataDir, version) -import qualified Data.SBV.Provers.Yices as Yices+import SBVUnitTestBuildTime (buildTime)  -- To add a new collection of tests, import below and add to testCollection variable-import qualified Data.SBV.TestSuite.Arrays.Memory                  as T01_01(testSuite)-import qualified Data.SBV.TestSuite.Basics.Arithmetic              as T02_01(testSuite)-import qualified Data.SBV.TestSuite.Basics.BasicTests              as T02_02(testSuite)-import qualified Data.SBV.TestSuite.Basics.Higher                  as T02_03(testSuite)-import qualified Data.SBV.TestSuite.Basics.Index                   as T02_04(testSuite)-import qualified Data.SBV.TestSuite.Basics.ProofTests              as T02_05(testSuite)-import qualified Data.SBV.TestSuite.Basics.QRem                    as T02_06(testSuite)-import qualified Data.SBV.TestSuite.BitPrecise.BitTricks           as T03_01(testSuite)-import qualified Data.SBV.TestSuite.BitPrecise.Legato              as T03_02(testSuite)-import qualified Data.SBV.TestSuite.BitPrecise.PrefixSum           as T03_03(testSuite)-import qualified Data.SBV.TestSuite.CRC.CCITT                      as T04_01(testSuite)-import qualified Data.SBV.TestSuite.CRC.CCITT_Unidir               as T04_02(testSuite)-import qualified Data.SBV.TestSuite.CRC.GenPoly                    as T04_03(testSuite)-import qualified Data.SBV.TestSuite.CRC.Parity                     as T04_04(testSuite)-import qualified Data.SBV.TestSuite.CRC.USB5                       as T04_05(testSuite)-import qualified Data.SBV.TestSuite.CodeGeneration.AddSub          as T05_01(testSuite)-import qualified Data.SBV.TestSuite.CodeGeneration.CgTests         as T05_02(testSuite)-import qualified Data.SBV.TestSuite.CodeGeneration.CRC_USB5        as T05_03(testSuite)-import qualified Data.SBV.TestSuite.CodeGeneration.Fibonacci       as T05_04(testSuite)-import qualified Data.SBV.TestSuite.CodeGeneration.GCD             as T05_05(testSuite)-import qualified Data.SBV.TestSuite.CodeGeneration.PopulationCount as T05_06(testSuite)-import qualified Data.SBV.TestSuite.CodeGeneration.Uninterpreted   as T05_07(testSuite)-import qualified Data.SBV.TestSuite.Crypto.AES                     as T06_01(testSuite)-import qualified Data.SBV.TestSuite.Crypto.RC4                     as T06_02(testSuite)-import qualified Data.SBV.TestSuite.Existentials.CRCPolynomial     as T07_01(testSuite)-import qualified Data.SBV.TestSuite.Polynomials.Polynomials        as T08_01(testSuite)-import qualified Data.SBV.TestSuite.Puzzles.Counts                 as T09_01(testSuite)-import qualified Data.SBV.TestSuite.Puzzles.DogCatMouse            as T09_02(testSuite)-import qualified Data.SBV.TestSuite.Puzzles.Euler185               as T09_03(testSuite)-import qualified Data.SBV.TestSuite.Puzzles.MagicSquare            as T09_04(testSuite)-import qualified Data.SBV.TestSuite.Puzzles.NQueens                as T09_05(testSuite)-import qualified Data.SBV.TestSuite.Puzzles.PowerSet               as T09_06(testSuite)-import qualified Data.SBV.TestSuite.Puzzles.Sudoku                 as T09_07(testSuite)-import qualified Data.SBV.TestSuite.Puzzles.Temperature            as T09_08(testSuite)-import qualified Data.SBV.TestSuite.Puzzles.U2Bridge               as T09_09(testSuite)-import qualified Data.SBV.TestSuite.Uninterpreted.AUF              as T10_01(testSuite)-import qualified Data.SBV.TestSuite.Uninterpreted.Function         as T10_02(testSuite)-import qualified Data.SBV.TestSuite.Uninterpreted.Uninterpreted    as T10_03(testSuite)+import qualified TestSuite.Arrays.Memory                  as T01_01(testSuite)+import qualified TestSuite.Basics.Arithmetic              as T02_01(testSuite)+import qualified TestSuite.Basics.BasicTests              as T02_02(testSuite)+import qualified TestSuite.Basics.Higher                  as T02_03(testSuite)+import qualified TestSuite.Basics.Index                   as T02_04(testSuite)+import qualified TestSuite.Basics.ProofTests              as T02_05(testSuite)+import qualified TestSuite.Basics.QRem                    as T02_06(testSuite)+import qualified TestSuite.BitPrecise.BitTricks           as T03_01(testSuite)+import qualified TestSuite.BitPrecise.Legato              as T03_02(testSuite)+import qualified TestSuite.BitPrecise.PrefixSum           as T03_03(testSuite)+import qualified TestSuite.CRC.CCITT                      as T04_01(testSuite)+import qualified TestSuite.CRC.CCITT_Unidir               as T04_02(testSuite)+import qualified TestSuite.CRC.GenPoly                    as T04_03(testSuite)+import qualified TestSuite.CRC.Parity                     as T04_04(testSuite)+import qualified TestSuite.CRC.USB5                       as T04_05(testSuite)+import qualified TestSuite.CodeGeneration.AddSub          as T05_01(testSuite)+import qualified TestSuite.CodeGeneration.CgTests         as T05_02(testSuite)+import qualified TestSuite.CodeGeneration.CRC_USB5        as T05_03(testSuite)+import qualified TestSuite.CodeGeneration.Fibonacci       as T05_04(testSuite)+import qualified TestSuite.CodeGeneration.GCD             as T05_05(testSuite)+import qualified TestSuite.CodeGeneration.PopulationCount as T05_06(testSuite)+import qualified TestSuite.CodeGeneration.Uninterpreted   as T05_07(testSuite)+import qualified TestSuite.Crypto.AES                     as T06_01(testSuite)+import qualified TestSuite.Crypto.RC4                     as T06_02(testSuite)+import qualified TestSuite.Existentials.CRCPolynomial     as T07_01(testSuite)+import qualified TestSuite.Polynomials.Polynomials        as T08_01(testSuite)+import qualified TestSuite.Puzzles.Coins                  as T09_01(testSuite)+import qualified TestSuite.Puzzles.Counts                 as T09_02(testSuite)+import qualified TestSuite.Puzzles.DogCatMouse            as T09_03(testSuite)+import qualified TestSuite.Puzzles.Euler185               as T09_04(testSuite)+import qualified TestSuite.Puzzles.MagicSquare            as T09_05(testSuite)+import qualified TestSuite.Puzzles.NQueens                as T09_06(testSuite)+import qualified TestSuite.Puzzles.PowerSet               as T09_07(testSuite)+import qualified TestSuite.Puzzles.Sudoku                 as T09_08(testSuite)+import qualified TestSuite.Puzzles.Temperature            as T09_09(testSuite)+import qualified TestSuite.Puzzles.U2Bridge               as T09_10(testSuite)+import qualified TestSuite.Uninterpreted.AUF              as T10_01(testSuite)+import qualified TestSuite.Uninterpreted.Function         as T10_02(testSuite)+import qualified TestSuite.Uninterpreted.Uninterpreted    as T10_03(testSuite)  testCollection :: [(String, SBVTestSuite)] testCollection = [@@ -97,15 +97,16 @@      , ("rc4",         T06_02.testSuite)      , ("existPoly",   T07_01.testSuite)      , ("poly",        T08_01.testSuite)-     , ("counts",      T09_01.testSuite)-     , ("dogCatMouse", T09_02.testSuite)-     , ("euler185",    T09_03.testSuite)-     , ("magicSquare", T09_04.testSuite)-     , ("nQueens",     T09_05.testSuite)-     , ("powerset",    T09_06.testSuite)-     , ("sudoku",      T09_07.testSuite)-     , ("temperature", T09_08.testSuite)-     , ("u2bridge",    T09_09.testSuite)+     , ("coins",       T09_01.testSuite)+     , ("counts",      T09_02.testSuite)+     , ("dogCatMouse", T09_03.testSuite)+     , ("euler185",    T09_04.testSuite)+     , ("magicSquare", T09_05.testSuite)+     , ("nQueens",     T09_06.testSuite)+     , ("powerset",    T09_07.testSuite)+     , ("sudoku",      T09_08.testSuite)+     , ("temperature", T09_09.testSuite)+     , ("u2bridge",    T09_10.testSuite)      , ("auf1",        T10_01.testSuite)      , ("auf2",        T10_02.testSuite)      , ("unint",       T10_03.testSuite)@@ -114,12 +115,14 @@ -- No user serviceable parts below..  main :: IO ()-main = do putStrLn $ "*** SBVUnitTester, version time stamp: " ++ buildTime+main = do putStrLn $ "*** SBVUnitTester, version: " ++ showVersion version ++ ", time stamp: " ++ buildTime           tgts <- getArgs           case tgts of             [x] | x `elem` ["-h", "--help", "-?"]                    -> putStrLn "Usage: SBVUnitTests [-l] [targets]" -- Not quite right, but sufficient             ["-l"] -> showTargets+            -- undocumented really+            ("-c":ts) -> createGolds (unwords ts)             _      -> run tgts False []  createGolds :: String -> IO ()@@ -133,7 +136,7 @@                                    exitWith $ ExitFailure 1  checkYices :: IO ()-checkYices = do ex <- getEnv "SBV_YICES" `catch` (\_ -> return (executable Yices.yices))+checkYices = do ex <- getEnv "SBV_YICES" `catch` (\_ -> return (executable (solver yices)))                 mbP <- findExecutable ex                 case mbP of                   Nothing -> do putStrLn $ "*** Cannot find default SMT solver executable for " ++ nm@@ -143,7 +146,7 @@                                 exitWith $ ExitFailure 1                   Just p  -> do putStrLn $ "*** Using solver : " ++ nm ++ " (" ++ show p ++ ")"                                 checkYicesVersion p- where nm = name Yices.yices+ where nm = name (solver yices)  checkYicesVersion :: FilePath -> IO () checkYicesVersion p =@@ -153,7 +156,7 @@                                  exitWith $ ExitFailure 1              ExitSuccess   -> do let isYices1 = "1." `isPrefixOf` yOut -- crude test; might fail..                                  when isYices1 $ putStrLn "*** Yices version 1.X is detected. Version 2.X is strongly recommended!"-                                 opts <- getEnv "SBV_YICES_OPTIONS" `catch` (\_ -> return (unwords (options Yices.yices)))+                                 opts <- getEnv "SBV_YICES_OPTIONS" `catch` (\_ -> return (unwords (options (solver yices))))                                  when (isYices1 && opts /= "-tc -smt -e") $ do                                            putStrLn "*** Either install Yices 2.X, or set the environment variable:"                                            putStrLn "***     SBV_YICES_OPTIONS=\"-tc -smt -e\""@@ -185,7 +188,7 @@ run _       _            _  = error "SBVUnitTests.run: impossible happened!"  decide :: Bool -> Counts -> IO ()-decide shouldCreate cts@(Counts c t e f) = do+decide shouldCreate (Counts c t e f) = do         when (c /= t) $ putStrLn $ "*** Not all test cases were tried. (Only tested " ++ show t ++ " of " ++ show c ++ ")"         when (e /= 0) $ putStrLn $ "*** " ++ show e ++ " (of " ++ show c ++ ") test cases in error."         when (f /= 0) $ putStrLn $ "*** " ++ show f ++ " (of " ++ show c ++ ") test cases failed."
SBVUnitTest/SBVUnitTestBuildTime.hs view
@@ -1,5 +1,5 @@ -- Auto-generated, don't edit-module SBVUnitTest.SBVUnitTestBuildTime (buildTime) where+module SBVUnitTestBuildTime (buildTime) where  buildTime :: String-buildTime = "Sun Dec  4 21:09:15 PST 2011"+buildTime = "Wed Dec 28 00:11:15 PST 2011"
+ SBVUnitTest/TestSuite/Arrays/Memory.hs view
@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Arrays.Memory+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.Arrays.Memory+-----------------------------------------------------------------------------++module TestSuite.Arrays.Memory(testSuite) where++import Data.SBV++import Examples.Arrays.Memory+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+     "memory-raw"           ~: assert       =<< isTheorem raw+   , "memory-waw"           ~: assert       =<< isTheorem waw+   , "memory-wcommute-bad"  ~: assert . not =<< isTheorem wcommutesBad+   , "memory-wcommute-good" ~: assert       =<< isTheorem wcommutesGood+   ]
+ SBVUnitTest/TestSuite/Basics/Arithmetic.hs view
@@ -0,0 +1,188 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Basics.Arithmetic+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for basic concrete arithmetic+-----------------------------------------------------------------------------++{-# LANGUAGE Rank2Types #-}++module TestSuite.Basics.Arithmetic(testSuite) where++import Data.SBV++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test $+        genBinTest "+"                (+)+     ++ genBinTest "-"                (-)+     ++ genBinTest "*"                (*)+     ++ genUnTest  "negate"           negate+     ++ genUnTest  "abs"              abs+     ++ genUnTest  "signum"           signum+     ++ genBinTest ".&."              (.&.)+     ++ genBinTest ".|."              (.|.)+     ++ genBinTest "xor"              xor+     ++ genUnTest  "complement"       complement+     ++ genIntTest "shift"            shift+     ++ genIntTest "rotate"           rotate+     ++ genIntTest "setBit"           setBit+     ++ genIntTest "clearBit"         clearBit+     ++ genIntTest "complementBit"    complementBit+     ++ genIntTest "shiftL"           shiftL+     ++ genIntTest "shiftR"           shiftR+     ++ genIntTest "rotateL"          rotateL+     ++ genIntTest "rotateR"          rotateR+     ++ genBlasts+     ++ genCasts++genBinTest :: String -> (forall a. Bits a => a -> a -> a) -> [Test]+genBinTest nm op = map mkTest $+        zipWith pair [(show x, show y, x `op` y) | x <- w8s,  y <- w8s ] [x `op` y | x <- sw8s,  y <- sw8s]+     ++ zipWith pair [(show x, show y, x `op` y) | x <- w16s, y <- w16s] [x `op` y | x <- sw16s, y <- sw16s]+     ++ zipWith pair [(show x, show y, x `op` y) | x <- w32s, y <- w32s] [x `op` y | x <- sw32s, y <- sw32s]+     ++ zipWith pair [(show x, show y, x `op` y) | x <- w64s, y <- w64s] [x `op` y | x <- sw64s, y <- sw64s]+     ++ zipWith pair [(show x, show y, x `op` y) | x <- i8s,  y <- i8s ] [x `op` y | x <- si8s,  y <- si8s]+     ++ zipWith pair [(show x, show y, x `op` y) | x <- i16s, y <- i16s] [x `op` y | x <- si16s, y <- si16s]+     ++ zipWith pair [(show x, show y, x `op` y) | x <- i32s, y <- i32s] [x `op` y | x <- si32s, y <- si32s]+     ++ zipWith pair [(show x, show y, x `op` y) | x <- i64s, y <- i64s] [x `op` y | x <- si64s, y <- si64s]+     ++ zipWith pair [(show x, show y, x `op` y) | x <- iUBs, y <- iUBs] [x `op` y | x <- siUBs, y <- siUBs]+  where pair (x, y, a) b   = (x, y, show (fromIntegral a `asTypeOf` b) == show b)+        mkTest (x, y, s) = "arithmetic-" ++ nm ++ "." ++ x ++ "_" ++ y  ~: s `showsAs` "True"++genUnTest :: String -> (forall a. Bits a => a -> a) -> [Test]+genUnTest nm op = map mkTest $+        zipWith pair [(show x, op x) | x <- w8s ] [op x | x <- sw8s ]+     ++ zipWith pair [(show x, op x) | x <- w16s] [op x | x <- sw16s]+     ++ zipWith pair [(show x, op x) | x <- w32s] [op x | x <- sw32s]+     ++ zipWith pair [(show x, op x) | x <- w64s] [op x | x <- sw64s]+     ++ zipWith pair [(show x, op x) | x <- i8s ] [op x | x <- si8s ]+     ++ zipWith pair [(show x, op x) | x <- i16s] [op x | x <- si16s]+     ++ zipWith pair [(show x, op x) | x <- i32s] [op x | x <- si32s]+     ++ zipWith pair [(show x, op x) | x <- i64s] [op x | x <- si64s]+     ++ zipWith pair [(show x, op x) | x <- iUBs] [op x | x <- siUBs]+  where pair (x, a) b   = (x, show (fromIntegral a `asTypeOf` b) == show b)+        mkTest (x, s) = "arithmetic-" ++ nm ++ "." ++ x ~: s `showsAs` "True"++genIntTest :: String -> (forall a. Bits a => a -> Int -> a) -> [Test]+genIntTest nm op = map mkTest $+        zipWith pair [("u8",  show x, show y, x `op` y) | x <- w8s,  y <- is] [x `op` y | x <- sw8s,  y <- is]+     ++ zipWith pair [("u16", show x, show y, x `op` y) | x <- w16s, y <- is] [x `op` y | x <- sw16s, y <- is]+     ++ zipWith pair [("u32", show x, show y, x `op` y) | x <- w32s, y <- is] [x `op` y | x <- sw32s, y <- is]+     ++ zipWith pair [("u64", show x, show y, x `op` y) | x <- w64s, y <- is] [x `op` y | x <- sw64s, y <- is]+     ++ zipWith pair [("s8",  show x, show y, x `op` y) | x <- i8s,  y <- is] [x `op` y | x <- si8s,  y <- is]+     ++ zipWith pair [("s16", show x, show y, x `op` y) | x <- i16s, y <- is] [x `op` y | x <- si16s, y <- is]+     ++ zipWith pair [("s32", show x, show y, x `op` y) | x <- i32s, y <- is] [x `op` y | x <- si32s, y <- is]+     ++ zipWith pair [("s64", show x, show y, x `op` y) | x <- i64s, y <- is] [x `op` y | x <- si64s, y <- is]+     ++ zipWith pair [("iUB", show x, show y, x `op` y) | x <- iUBs, y <- is] [x `op` y | x <- siUBs, y <- is]+  where pair (t, x, y, a) b       = (t, x, y, show a, show b, show (fromIntegral a `asTypeOf` b) == show b)+        mkTest (t, x, y, a, b, s) = "arithmetic-" ++ nm ++ "." ++ t ++ "_" ++ x ++ "_" ++ y ++ "_" ++ a ++ "_" ++ b ~: s `showsAs` "True"+        is = [-10 .. 10]++genBlasts :: [Test]+genBlasts = map mkTest $+             [(show x, fromBitsLE (blastLE x) .== x) | x <- sw8s ]+          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- sw8s ]+          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- si8s ]+          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- si8s ]+          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- sw16s]+          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- sw16s]+          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- si16s]+          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- si16s]+          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- sw32s]+          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- sw32s]+          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- si32s]+          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- si32s]+          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- sw64s]+          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- sw64s]+          ++ [(show x, fromBitsLE (blastLE x) .== x) | x <- si64s]+          ++ [(show x, fromBitsBE (blastBE x) .== x) | x <- si64s]+  where mkTest (x, r) = "blast-" ++ show x ~: r `showsAs` "True"++genCasts :: [Test]+genCasts = map mkTest $+            [(show x, unsignCast (signCast x) .== x) | x <- sw8s ]+         ++ [(show x, unsignCast (signCast x) .== x) | x <- sw16s]+         ++ [(show x, unsignCast (signCast x) .== x) | x <- sw32s]+         ++ [(show x, unsignCast (signCast x) .== x) | x <- sw64s]+         ++ [(show x, signCast (unsignCast x) .== x) | x <- si8s ]+         ++ [(show x, signCast (unsignCast x) .== x) | x <- si16s]+         ++ [(show x, signCast (unsignCast x) .== x) | x <- si8s ]+         ++ [(show x, signCast (unsignCast x) .== x) | x <- si16s]+         ++ [(show x, signCast (unsignCast x) .== x) | x <- si32s]+         ++ [(show x, signCast (unsignCast x) .== x) | x <- si64s]+         ++ [(show x, signCast x .== fromBitsLE (blastLE x))   | x <- sw8s ]+         ++ [(show x, signCast x .== fromBitsLE (blastLE x))   | x <- sw16s]+         ++ [(show x, signCast x .== fromBitsLE (blastLE x))   | x <- sw32s]+         ++ [(show x, signCast x .== fromBitsLE (blastLE x))   | x <- sw64s]+         ++ [(show x, unsignCast x .== fromBitsLE (blastLE x)) | x <- si8s ]+         ++ [(show x, unsignCast x .== fromBitsLE (blastLE x)) | x <- si16s]+         ++ [(show x, unsignCast x .== fromBitsLE (blastLE x)) | x <- si32s]+         ++ [(show x, unsignCast x .== fromBitsLE (blastLE x)) | x <- si64s]+  where mkTest (x, r) = "cast-" ++ show x ~: r `showsAs` "True"++-- Concrete test data+xsSigned, xsUnsigned :: (Num a, Enum a, Bounded a) => [a]+xsUnsigned = take 5 (iterate (1+) minBound) ++ take 5 (iterate (\x -> x-1) maxBound)+xsSigned   = xsUnsigned ++ [-5 .. 5]++w8s :: [Word8]+w8s = xsUnsigned++sw8s :: [SWord8]+sw8s = xsUnsigned++w16s :: [Word16]+w16s = xsUnsigned++sw16s :: [SWord16]+sw16s = xsUnsigned++w32s :: [Word32]+w32s = xsUnsigned++sw32s :: [SWord32]+sw32s = xsUnsigned++w64s :: [Word64]+w64s = xsUnsigned++sw64s :: [SWord64]+sw64s = xsUnsigned++i8s :: [Int8]+i8s = xsSigned++si8s :: [SInt8]+si8s = xsSigned++i16s :: [Int16]+i16s = xsSigned++si16s :: [SInt16]+si16s = xsSigned++i32s :: [Int32]+i32s = xsSigned++si32s :: [SInt32]+si32s = xsSigned++i64s :: [Int64]+i64s = xsSigned++si64s :: [SInt64]+si64s = xsSigned++iUBs :: [Integer]+iUBs = [-1000000 .. -999995] ++ [-5 .. 5] ++ [999995 ..  1000000]++siUBs :: [SInteger]+siUBs = map literal iUBs
+ SBVUnitTest/TestSuite/Basics/BasicTests.hs view
@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Basics.BasicTests+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.Basics.BasicTests+-----------------------------------------------------------------------------++module TestSuite.Basics.BasicTests(testSuite) where++import Examples.Basics.BasicTests+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "basic-0.1" ~: test0 f1 `showsAs` "5"+ , "basic-0.2" ~: test0 f2 `showsAs` "5"+ , "basic-0.3" ~: test0 f3 `showsAs` "25"+ , "basic-0.4" ~: test0 f4 `showsAs` "25"+ , "basic-0.5" ~: test0 f5 `showsAs` "4"+ , "basic-1.1" ~: test1 f1 `goldCheck` "basic-1_1.gold"+ , "basic-1.2" ~: test1 f2 `goldCheck` "basic-1_2.gold"+ , "basic-1.3" ~: test1 f3 `goldCheck` "basic-1_3.gold"+ , "basic-1.4" ~: test1 f4 `goldCheck` "basic-1_4.gold"+ , "basic-1.5" ~: test1 f5 `goldCheck` "basic-1_5.gold"+ , "basic-2.1" ~: test2 f1 `goldCheck` "basic-2_1.gold"+ , "basic-2.2" ~: test2 f2 `goldCheck` "basic-2_2.gold"+ , "basic-2.3" ~: test2 f3 `goldCheck` "basic-2_3.gold"+ , "basic-2.4" ~: test2 f4 `goldCheck` "basic-2_4.gold"+ , "basic-2.5" ~: test2 f5 `goldCheck` "basic-2_5.gold"+ , "basic-3.1" ~: test3 f1 `goldCheck` "basic-3_1.gold"+ , "basic-3.2" ~: test3 f2 `goldCheck` "basic-3_2.gold"+ , "basic-3.3" ~: test3 f3 `goldCheck` "basic-3_3.gold"+ , "basic-3.4" ~: test3 f4 `goldCheck` "basic-3_4.gold"+ , "basic-3.5" ~: test3 f5 `goldCheck` "basic-3_5.gold"+ , "basic-4.1" ~: test4 f1 `goldCheck` "basic-4_1.gold"+ , "basic-4.2" ~: test4 f2 `goldCheck` "basic-4_2.gold"+ , "basic-4.3" ~: test4 f3 `goldCheck` "basic-4_3.gold"+ , "basic-4.4" ~: test4 f4 `goldCheck` "basic-4_4.gold"+ , "basic-4.5" ~: test4 f5 `goldCheck` "basic-4_5.gold"+ , "basic-5.1" ~: test5 f1 `goldCheck` "basic-5_1.gold"+ , "basic-5.2" ~: test5 f2 `goldCheck` "basic-5_2.gold"+ , "basic-5.3" ~: test5 f3 `goldCheck` "basic-5_3.gold"+ , "basic-5.4" ~: test5 f4 `goldCheck` "basic-5_4.gold"+ , "basic-5.5" ~: test5 f5 `goldCheck` "basic-5_5.gold"+ ]
+ SBVUnitTest/TestSuite/Basics/Higher.hs view
@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Basics.Higher+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.Basics.Higher+-----------------------------------------------------------------------------++module TestSuite.Basics.Higher(testSuite) where++import Data.SBV++import Examples.Basics.Higher+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "higher-1"  ~: (f11 === f11)   `goldCheck` "higher-1.gold"+ , "higher-2"  ~: (f12 === f12)   `goldCheck` "higher-2.gold"+ , "higher-3"  ~: (f21 === f21)   `goldCheck` "higher-3.gold"+ , "higher-4"  ~: (f22 === f22)   `goldCheck` "higher-4.gold"+ , "higher-5"  ~: (f31 === f31)   `goldCheck` "higher-5.gold"+ , "higher-6"  ~: (f32 === f32)   `goldCheck` "higher-6.gold"+ , "higher-7"  ~: (f33 === f33)   `goldCheck` "higher-7.gold"+ , "higher-8"  ~: double          `goldCheck` "higher-8.gold"+ , "higher-9"  ~: onlyFailsFor128 `goldCheck` "higher-9.gold"+ ]+ where double          = (2*) === (\x -> x+(x::SWord8))+       onlyFailsFor128 = (2*) === (\x -> ite (x .== 128) 5 (x+(x::SWord8)))+
+ SBVUnitTest/TestSuite/Basics/Index.hs view
@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Basics.Index+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.Basics.Index+-----------------------------------------------------------------------------++module TestSuite.Basics.Index(testSuite) where++import Examples.Basics.Index+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test $ zipWith tst [f x | f <- [test1, test2, test3], x <- [0..13]] [(0::Int)..]+  where tst t i = "index-" ++ show i ~: t `ioShowsAs` "True"
+ SBVUnitTest/TestSuite/Basics/ProofTests.hs view
@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Basics.ProofTests+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.Basics.ProofTests+-----------------------------------------------------------------------------++module TestSuite.Basics.ProofTests(testSuite)  where++import Data.SBV++import Examples.Basics.ProofTests+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "proofs-1"  ~: assert       =<< isTheorem f1eqf2+ , "proofs-2"  ~: assert . not =<< isTheorem f1eqf3+ , "proofs-3"  ~: assert       =<< isTheorem f3eqf4+ , "proofs-4"  ~: assert       =<< isTheorem f1Single+ , "proofs-5"  ~: assert       =<< isSatisfiable (f1 `xyEq` f2)+ , "proofs-6"  ~: assert       =<< isSatisfiable (f1 `xyEq` f3)+ , "proofs-7"  ~: assert . not =<< isSatisfiable (exists "x" >>= \x -> return (x .== x + (1 :: SWord16)))+ , "proofs-8"  ~: assert       =<< isSatisfiable (exists "x" >>= \x -> return (x :: SBool))+ , "proofs-9"  ~: assert       =<< isSatisfiable (exists "x" >>= \x -> return x :: Predicate)+ ]+ where func1 `xyEq` func2 = do x <- exists_+                               y <- exists_+                               return $ func1 x y .== func2 x (y :: SWord8)
+ SBVUnitTest/TestSuite/Basics/QRem.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Basics.QRem+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.Basics.QRem+-----------------------------------------------------------------------------++module TestSuite.Basics.QRem(testSuite) where++import Data.SBV++import Examples.Basics.QRem+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "qrem" ~: assert =<< isTheorem (qrem :: SWord8 -> SWord8 -> SBool)+ ]
+ SBVUnitTest/TestSuite/BitPrecise/BitTricks.hs view
@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.BitPrecise.BitTricks+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.BitPrecise.BitTricks+-----------------------------------------------------------------------------++module TestSuite.BitPrecise.BitTricks(testSuite) where++import Data.SBV+import Data.SBV.Examples.BitPrecise.BitTricks++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "fast min"              ~: assert =<< isTheorem fastMinCorrect+ , "fast max"              ~: assert =<< isTheorem fastMaxCorrect+ , "opposite signs"        ~: assert =<< isTheorem oppositeSignsCorrect+ , "conditional set clear" ~: assert =<< isTheorem conditionalSetClearCorrect+ , "power of two"          ~: assert =<< isTheorem powerOfTwoCorrect+ ]
+ SBVUnitTest/TestSuite/BitPrecise/Legato.hs view
@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.BitPrecise.Legato+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.BitPrecise.Legato+-----------------------------------------------------------------------------++module TestSuite.BitPrecise.Legato(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.BitPrecise.Legato++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "legato-1" ~: legatoPgm `goldCheck` "legato.gold"+ , "legato-2" ~: legatoC `goldCheck` "legato_c.gold"+ ]+ where legatoPgm = runSymbolic True $ forAll ["mem", "addrX", "x", "addrY", "y", "addrLow", "regX", "regA", "memVals", "flagC", "flagZ"] legatoIsCorrect+                                        >>= output+       legatoC = compileToC' "legatoMult" $ do+                    cgSetDriverValues [87, 92]+                    cgPerformRTCs True+                    x <- cgInput "x"+                    y <- cgInput "y"+                    let (hi, lo) = runLegato (0, x) (1, y) 2 (initMachine (mkSFunArray (const 0)) (0, 0, 0, false, false))+                    cgOutput "hi" hi+                    cgOutput "lo" lo
+ SBVUnitTest/TestSuite/BitPrecise/PrefixSum.hs view
@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.BitPrecise.PrefixSum+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.PrefixSum.PrefixSum+-----------------------------------------------------------------------------++module TestSuite.BitPrecise.PrefixSum(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.BitPrecise.PrefixSum++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+    "prefixSum1" ~: assert =<< isTheorem (flIsCorrect  8 (0, (+)))+  , "prefixSum2" ~: assert =<< isTheorem (flIsCorrect 16 (0, smax))+  , "prefixSum3" ~: runSymbolic True (genPrefixSumInstance 16 >>= output) `goldCheck` "prefixSum_16.gold"+  ]
+ SBVUnitTest/TestSuite/CRC/CCITT.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CRC.CCITT+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.CRC.CCITT+-----------------------------------------------------------------------------++module TestSuite.CRC.CCITT(testSuite) where++import Data.SBV+import Data.SBV.Internals++import Examples.CRC.CCITT+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+  "ccitt" ~: crcPgm `goldCheck` "ccitt.gold"+ ]+ where crcPgm = runSymbolic True $ forAll_ crcGood >>= output
+ SBVUnitTest/TestSuite/CRC/CCITT_Unidir.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CRC.CCITT_Unidir+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.CRC.CCITT_Unidir+-----------------------------------------------------------------------------++module TestSuite.CRC.CCITT_Unidir(testSuite) where++import Data.SBV++import Examples.CRC.CCITT_Unidir+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "ccitHDis3" ~: assert       =<< isTheorem (crcUniGood 3)+ , "ccitHDis4" ~: assert . not =<< isTheorem (crcUniGood 4)+ ]
+ SBVUnitTest/TestSuite/CRC/GenPoly.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CRC.GenPoly+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.CRC.GenPoly+-----------------------------------------------------------------------------++module TestSuite.CRC.GenPoly(testSuite) where++import Data.SBV++import Examples.CRC.GenPoly+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "crcGood" ~: assert       =<< isSatisfiable crcGoodE+ , "crcGood" ~: assert . not =<< isTheorem (crcGood 3 12)+ ]+ where crcGoodE = do x1 <- exists_+                     x2 <- exists_+                     y1 <- exists_+                     y2 <- exists_+                     return (crcGood 3 0 (x1,x2) (y1,y2))
+ SBVUnitTest/TestSuite/CRC/Parity.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CRC.Parity+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.CRC.Parity+-----------------------------------------------------------------------------++module TestSuite.CRC.Parity(testSuite) where++import Data.SBV++import Examples.CRC.Parity+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "parity" ~: assert =<< isTheorem parityOK+ ]
+ SBVUnitTest/TestSuite/CRC/USB5.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CRC.USB5+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.CRC.USB5+-----------------------------------------------------------------------------++module TestSuite.CRC.USB5(testSuite) where++import Data.SBV++import Examples.CRC.USB5+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "usbGood" ~: assert =<< isTheorem usbGood+ ]
+ SBVUnitTest/TestSuite/CodeGeneration/AddSub.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CodeGeneration.AddSub+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.CodeGeneration.AddSub+-----------------------------------------------------------------------------++module TestSuite.CodeGeneration.AddSub(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.CodeGeneration.AddSub++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "addSub" ~: code `goldCheck` "addSub.gold"+ ]+ where code = compileToC' "addSub" $ do+                cgSetDriverValues [76, 92]+                cgPerformRTCs True+                x <- cgInput "x"+                y <- cgInput "y"+                let (s, d) = addSub x y+                cgOutput "sum" s+                cgOutput "dif" d
+ SBVUnitTest/TestSuite/CodeGeneration/CRC_USB5.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CodeGeneration.CRC_USB5+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.CodeGeneration.CRC_USB5+-----------------------------------------------------------------------------++module TestSuite.CodeGeneration.CRC_USB5(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.CodeGeneration.CRC_USB5++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "crcUSB5-1" ~: genC crcUSB  `goldCheck` "crcUSB5_1.gold"+ , "crcUSB5-2" ~: genC crcUSB' `goldCheck` "crcUSB5_2.gold"+ ]+ where genC f = compileToC' "crcUSB5" $ do+                   cgSetDriverValues [0xFEDC]+                   msg <- cgInput "msg"+                   cgReturn $ f msg
+ SBVUnitTest/TestSuite/CodeGeneration/CgTests.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CodeGeneration.CgTests+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for code-generation features+-----------------------------------------------------------------------------++{-# LANGUAGE ScopedTypeVariables #-}++module TestSuite.CodeGeneration.CgTests(testSuite) where++import Data.SBV+import Data.SBV.Internals++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "selChecked"   ~: genSelect True  "selChecked"   `goldCheck` "selChecked.gold"+ , "selUnchecked" ~: genSelect False "selUnChecked" `goldCheck` "selUnchecked.gold"+ , "codegen1"     ~: foo `goldCheck` "codeGen1.gold"+ ]+ where genSelect b n = compileToC' n $ do+                         cgSetDriverValues [65]+                         cgPerformRTCs b+                         let sel :: SWord8 -> SWord8+                             sel x = select [1, x+2] 3 x+                         x <- cgInput "x"+                         cgReturn $ sel x+       foo = compileToC' "foo" $ do+                        cgSetDriverValues $ repeat 0+                        (x::SInt16)    <- cgInput "x"+                        (ys::[SInt64]) <- cgInputArr 45 "xArr"+                        cgOutput "z" (5 :: SWord16)+                        cgOutputArr "zArr" (replicate 7 (x+1))+                        cgOutputArr "yArr" ys+                        cgReturn (x*2)
+ SBVUnitTest/TestSuite/CodeGeneration/Fibonacci.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CodeGeneration.Fibonacci+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.CodeGeneration.Fibonacci+-----------------------------------------------------------------------------++module TestSuite.CodeGeneration.Fibonacci(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.CodeGeneration.Fibonacci++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "fib1" ~: tst [12] "fib1" (fib1 64) `goldCheck` "fib1.gold"+ , "fib2" ~: tst [20] "fib2" (fib2 64) `goldCheck` "fib2.gold"+ ]+ where tst vs nm f = compileToC' nm $ do cgPerformRTCs True+                                         cgSetDriverValues vs+                                         n <- cgInput "n"+                                         cgReturn $ f n
+ SBVUnitTest/TestSuite/CodeGeneration/GCD.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CodeGeneration.GCD+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.CodeGeneration.GCD+-----------------------------------------------------------------------------++module TestSuite.CodeGeneration.GCD(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.CodeGeneration.GCD++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "gcd" ~: gcdC `goldCheck` "gcd.gold"+ ]+ where gcdC = compileToC' "sgcd" $ do+                cgSetDriverValues [55,154]+                x <- cgInput "x"+                y <- cgInput "y"+                cgReturn $ sgcd x y
+ SBVUnitTest/TestSuite/CodeGeneration/PopulationCount.hs view
@@ -0,0 +1,31 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CodeGeneration.PopulationCount+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.CodeGeneration.PopulationCount+-----------------------------------------------------------------------------++module TestSuite.CodeGeneration.PopulationCount(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.CodeGeneration.PopulationCount++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "popCount-1" ~: genC False `goldCheck` "popCount1.gold"+ , "popCount-2" ~: genC True  `goldCheck` "popCount2.gold"+ ]+ where genC b = compileToC' "popCount" $ do+                  cgSetDriverValues [0x0123456789ABCDEF]+                  cgPerformRTCs b+                  x <- cgInput "x"+                  cgReturn $ popCount x
+ SBVUnitTest/TestSuite/CodeGeneration/Uninterpreted.hs view
@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.CodeGeneration.Uninterpreted+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.CodeGeneration.Uninterpreted+-----------------------------------------------------------------------------+module TestSuite.CodeGeneration.Uninterpreted(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.CodeGeneration.Uninterpreted++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "cgUninterpret" ~: genC `goldCheck` "cgUninterpret.gold"+ ]+ where genC = compileToC' "tstShiftLeft" $ do+                  cgSetDriverValues [1, 2, 3]+                  [x, y, z] <- cgInputArr 3 "vs"+                  cgReturn $ tstShiftLeft x y z
+ SBVUnitTest/TestSuite/Crypto/AES.hs view
@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Crypto.AES+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Crypto.AES+-----------------------------------------------------------------------------++module TestSuite.Crypto.AES(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.Crypto.AES++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "aes128Enc" ~: compileToC'    "aes128Enc" (aes128EncDec True)  `goldCheck` "aes128Enc.gold"+ , "aes128Dec" ~: compileToC'    "aes128Dec" (aes128EncDec False) `goldCheck` "aes128Dec.gold"+ , "aes128Lib" ~: compileToCLib' "aes128Lib" aes128Comps          `goldCheck` "aes128Lib.gold"+ ]+ where aes128EncDec d = do pt  <- cgInputArr 4 "pt"+                           key <- cgInputArr 4 "key"+                           cgSetDriverValues $ repeat 0+                           let (encKs, decKs) = aesKeySchedule key+                               res | d    = aesEncrypt pt encKs+                                   | True = aesDecrypt pt decKs+                           cgOutputArr "ct" res+       aes128Comps = [(f, setVals c) | (f, c) <- aes128LibComponents]+       setVals c = cgSetDriverValues (repeat 0) >> c
+ SBVUnitTest/TestSuite/Crypto/RC4.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Crypto.RC4+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Crypto.RC4+-----------------------------------------------------------------------------++module TestSuite.Crypto.RC4(testSuite) where++import Data.SBV+import Data.SBV.Examples.Crypto.RC4++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "rc4swap" ~: assert =<< isTheorem readWrite+ ]+ where readWrite i j = readSTree (writeSTree initS i j) i .== j
+ SBVUnitTest/TestSuite/Existentials/CRCPolynomial.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Existentials.CRCPolynomial+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Existentials.CRCPolynomial+-----------------------------------------------------------------------------++module TestSuite.Existentials.CRCPolynomial(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.Existentials.CRCPolynomial++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+  "crcPolyExist" ~: pgm `goldCheck` "crcPolyExist.gold"+ ]+ where pgm = runSymbolic True $ do+                p <- exists "poly"+                s <- do sh <- forall "sh"+                        sl <- forall "sl"+                        return (sh, sl)+                r <- do rh <- forall "rh"+                        rl <- forall "rl"+                        return (rh, rl)+                output $ bitValue p 0 &&& crcGood 4 p s r
+ SBVUnitTest/TestSuite/Polynomials/Polynomials.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Polynomials.Polynomials+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Polynomials.Polynomials+-----------------------------------------------------------------------------++module TestSuite.Polynomials.Polynomials(testSuite) where++import Data.SBV+import Data.SBV.Examples.Polynomials.Polynomials++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "polynomial-1" ~: assert =<< isTheorem multUnit+ , "polynomial-2" ~: assert =<< isTheorem multComm+ , "polynomial-3" ~: assert =<< isTheorem polyDivMod+ ]
+ SBVUnitTest/TestSuite/Puzzles/Coins.hs view
@@ -0,0 +1,29 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.Coins+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Puzzles.Coins+-----------------------------------------------------------------------------++module TestSuite.Puzzles.Coins(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.Puzzles.Coins++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+  "coins" ~: coinsPgm `goldCheck` "coins.gold"+ ]+ where coinsPgm = runSymbolic True $ 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)+                                        output $ sum cs .== 115
+ SBVUnitTest/TestSuite/Puzzles/Counts.hs view
@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.Counts+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Puzzles.Counts+-----------------------------------------------------------------------------++module TestSuite.Puzzles.Counts(testSuite) where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.Puzzles.Counts++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+  "counts" ~: countPgm `goldCheck` "counts.gold"+ ]+ where countPgm = runSymbolic True $ forAll_ puzzle' >>= output+       puzzle' d0 d1 d2 d3 d4 d5 d6 d7 d8 d9 = puzzle [d0, d1, d2, d3, d4, d5, d6, d7, d8, d9]
+ SBVUnitTest/TestSuite/Puzzles/DogCatMouse.hs view
@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.DogCatMouse+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Puzzles.DogCatMouse+-----------------------------------------------------------------------------++module TestSuite.Puzzles.DogCatMouse(testSuite) where++import Data.SBV+import Data.SBV.Examples.Puzzles.DogCatMouse++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+  "dog cat mouse" ~: allSat p `goldCheck` "dogCatMouse.gold"+ ]+ where p = do d <- exists "d"+              c <- exists "c"+              m <- exists "m"+              return $ puzzle d c m
+ SBVUnitTest/TestSuite/Puzzles/Euler185.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.Euler185+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Puzzles.Euler185+-----------------------------------------------------------------------------++module TestSuite.Puzzles.Euler185(testSuite) where++import Data.SBV+import Data.SBV.Examples.Puzzles.Euler185++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+  "euler185" ~: allSat euler185 `goldCheck` "euler185.gold"+ ]
+ SBVUnitTest/TestSuite/Puzzles/MagicSquare.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.MagicSquare+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Puzzles.MagicSquare+-----------------------------------------------------------------------------++module TestSuite.Puzzles.MagicSquare(testSuite) where++import Data.SBV+import Data.SBV.Examples.Puzzles.MagicSquare++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "magic 2" ~: assert . not =<< isSatisfiable (mkMagic 2)+ , "magic 3" ~: assert       =<< isSatisfiable (mkMagic 3)+ ]+ where mkMagic n = (isMagic . chunk n) `fmap` mkExistVars (n*n)
+ SBVUnitTest/TestSuite/Puzzles/NQueens.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.NQueens+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Puzzles.NQueens+-----------------------------------------------------------------------------++module TestSuite.Puzzles.NQueens(testSuite) where++import Data.SBV+import Data.SBV.Examples.Puzzles.NQueens++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   -- number of *distinct* solutions is given in http://en.wikipedia.org/wiki/Eight_queens_puzzle+   "nQueens 1" ~: assert $ (==  1) `fmap` numberOfModels (mkQueens 1)+ , "nQueens 2" ~: assert $ (==  0) `fmap` numberOfModels (mkQueens 2)+ , "nQueens 3" ~: assert $ (==  0) `fmap` numberOfModels (mkQueens 3)+ , "nQueens 4" ~: assert $ (==  2) `fmap` numberOfModels (mkQueens 4)+ , "nQueens 5" ~: assert $ (== 10) `fmap` numberOfModels (mkQueens 5)+ , "nQueens 6" ~: assert $ (==  4) `fmap` numberOfModels (mkQueens 6)+ , "nQueens 7" ~: assert $ (== 40) `fmap` numberOfModels (mkQueens 7)+ , "nQueens 8" ~: assert $ (== 92) `fmap` numberOfModels (mkQueens 8)+ ]+ where mkQueens n = isValid n `fmap` mkExistVars n
+ SBVUnitTest/TestSuite/Puzzles/PowerSet.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.PowerSet+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.Puzzles.PowerSet+-----------------------------------------------------------------------------++module TestSuite.Puzzles.PowerSet(testSuite) where++import Data.SBV++import Examples.Puzzles.PowerSet+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [ "powerSet " ++ show i ~: assert (pSet i) | i <- [0 .. 7] ]+ where pSet :: Int -> IO Bool+       pSet n = do cnt <- numberOfModels $ genPowerSet `fmap` mkExistVars n+                   return (cnt == 2^n)
+ SBVUnitTest/TestSuite/Puzzles/Sudoku.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.Sudoku+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Puzzles.Sudoku+-----------------------------------------------------------------------------++module TestSuite.Puzzles.Sudoku(testSuite) where++import Data.SBV+import Data.SBV.Examples.Puzzles.Sudoku++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+  "sudoku " ++ show n ~: assert (checkPuzzle s)+     | (n, s) <- zip [(0::Int)..] [puzzle0, puzzle1, puzzle2, puzzle3, puzzle4, puzzle5, puzzle6]+ ]+ where checkPuzzle (i, f) = isSatisfiable $ (valid . f) `fmap` mkExistVars i
+ SBVUnitTest/TestSuite/Puzzles/Temperature.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.Temperature+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.Puzzles.Temperature+-----------------------------------------------------------------------------++module TestSuite.Puzzles.Temperature(testSuite) where++import Data.SBV++import Examples.Puzzles.Temperature+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+  "temperature" ~: sat (revOf `fmap` exists_) `goldCheck` "temperature.gold"+ ]
+ SBVUnitTest/TestSuite/Puzzles/U2Bridge.hs view
@@ -0,0 +1,32 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Puzzles.U2Bridge+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Puzzles.U2Bridge+-----------------------------------------------------------------------------++module TestSuite.Puzzles.U2Bridge(testSuite) where++import Data.SBV+import Data.SBV.Examples.Puzzles.U2Bridge++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "U2Bridge-1" ~: assert $ (0 ==) `fmap` count 1+ , "U2Bridge-2" ~: assert $ (0 ==) `fmap` count 2+ , "U2Bridge-3" ~: assert $ (0 ==) `fmap` count 3+ , "U2Bridge-4" ~: assert $ (0 ==) `fmap` count 4+ , "U2Bridge-5" ~: solve 5 `goldCheck` "U2Bridge.gold"+ , "U2Bridge-6" ~: assert $ (0 ==) `fmap` count 6+ ]+ where act     = do b <- exists_; p1 <- exists_; p2 <- exists_; return (b, p1, p2)+       count n = numberOfModels $ isValid `fmap` mapM (const act) [1..(n::Int)]+       solve n = sat $ isValid `fmap` mapM (const act) [1..(n::Int)]
+ SBVUnitTest/TestSuite/Uninterpreted/AUF.hs view
@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Uninterpreted.AUF+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Data.SBV.Examples.Uninterpreted.AUF+-----------------------------------------------------------------------------++module TestSuite.Uninterpreted.AUF where++import Data.SBV+import Data.SBV.Internals+import Data.SBV.Examples.Uninterpreted.AUF++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \goldCheck -> test [+   "auf-0" ~: assert =<< isTheorem thm1+ , "auf-1" ~: assert =<< isTheorem thm2+ , "auf-2" ~: pgm `goldCheck` "auf-1.gold"+ ]+ where pgm = runSymbolic True $ forAll ["x", "y", "a", "initVal"] thm1 >>= output
+ SBVUnitTest/TestSuite/Uninterpreted/Function.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  TestSuite.Uninterpreted.Function+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Testsuite for Data.SBV.Examples.Uninterpreted.Function+-----------------------------------------------------------------------------++module TestSuite.Uninterpreted.Function where++import Data.SBV+import Data.SBV.Examples.Uninterpreted.Function++import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "aufunc-0" ~: assert       =<< isTheorem thmGood+ , "aufunc-1" ~: assert . not =<< isTheorem thmBad+ ]
+ SBVUnitTest/TestSuite/Uninterpreted/Uninterpreted.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Examples.TestSuite.Uninterpreted+-- Copyright   :  (c) Levent Erkok+-- License     :  BSD3+-- Maintainer  :  erkokl@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Test suite for Examples.Uninterpreted.Uninterpreted+-----------------------------------------------------------------------------++module TestSuite.Uninterpreted.Uninterpreted where++import Data.SBV++import Examples.Uninterpreted.Uninterpreted+import SBVTest++-- Test suite+testSuite :: SBVTestSuite+testSuite = mkTestSuite $ \_ -> test [+   "uninterpreted-0" ~: assert       =<< isTheorem p0+ , "uninterpreted-1" ~: assert       =<< isTheorem p1+ , "uninterpreted-2" ~: assert . not =<< isTheorem p2+ ]
Setup.hs view
@@ -13,22 +13,7 @@ {-# OPTIONS_GHC -Wall #-} module Main(main) where -import Distribution.Simple (defaultMainWithHooks, simpleUserHooks, postInst)-import System.Directory    (findExecutable)-import System.Exit         (exitWith, ExitCode(..))--import Data.SBV.Provers.Prover (SMTSolver(..))-import Data.SBV.Provers.Yices  (yices)+import Distribution.Simple  main :: IO ()-main = defaultMainWithHooks simpleUserHooks{ postInst = checkDefSolver }- where checkDefSolver _ _ _ _ = do-                mbP <- findExecutable ex-                case mbP of-                   Nothing -> do putStrLn $ "*** The sbv library requires the default solver " ++ nm ++ " to be installed."-                                 putStrLn $ "*** The executable " ++ show ex ++ " must be in your path."-                                 putStrLn $ "*** Do not forget to install " ++ nm ++ "!"-                   Just _  -> return ()-                exitWith ExitSuccess-       ex = executable yices-       nm = name yices+main = defaultMain
sbv.cabal view
@@ -1,6 +1,6 @@ Name:          sbv-Version:       0.9.23-Category:      Formal Methods, Theorem Provers, Bit vectors, Symbolic Computation, Math+Version:       0.9.24+Category:      Formal Methods, Theorem Provers, Bit vectors, Symbolic Computation, Math, SMT Synopsis:      Symbolic bit vectors: Bit-precise verification and automatic C-code generation. Description:   Express properties about bit-precise Haskell programs and automatically prove                them using SMT solvers. Automatically generate C programs from Haskell functions.@@ -46,6 +46,8 @@                .                  * quick-checked                .+                 * used in concrete test case generation (the 'genTest' function)+               .                Predicates can have both existential and universal variables. Use of                alternating quantifiers provides considerable expressive power.                Furthermore, existential variables allow synthesis via model generation.@@ -63,6 +65,8 @@                The following people reported bugs, provided comments/feedback, or contributed to the                development of SBV in various ways: Ian Blumenfeld, Ian Calvert, Iavor Diatchki,                Tom Hawkins, Lee Pike, Austin Seipp, Don Stewart, Josef Svenningsson, and Nis Wegmann.+               .+               Release notes can be seen at: <http://github.com/LeventErkok/sbv/blob/master/RELEASENOTES>.  Copyright:     Levent Erkok, 2010-2011 License:       BSD3@@ -72,10 +76,10 @@ Homepage:      http://github.com/LeventErkok/sbv Bug-reports:   http://github.com/LeventErkok/sbv/issues Maintainer:    Levent Erkok (erkokl@gmail.com)-Build-Type:    Custom+Build-Type:    Simple Cabal-Version: >= 1.6 Data-Files: SBVUnitTest/GoldFiles/*.gold-Extra-Source-Files: INSTALL, README, COPYRIGHT+Extra-Source-Files: INSTALL, README, COPYRIGHT, RELEASENOTES  source-repository head     type:       git@@ -83,21 +87,19 @@  Library   ghc-options     : -Wall-  ghc-prof-options: -auto-all -caf-all-  Build-Depends   : base                >= 3 && < 5-                  , deepseq             >= 1.1.0.2-                  , process             >= 1.0.1.3+  Build-Depends   : array               >= 0.3.0.1+                  , base                >= 3 && < 5                   , containers          >= 0.3.0.0-                  , QuickCheck          >= 2.4.0.1-                  , strict-concurrency  >= 0.2.4.1-                  , old-time            >= 1.0.0.5-                  , mtl                 >= 2.0.1.0-                  , array               >= 0.3.0.1-                  , HUnit               >= 1.2.2.3+                  , deepseq             >= 1.1.0.2                   , directory           >= 1.0.1.1                   , filepath            >= 1.1.0.4+                  , mtl                 >= 2.0.1.0+                  , old-time            >= 1.0.0.5                   , pretty              >= 1.0.1.1-                  , random              >= 1.0.0.2+                  , process             >= 1.0.1.3+                  , QuickCheck          >= 2.4.0.1+                  , random              >= 1.0.1.1+                  , strict-concurrency  >= 0.2.4.1   Exposed-modules : Data.SBV                   , Data.SBV.Internals                   , Data.SBV.Examples.BitPrecise.BitTricks@@ -113,6 +115,7 @@                   , Data.SBV.Examples.Crypto.RC4                   , Data.SBV.Examples.Existentials.CRCPolynomial                   , Data.SBV.Examples.Polynomials.Polynomials+                  , Data.SBV.Examples.Puzzles.Coins                   , Data.SBV.Examples.Puzzles.Counts                   , Data.SBV.Examples.Puzzles.DogCatMouse                   , Data.SBV.Examples.Puzzles.Euler185@@ -123,6 +126,7 @@                   , Data.SBV.Examples.Uninterpreted.AUF                   , Data.SBV.Examples.Uninterpreted.Function   Other-modules   : Data.SBV.BitVectors.Data+                  , Data.SBV.BitVectors.GenTest                   , Data.SBV.BitVectors.Model                   , Data.SBV.BitVectors.Optimize                   , Data.SBV.BitVectors.Polynomial@@ -142,61 +146,69 @@                   , Data.SBV.Provers.Z3                   , Data.SBV.Utils.Boolean                   , Data.SBV.Utils.TDiff-                  , Data.SBV.Utils.SBVTest                   , Data.SBV.Utils.Lib-                  , Data.SBV.Examples.Arrays.Memory-                  , Data.SBV.Examples.Basics.BasicTests-                  , Data.SBV.Examples.Basics.Higher-                  , Data.SBV.Examples.Basics.Index-                  , Data.SBV.Examples.Basics.ProofTests-                  , Data.SBV.Examples.Basics.QRem-                  , Data.SBV.Examples.CRC.CCITT-                  , Data.SBV.Examples.CRC.CCITT_Unidir-                  , Data.SBV.Examples.CRC.GenPoly-                  , Data.SBV.Examples.CRC.Parity-                  , Data.SBV.Examples.CRC.USB5-                  , Data.SBV.Examples.Puzzles.PowerSet-                  , Data.SBV.Examples.Puzzles.Temperature-                  , Data.SBV.Examples.Uninterpreted.Uninterpreted-                  , Data.SBV.TestSuite.Arrays.Memory-                  , Data.SBV.TestSuite.Basics.Arithmetic-                  , Data.SBV.TestSuite.Basics.BasicTests-                  , Data.SBV.TestSuite.Basics.Higher-                  , Data.SBV.TestSuite.Basics.Index-                  , Data.SBV.TestSuite.Basics.ProofTests-                  , Data.SBV.TestSuite.Basics.QRem-                  , Data.SBV.TestSuite.BitPrecise.BitTricks-                  , Data.SBV.TestSuite.BitPrecise.Legato-                  , Data.SBV.TestSuite.BitPrecise.PrefixSum-                  , Data.SBV.TestSuite.CodeGeneration.AddSub-                  , Data.SBV.TestSuite.CodeGeneration.CgTests-                  , Data.SBV.TestSuite.CodeGeneration.CRC_USB5-                  , Data.SBV.TestSuite.CodeGeneration.Fibonacci-                  , Data.SBV.TestSuite.CodeGeneration.GCD-                  , Data.SBV.TestSuite.CodeGeneration.PopulationCount-                  , Data.SBV.TestSuite.CodeGeneration.Uninterpreted-                  , Data.SBV.TestSuite.Crypto.AES-                  , Data.SBV.TestSuite.Crypto.RC4-                  , Data.SBV.TestSuite.Existentials.CRCPolynomial-                  , Data.SBV.TestSuite.CRC.CCITT-                  , Data.SBV.TestSuite.CRC.CCITT_Unidir-                  , Data.SBV.TestSuite.CRC.GenPoly-                  , Data.SBV.TestSuite.CRC.Parity-                  , Data.SBV.TestSuite.CRC.USB5-                  , Data.SBV.TestSuite.Polynomials.Polynomials-                  , Data.SBV.TestSuite.Puzzles.Counts-                  , Data.SBV.TestSuite.Puzzles.DogCatMouse-                  , Data.SBV.TestSuite.Puzzles.Euler185-                  , Data.SBV.TestSuite.Puzzles.MagicSquare-                  , Data.SBV.TestSuite.Puzzles.NQueens-                  , Data.SBV.TestSuite.Puzzles.PowerSet-                  , Data.SBV.TestSuite.Puzzles.Sudoku-                  , Data.SBV.TestSuite.Puzzles.U2Bridge-                  , Data.SBV.TestSuite.Puzzles.Temperature-                  , Data.SBV.TestSuite.Uninterpreted.AUF-                  , Data.SBV.TestSuite.Uninterpreted.Uninterpreted-                  , Data.SBV.TestSuite.Uninterpreted.Function  Executable SBVUnitTests-  main-is         : SBVUnitTest/SBVUnitTest.hs-  Other-modules   : SBVUnitTest.SBVUnitTestBuildTime+  ghc-options     : -Wall+  Build-depends   : base      >= 3 && < 5+                  , directory >= 1.0.1.1+                  , HUnit     >= 1.2.4.2+                  , filepath  >= 1.1.0.4+                  , process   >= 1.0.1.3+  Hs-Source-Dirs  : SBVUnitTest, .+  main-is         : SBVUnitTest.hs+  Other-modules   : SBVUnitTestBuildTime+                  , SBVTest+                  , Examples.Arrays.Memory+                  , Examples.Basics.BasicTests+                  , Examples.Basics.Higher+                  , Examples.Basics.Index+                  , Examples.Basics.ProofTests+                  , Examples.Basics.QRem+                  , Examples.CRC.CCITT+                  , Examples.CRC.CCITT_Unidir+                  , Examples.CRC.GenPoly+                  , Examples.CRC.Parity+                  , Examples.CRC.USB5+                  , Examples.Puzzles.PowerSet+                  , Examples.Puzzles.Temperature+                  , Examples.Uninterpreted.Uninterpreted+                  , TestSuite.Arrays.Memory+                  , TestSuite.Basics.Arithmetic+                  , TestSuite.Basics.BasicTests+                  , TestSuite.Basics.Higher+                  , TestSuite.Basics.Index+                  , TestSuite.Basics.ProofTests+                  , TestSuite.Basics.QRem+                  , TestSuite.BitPrecise.BitTricks+                  , TestSuite.BitPrecise.Legato+                  , TestSuite.BitPrecise.PrefixSum+                  , TestSuite.CodeGeneration.AddSub+                  , TestSuite.CodeGeneration.CgTests+                  , TestSuite.CodeGeneration.CRC_USB5+                  , TestSuite.CodeGeneration.Fibonacci+                  , TestSuite.CodeGeneration.GCD+                  , TestSuite.CodeGeneration.PopulationCount+                  , TestSuite.CodeGeneration.Uninterpreted+                  , TestSuite.Crypto.AES+                  , TestSuite.Crypto.RC4+                  , TestSuite.Existentials.CRCPolynomial+                  , TestSuite.CRC.CCITT+                  , TestSuite.CRC.CCITT_Unidir+                  , TestSuite.CRC.GenPoly+                  , TestSuite.CRC.Parity+                  , TestSuite.CRC.USB5+                  , TestSuite.Puzzles.Coins+                  , TestSuite.Polynomials.Polynomials+                  , TestSuite.Puzzles.Counts+                  , TestSuite.Puzzles.DogCatMouse+                  , TestSuite.Puzzles.Euler185+                  , TestSuite.Puzzles.MagicSquare+                  , TestSuite.Puzzles.NQueens+                  , TestSuite.Puzzles.PowerSet+                  , TestSuite.Puzzles.Sudoku+                  , TestSuite.Puzzles.U2Bridge+                  , TestSuite.Puzzles.Temperature+                  , TestSuite.Uninterpreted.AUF+                  , TestSuite.Uninterpreted.Function+                  , TestSuite.Uninterpreted.Uninterpreted