hevm 0.56.0 → 0.57.0

raw patch · 25 files changed

+1909/−1718 lines, 25 filesdep +monad-loopsdep ~directorydep ~filepathPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-loops

Dependency ranges changed: directory, filepath

API changes (from Hackage documentation)

Files

• CHANGELOG.md +27/−0
• bench/bench-perf.hs +2/−2
• bench/bench.hs +4/−28
• cli/cli.hs +60/−50
• hevm.cabal +3/−3
• src/EVM.hs +185/−196
• src/EVM/Exec.hs +5/−5
• src/EVM/Expr.hs +180/−141
• src/EVM/Fetch.hs +317/−199
• src/EVM/Format.hs +8/−12
• src/EVM/SMT.hs +6/−2
• src/EVM/Solidity.hs +2/−2
• src/EVM/Stepper.hs +24/−29
• src/EVM/SymExec.hs +311/−239
• src/EVM/Tracing.hs +12/−12
• src/EVM/Transaction.hs +1/−1
• src/EVM/Traversals.hs +0/−6
• src/EVM/Types.hs +64/−70
• src/EVM/UnitTest.hs +57/−53
• test/EVM/Test/BlockchainTests.hs +166/−239
• test/EVM/Test/FuzzSymExec.hs +22/−22
• test/EVM/Test/Utils.hs +4/−5
• test/clitest.hs +2/−46
• test/rpc.hs +21/−23
• test/test.hs +426/−333

@@ -5,6 +5,33 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.57.0] - 2026-01-08++## Added+- We support RPC in equivalence checking now+- Inequality propagation in constant propagation to prune impossible execution paths earlier.+  The constraint solver now tracks lower and upper bounds for symbolic values and detects+  conflicts (e.g., x < 5 && x > 10), significantly reducing the number of paths explored+- Encode symbolic power of 2 as bit-shift in SMT encoding.+- Limit the expansion of the EXP operation to avoid blow-up in the size of the SMT expressions.+- New EXP rewrite rule for base-2 exponents++## Fixed+- Fix incorrect simplification rule for `PEq (Lit 1) (IsZero (LT a b))`++## Changed+- Replaced RPC mocking by a full block cache support. This allows users to cache responses from an RPC+  node via `--cache-dir dir`.+- Changed `verify*` methods to always require postcodition.+- We now use a symbolic execution queue, so as not to run out of resources when there are+  too many branches to explore.+- Removed type parameter of mutable memory from VM definition.+- Removed simplification that were rewriting concrete bytes-to-be-overwritten+  with zero bytes. Benefits were unclear while it had negative effect on+  analysis' performance.+- We now use the symbolic execution queue to also run the SMT solver in `test` mode,+  and verify the results using a cexHandler+ ## [0.56.0] - 2025-10-13  ## Added

@@ -24,7 +24,7 @@  -- benchmark hevm using tasty-bench -vmFromRawByteString :: App m => ByteString -> m (VM Concrete RealWorld)+vmFromRawByteString :: App m => ByteString -> m (VM Concrete) vmFromRawByteString bs = liftIO $   bs     & ConcreteRuntimeCode@@ -34,7 +34,7 @@     & stToIO     & fmap EVM.Transaction.initTx -vm0 :: Contract -> ST s (VM Concrete s)+vm0 :: Contract -> ST RealWorld (VM Concrete) vm0 c = makeVm $ vm0Opts c  vm0Opts :: Contract -> VMOpts Concrete

@@ -4,18 +4,14 @@ import Control.Monad import Control.Monad.IO.Unlift import Data.Maybe-import System.Environment (getEnv)  import qualified Paths_hevm as Paths  import Test.Tasty (localOption, withResource) import Test.Tasty.Bench import Data.ByteString (ByteString)-import System.FilePath.Posix import qualified Data.Map.Strict as Map import qualified Data.Text as T-import qualified System.FilePath.Find as Find-import qualified Data.ByteString.Lazy as LazyByteString  import EVM.SymExec import EVM.Solidity@@ -34,30 +30,12 @@   , mkbench (pure vat) "vat" 0 [4]   , mkbench (pure deposit) "deposit" 32 [4]   , mkbench (pure uniV2Pair) "uniV2" 10 [4]-  , withResource bcjsons (pure . const ()) blockchainTests+  , withResource BCTests.allTestCases (pure . const ()) blockchainTests   ]   --- General State Tests ---------------------------------------------------------------------------- ---- | loads and parses all blockchain test files--- We pull this out into a separate stage to ensure that we only benchmark the--- actual time spent executing tests, and not the IO & parsing overhead-bcjsons :: IO (Map.Map FilePath (Map.Map String BCTests.Case))-bcjsons = do-  repo <- getEnv "HEVM_ETHEREUM_TESTS_REPO"-  let testsDir = "BlockchainTests/GeneralStateTests"-      dir = repo </> testsDir-  jsons <- Find.find Find.always (Find.extension Find.==? ".json") dir-  Map.fromList <$> mapM parseSuite jsons-  where-    parseSuite path = do-      contents <- LazyByteString.readFile path-      case BCTests.parseBCSuite contents of-        Left _ -> pure (path, mempty)-        Right tests -> pure (path, tests)- -- | executes all provided bc tests in sequence and accumulates a boolean value representing their success. -- the accumulated value ensures that we actually have to execute all the tests as a part of this benchmark blockchainTests :: IO (Map.Map FilePath (Map.Map String BCTests.Case)) -> Benchmark@@ -65,7 +43,7 @@   tests <- ts   putStrLn "    executing blockchain tests"   let cases = concat . Map.elems . (fmap Map.toList) $ tests-      ignored = Map.keys BCTests.commonProblematicTests+      ignored = Map.keys BCTests.problematicTests   foldM (\acc (n, c) ->       if n `elem` ignored       then pure True@@ -81,9 +59,7 @@   vm0 <- liftIO $ BCTests.vmForCase x   result <- Stepper.interpret (Fetch.zero 0 Nothing) vm0 Stepper.runFully   writeTrace vm0--  maybeReason <- BCTests.checkExpectation x result-  pure $ isNothing maybeReason+  pure $ isNothing $ BCTests.checkExpectation x result   --- Helpers ----------------------------------------------------------------------------------------@@ -92,7 +68,7 @@ findPanics :: App m => Solver -> Natural -> Integer -> ByteString -> m () findPanics solver count iters c = do   _ <- withSolvers solver count 1 Nothing $ \s -> do-    let opts = defaultVeriOpts { iterConf = defaultIterConf {maxIter = Just iters, askSmtIters = iters + 1 }}+    let opts = (defaultVeriOpts :: VeriOpts) { iterConf = defaultIterConf {maxIter = Just iters, askSmtIters = iters + 1 }}     checkAssert s allPanicCodes c Nothing [] opts   liftIO $ putStrLn "done" 

@@ -9,10 +9,11 @@  import Control.Monad (when, forM_, unless) import Control.Monad.State.Strict (runStateT)-import Control.Monad.ST (RealWorld, stToIO)+import Control.Monad.ST (stToIO) import Control.Monad.IO.Unlift import Control.Exception (try, IOException) import Data.ByteString (ByteString)+import Control.Concurrent.MVar (readMVar) import qualified Data.ByteString.Lazy as BS import Data.ByteString.Builder (toLazyByteString) import qualified Data.ByteString.Char8 as BC@@ -24,6 +25,7 @@ import Data.Version (showVersion) import Data.Word (Word64) import GHC.Conc (getNumProcessors)+import GitHash import Numeric.Natural (Natural) import Optics.Core ((&), set) import Witch (unsafeInto)@@ -42,10 +44,9 @@ import EVM.Dapp (dappInfo, DappInfo, emptyDapp) import EVM.Expr qualified as Expr import EVM.Concrete qualified as Concrete-import GitHash import EVM.FeeSchedule (feeSchedule) import EVM.Fetch qualified as Fetch-import EVM.Format (hexByteString, strip0x, formatExpr)+import EVM.Format (hexByteString, strip0x, formatExpr, indent) import EVM.Solidity import EVM.Solvers import EVM.Stepper qualified@@ -99,6 +100,7 @@   , maxDepth      ::Maybe Int   , noSimplify    ::Bool   , onlyDeployed  ::Bool+  , cacheDir      ::Maybe String   }  commonOptions :: Parser CommonOptions@@ -127,6 +129,7 @@   <*> (optional $ option auto $ long "max-depth" <> help "Limit maximum depth of branching during exploration (default: unlimited)")   <*> (switch $ long "no-simplify" <> help "Don't perform simplification of expressions")   <*> (switch $ long "only-deployed" <> help "When trying to resolve unknown addresses, only use addresses of deployed contracts")+  <*> (optional $ strOption $ long "cache-dir" <> help "Directory to save and load RPC cache")  data CommonExecOptions = CommonExecOptions   { address       ::Maybe Addr@@ -188,7 +191,6 @@   , match         ::Maybe String   , prefix        ::String   , ffi           ::Bool-  , mockFile      ::Maybe String   }  testOptions :: Parser TestOptions@@ -200,9 +202,7 @@   <*> (optional $ strOption $ long "match" <> help "Test case filter - only run methods matching regex")   <*> (strOption $ long "prefix"  <> showDefault <> value "prove" <> help "Prefix for test cases to prove")   <*> (switch $ long "ffi" <> help "Allow the usage of the hevm.ffi() cheatcode (WARNING: this allows test authors to execute arbitrary code on your machine)")-  <*> (optional $ strOption $ long "mock-file" <> help "Read mocked RPC response data from JSON file") - data EqOptions = EqOptions   { codeA         ::Maybe ByteString   , codeB         ::Maybe ByteString@@ -340,6 +340,9 @@             -- TODO: which functions here actually require a BuildOutput, and which can take it as a Maybe?             unitTestOpts <- unitTestOptions testOpts cOpts solvers (Just out)             res <- unitTest unitTestOpts out+            liftIO $ forM_ ((,) <$> cOpts.cacheDir <*> testOpts.number) $ \(dir, fetchedBlock) -> do+              cache <- readMVar (unitTestOpts.sess.sharedCache)+              Fetch.saveCache dir fetchedBlock cache             liftIO $ unless (uncurry (&&) res) exitFailure     Exec cFileOpts execOpts cExecOpts cOpts-> do       env <- makeEnv cOpts@@ -402,19 +405,19 @@   when (isNothing bytecodeB) $ liftIO $ do     putStrLn "Error: invalid or no bytecode for program B. Provide a valid one with --code-b or --code-b-file"     exitFailure-  let veriOpts = VeriOpts { iterConf = IterConfig {+  let veriOpts = (defaultVeriOpts :: VeriOpts) { iterConf = IterConfig {                             maxIter = parseMaxIters cOpts.maxIterations                             , askSmtIters = cOpts.askSmtIterations                             , loopHeuristic = cOpts.loopDetectionHeuristic                             }-                          , rpcInfo = mempty                           }   calldata <- buildCalldata cOpts eqOpts.sig eqOpts.arg   solver <- liftIO $ getSolver cOpts.solver   cores <- liftIO $ unsafeInto <$> getNumProcessors   let solverCount = fromMaybe cores cOpts.numSolvers   withSolvers solver solverCount cOpts.solverThreads (Just cOpts.smttimeout) $ \s -> do-    eq <- equivalenceCheck s (fromJust bytecodeA) (fromJust bytecodeB) veriOpts calldata eqOpts.create+    sess <- Fetch.mkSession cOpts.cacheDir Nothing+    eq <- equivalenceCheck s (Just sess) (fromJust bytecodeA) (fromJust bytecodeB) veriOpts calldata eqOpts.create     let anyIssues =  not (null eq.partials) || any (isUnknown . fst) eq.res  || any (isError . fst) eq.res     liftIO $ case (any (isCex . fst) eq.res, anyIssues) of       (False, False) -> putStrLn "   \x1b[32m[PASS]\x1b[0m Contracts behave equivalently"@@ -496,7 +499,7 @@ symbCheck cFileOpts sOpts cExecOpts cOpts = do   let block' = maybe Fetch.Latest Fetch.BlockNumber cExecOpts.block       blockUrlInfo = (,) block' <$> cExecOpts.rpc-  sess <- Fetch.mkSession+  sess <- Fetch.mkSession cOpts.cacheDir cExecOpts.block   calldata <- buildCalldata cOpts sOpts.sig sOpts.arg   preState <- symvmFromCommand cExecOpts sOpts cFileOpts sess calldata   errCodes <- case sOpts.assertions of@@ -516,12 +519,15 @@                               , askSmtIters = cOpts.askSmtIterations                               , loopHeuristic = cOpts.loopDetectionHeuristic                               }-                            , rpcInfo = mempty {Fetch.blockNumURL = blockUrlInfo}+                            , rpcInfo = Fetch.RpcInfo blockUrlInfo                             }     let fetcher = Fetch.oracle solvers (Just sess) veriOpts.rpcInfo-    (expr, res) <- verify solvers fetcher veriOpts preState (Just $ checkAssertions errCodes)+    (expr, res) <- verify solvers fetcher veriOpts preState (checkAssertions errCodes) Nothing+    liftIO $ forM_ ((,) <$> cOpts.cacheDir <*> cExecOpts.block) $ \(dir, block) -> do+      cache <- readMVar sess.sharedCache+      Fetch.saveCache dir block cache     case res of-      [Qed] -> do+      [] -> do         liftIO $ putStrLn "\nQED: No reachable property violations discovered\n"         showExtras solvers sOpts calldata expr       _ -> do@@ -534,26 +540,29 @@                  , ""                  ] <> fmap (formatCex (fst calldata) Nothing) cexs         liftIO $ T.putStrLn $ T.unlines counterexamples-        liftIO $ printWarnings Nothing [expr] res "symbolically"+        liftIO $ printWarnings Nothing expr res "symbolically"         showExtras solvers sOpts calldata expr         liftIO exitFailure -showExtras :: App m => SolverGroup ->SymbolicOptions -> (Expr Buf, [Prop]) -> Expr End -> m ()+showExtras :: App m => SolverGroup ->SymbolicOptions -> (Expr Buf, [Prop]) -> [Expr End] -> m () showExtras solvers sOpts calldata expr = do   when sOpts.showTree $ liftIO $ do-    putStrLn "=== Expression ===\n"-    T.putStrLn $ formatExpr $ Expr.simplify expr+    putStrLn "=== Leafs ===\n"+    printLeafs $ map (formatExpr . Expr.simplify) expr     putStrLn ""   when sOpts.showReachableTree $ do     reached <- reachable solvers expr     liftIO $ do-      putStrLn "=== Potentially Reachable Expression ===\n"-      T.putStrLn (formatExpr . Expr.simplify $ reached)+      putStrLn "=== Potentially Reachable Leafs ===\n"+      printLeafs $ map (formatExpr . Expr.simplify) reached       putStrLn ""   when sOpts.getModels $ do-    liftIO $ putStrLn $ "=== Models for " <> show (Expr.numBranches expr) <> " branches ==="+    liftIO $ putStrLn $ "=== Models for " <> show (length expr) <> " branches ==="     ms <- produceModels solvers expr     liftIO $ forM_ ms (showModel (fst calldata))+  where+    printLeafs leafs =+      T.putStrLn $ indent 2 $ T.unlines $ zipWith (\i r -> "Leaf " <> T.pack (show (i :: Integer)) <> ":\n" <> r) [0..] leafs  isTestOrLib :: Text -> Bool isTestOrLib file = T.isSuffixOf ".t.sol" file || areAnyPrefixOf ["src/test/", "src/tests/", "lib/"] file@@ -564,12 +573,12 @@ launchExec :: App m => CommonFileOptions -> ExecOptions -> CommonExecOptions -> CommonOptions -> m () launchExec cFileOpts execOpts cExecOpts cOpts = do   dapp <- getSrcInfo execOpts cOpts-  sess <- Fetch.mkSession+  sess <- Fetch.mkSession cOpts.cacheDir cExecOpts.block   vm <- vmFromCommand cOpts cExecOpts cFileOpts execOpts sess   let     block = maybe Fetch.Latest Fetch.BlockNumber cExecOpts.block     blockUrlInfo = (,) block <$> cExecOpts.rpc-    rpcDat :: Fetch.RpcInfo = mempty { Fetch.blockNumURL = blockUrlInfo }+    rpcDat :: Fetch.RpcInfo = Fetch.RpcInfo blockUrlInfo    -- TODO: we shouldn't need solvers to execute this code   withSolvers Z3 0 1 Nothing $ \solvers -> do@@ -590,6 +599,9 @@              pure vm'            else EVM.Stepper.interpret fetcher vm EVM.Stepper.runFully     writeTraceDapp dapp vm'+    liftIO $ forM_ ((,) <$> cOpts.cacheDir <*> cExecOpts.block) $ \(dir, fetchedBlock) -> do+      cache <- readMVar sess.sharedCache+      Fetch.saveCache dir fetchedBlock cache     case vm'.result of       Just (VMFailure (Revert msg)) -> liftIO $ do         let res = case msg of@@ -609,7 +621,7 @@         internalError "no EVM result"  -- | Creates a (concrete) VM from command line options-vmFromCommand :: App m => CommonOptions -> CommonExecOptions -> CommonFileOptions -> ExecOptions -> Fetch.Session -> m (VM Concrete RealWorld)+vmFromCommand :: App m => CommonOptions -> CommonExecOptions -> CommonFileOptions -> ExecOptions -> Fetch.Session -> m (VM Concrete) vmFromCommand cOpts cExecOpts cFileOpts execOpts sess = do   conf <- readConfig   (miner,ts,baseFee,blockNum,prevRan) <- case cExecOpts.rpc of@@ -634,23 +646,28 @@         exitFailure       else         Fetch.fetchContractWithSession conf sess block url addr' >>= \case-          Nothing -> do+          Fetch.FetchFailure _ -> do             putStrLn $ "Error: contract not found: " <> show address             exitFailure-          Just contract ->+          Fetch.FetchError e -> do+            putStrLn $ "Error: RPC failure: " <> show e+            exitFailure+          Fetch.FetchSuccess rpcContract _ ->             -- if both code and url is given,             -- fetch the contract and overwrite the code-            pure $ initialContract (mkCode $ fromJust code)-                & set #balance  (contract.balance)-                & set #nonce    (contract.nonce)-                & set #external (contract.external)+              pure $ initialContract (mkCode $ fromJust code)+                & set #balance  (Lit rpcContract.balance)+                & set #nonce    (Just rpcContract.nonce)      (Just url, Just addr', Nothing) ->       liftIO $ Fetch.fetchContractWithSession conf sess block url addr' >>= \case-        Nothing -> do+        Fetch.FetchFailure _ -> do           putStrLn $ "Error, contract not found: " <> show address           exitFailure-        Just contract -> pure contract+        Fetch.FetchError e -> do+          putStrLn $ "Error: RPC failure: " <> show e+          exitFailure+        Fetch.FetchSuccess rpcContract _ -> pure $ Fetch.makeContractFromRPC rpcContract      (_, _, Just c)  -> do       let code = hexByteString $ strip0x c@@ -723,7 +740,7 @@  symvmFromCommand :: App m =>   CommonExecOptions -> SymbolicOptions -> CommonFileOptions -> Fetch.Session ->-  (Expr Buf, [Prop]) -> m (VM EVM.Types.Symbolic RealWorld)+  (Expr Buf, [Prop]) -> m (VM EVM.Types.Symbolic) symvmFromCommand cExecOpts sOpts cFileOpts sess calldata = do   conf <- readConfig   (miner,blockNum,baseFee,prevRan) <- case cExecOpts.rpc of@@ -748,11 +765,14 @@   contract <- case (cExecOpts.rpc, cExecOpts.address, codeWrapped) of     (Just url, Just addr', _) ->       liftIO $ Fetch.fetchContractWithSession conf sess block url addr' >>= \case-        Nothing -> do+        Fetch.FetchFailure _ -> do           putStrLn "Error, contract not found."           exitFailure-        Just contract' -> case codeWrapped of-              Nothing -> pure contract'+        Fetch.FetchError e -> do+          putStrLn $ "Error: RPC failure: " <> show e+          exitFailure+        Fetch.FetchSuccess rpcContract' _ -> case codeWrapped of+              Nothing -> pure $ Fetch.makeContractFromRPC rpcContract'               -- if both code and url is given,               -- fetch the contract and overwrite the code               Just c -> do@@ -762,10 +782,8 @@                   exitFailure                 else pure $ do                   initialContract (mkCode $ fromJust c')-                        & set #origStorage (contract'.origStorage)-                        & set #balance     (contract'.balance)-                        & set #nonce       (contract'.nonce)-                        & set #external    (contract'.external)+                        & set #balance (Lit rpcContract'.balance)+                        & set #nonce (Just rpcContract'.nonce)      (_, _, Just c) -> liftIO $ do       let c' = decipher c@@ -825,25 +843,17 @@     word64 f def = fromMaybe def (f cExecOpts)     eaddr f def = maybe def LitAddr (f cExecOpts) -unitTestOptions :: App m => TestOptions -> CommonOptions -> SolverGroup -> Maybe BuildOutput -> m (UnitTestOptions RealWorld)+unitTestOptions :: App m => TestOptions -> CommonOptions -> SolverGroup -> Maybe BuildOutput -> m (UnitTestOptions) unitTestOptions testOpts cOpts solvers buildOutput = do   root <- liftIO $ getRoot cOpts-  mockData <- if isJust testOpts.mockFile then liftIO $ do-      ret <- Fetch.readMockData (fromJust testOpts.mockFile)-      case ret of-        Left err -> do-          putStrLn $ "Error reading mock file: " <> err-          exitFailure-        Right md -> pure md-    else pure mempty    let srcInfo = maybe emptyDapp (dappInfo root) buildOutput   let blockUrlInfo = case (testOpts.number, testOpts.rpc) of           (Just block, Just url) -> Just (Fetch.BlockNumber block, url)           (Nothing, Just url) -> Just (Fetch.Latest, url)           _ -> Nothing-      rpcDat = Fetch.mkRpcInfo blockUrlInfo mockData-  sess <- Fetch.mkSession+      rpcDat = Fetch.RpcInfo blockUrlInfo+  sess <- Fetch.mkSession cOpts.cacheDir testOpts.number   params <- paramsFromRpc rpcDat sess   let testn = params.number       block' = if 0 == testn

@@ -2,7 +2,7 @@ name:   hevm version:-  0.56.0+  0.57.0 synopsis:   Symbolic EVM Evaluator description:@@ -143,6 +143,7 @@   install-includes:     ethjet/tinykeccak.h, ethjet/ethjet.h, ethjet/ethjet-ff.h, ethjet/blake2.h   build-depends:+    directory                         >= 1.3.6 && < 1.4,     system-cxx-std-lib                >= 1.0 && < 2.0,     QuickCheck                        >= 2.13.2 && < 2.16,     Decimal                           >= 0.5.1 && < 0.6,@@ -187,6 +188,7 @@     template-haskell                  >= 2.19.0 && < 3,     extra                             >= 1.7.14 && < 2,     aeson-pretty                      >= 0.8.8 && < 0.9.0,+    monad-loops                       >= 0.4.1 && < 0.5,   hs-source-dirs:     src @@ -359,8 +361,6 @@     text,     hevm,     test-utils,-    filemanip,-    filepath,     containers,     unliftio-core 

@@ -26,7 +26,7 @@ import EVM.Effects (Config (..))  import Control.Monad (unless, when)-import Control.Monad.ST (ST)+import Control.Monad.ST (ST, RealWorld) import Control.Monad.State.Strict (MonadState, State, get, gets, lift, modify', put) import Data.Bits (FiniteBits, countLeadingZeros, finiteBitSize) import Data.ByteArray qualified as BA@@ -66,7 +66,7 @@ import Crypto.Hash qualified as Crypto import Crypto.Number.ModArithmetic (expFast) -blankState :: VMOps t => ST s (FrameState t s)+blankState :: VMOps t => ST RealWorld (FrameState t) blankState = do   memory <- ConcreteMemory <$> VS.Mutable.new 0   pure $ FrameState@@ -98,13 +98,13 @@  -- * Data accessors -currentContract :: VM t s -> Maybe Contract+currentContract :: VM t -> Maybe Contract currentContract vm =   Map.lookup vm.state.codeContract vm.env.contracts  -- * Data constructors ---makeVm :: VMOps t => VMOpts t -> ST s (VM t s)+makeVm :: VMOps t => VMOpts t -> ST RealWorld (VM t) makeVm o = do   let txaccessList = o.txAccessList       txorigin = o.origin@@ -186,7 +186,7 @@       }  -- https://eips.ethereum.org/EIPS/eip-4788-setEIP4788Storage :: VMOpts t -> VM t s -> VM t s+setEIP4788Storage :: VMOpts t -> VM t -> VM t setEIP4788Storage o vm = do   let beaconRootsAddress = LitAddr 0x000F3df6D732807Ef1319fB7B8bB8522d0Beac02   case Map.lookup beaconRootsAddress vm.env.contracts of@@ -272,10 +272,10 @@ -- * Opcode dispatch (exec1)  -- | Update program counter-next :: (?op :: Word8) => EVM t s ()+next :: (?op :: Word8) => EVM t () next = modifying' (#state % #pc) (+ (opSize ?op)) -getOpW8 :: forall (t :: VMType) s . FrameState t s -> Word8+getOpW8 :: forall (t :: VMType) . FrameState t -> Word8 getOpW8 state = case state.code of       UnknownCode _ -> internalError "Cannot execute unknown code"       InitCode conc _ -> BS.index conc state.pc@@ -284,11 +284,11 @@         fromMaybe (internalError "could not analyze symbolic code") $           maybeLitByteSimp $ ops V.! state.pc -getOpName :: forall (t :: VMType) s . FrameState t s -> [Char]+getOpName :: forall (t :: VMType) . FrameState t -> [Char] getOpName state = intToOpName $ fromEnum $ getOpW8 state  -- | Executes the EVM one step-exec1 :: forall (t :: VMType) s. (VMOps t, Typeable t) => Config ->  EVM t s ()+exec1 :: forall (t :: VMType). (VMOps t, Typeable t) => Config ->  EVM t () exec1 conf = do   vm <- get @@ -727,63 +727,60 @@          OpSload -> {-# SCC "OpSload" #-}           case stk of-            x:xs -> do-              acc <- accessStorageForGas self x-              let cost = if acc then g_warm_storage_read else g_cold_sload-              burn cost $-                accessStorage self x $ \y -> do-                  next-                  assign' (#state % #stack) (y:xs)+            x:xs ->+              let+                finalizeLoad readValue = do next; assign' (#state % #stack) (readValue:xs)++                symbolicRead :: EVM t () = if this.external+                  then accessStorage self x finalizeLoad+                  else finalizeLoad $ Expr.readStorage' (Expr.concKeccakOnePass x) this.storage++                concreteRead :: EVM t () = do+                  acc <- accessStorageForGas self (forceLit x)+                  let cost = if acc then g_warm_storage_read else g_cold_sload+                  burn cost $ if this.external+                    then accessStorage self x finalizeLoad+                    else finalizeLoad $ Lit $ accessConcreteStorage this.storage (forceLit x)+              in whenSymbolicElse symbolicRead concreteRead             _ -> underrun          OpSstore -> {-# SCC "OpSstore" #-}           notStatic $           case stk of             x:new:xs ->-              accessStorage self x $ \current -> do-                ensureGas g_callstipend $ do-                  let-                    original =-                      case Expr.concKeccakSimpExpr $ SLoad x this.origStorage of-                        Lit v -> v-                        _ -> 0-                    storage_cost =-                      case (maybeLitWordSimp current, maybeLitWordSimp new) of-                        (Just current', Just new') ->-                           if (current' == new') then g_sload-                           else if (current' == original) && (original == 0) then g_sset-                           else if (current' == original) then g_sreset-                           else g_sload--                        -- if any of the arguments are symbolic,-                        -- assume worst case scenario-                        _-> g_sset+              let+                updateVMState :: EVM t () = do+                  next+                  assign' (#state % #stack) xs+                  modifying (#env % #contracts % ix self % #storage) (writeStorage x new) -                  acc <- accessStorageForGas self x-                  let cold_storage_cost = if acc then 0 else g_cold_sload-                  burn (storage_cost + cold_storage_cost) $ do-                    next-                    assign' (#state % #stack) xs-                    modifying (#env % #contracts % ix self % #storage) (writeStorage x new)+                concreteSstore :: EVM t () = do+                  let+                    slot = forceLit x+                    currentVal = accessConcreteStorage this.storage slot+                    newVal = forceLit new+                    originalVal = accessConcreteStorage this.origStorage slot+                  ensureGas g_callstipend $ do+                    let storage_cost+                          | (currentVal == newVal) = g_sload+                          | (currentVal == originalVal) && (originalVal == 0) = g_sset+                          | (currentVal == originalVal) = g_sreset+                          | otherwise = g_sload -                    case (maybeLitWordSimp current, maybeLitWordSimp new) of-                       (Just current', Just new') ->-                          unless (current' == new') $-                            if current' == original then-                              when (original /= 0 && new' == 0) $-                                refund (g_sreset + g_access_list_storage_key)-                            else do-                              when (original /= 0) $-                                if current' == 0-                                then unRefund (g_sreset + g_access_list_storage_key)-                                else when (new' == 0) $ refund (g_sreset + g_access_list_storage_key)-                              when (original == new') $-                                if original == 0-                                then refund (g_sset - g_sload)-                                else refund (g_sreset - g_sload)-                       -- if any of the arguments are symbolic,-                       -- don't change the refund counter-                       _ -> noop+                    acc <- accessStorageForGas self slot+                    let cold_storage_cost = if acc then 0 else g_cold_sload+                    burn (storage_cost + cold_storage_cost) $ do+                      updateVMState+                      case (originalVal, currentVal, newVal) of+                        (o, c, n)+                          | c == n -> pure ()+                          | o /= 0 && n == 0 -> refund (g_sreset + g_access_list_storage_key)+                          | o /= 0 && c == 0 -> do unRefund (g_sreset + g_access_list_storage_key); when (o == n) $ refund (g_sreset - g_sload)+                          | o /= 0 && o == n -> refund (g_sreset - g_sload)+                          | o == 0 && o == n -> refund (g_sset - g_sload)+                          | otherwise -> pure ()+              in+                whenSymbolicElse updateVMState concreteSstore             _ -> underrun          OpTload -> {-# SCC "OpTload" #-}@@ -818,7 +815,7 @@           case stk of             x:y:xs -> forceConcreteLimitSz x 2 "JUMPI: symbolic jumpdest" $ \x' ->               burn g_high $-                let jump :: Bool -> EVM t s ()+                let jump :: Bool -> EVM t ()                     jump False = assign' (#state % #stack) xs >> next                     jump _    = case tryInto x' of                       Left _ -> vmError BadJumpDestination@@ -1054,7 +1051,7 @@          OpUnknown xxx -> {-# SCC "OpUnknown" #-} vmError $ UnrecognizedOpcode xxx -transfer :: (VMOps t, ?conf::Config) => Expr EAddr -> Expr EAddr -> Expr EWord -> EVM t s ()+transfer :: (VMOps t, ?conf::Config) => Expr EAddr -> Expr EAddr -> Expr EWord -> EVM t () transfer _ _ (Lit 0) = pure () transfer src dst val = do   sb <- preuse $ #env % #contracts % ix src % #balance@@ -1086,7 +1083,7 @@  -- | Checks a *CALL for failure; OOG, too many callframes, memory access etc. callChecks-  :: forall (t :: VMType) s. (?op :: Word8, ?conf :: Config, VMOps t)+  :: forall (t :: VMType). (?op :: Word8, ?conf :: Config, VMOps t)   => Contract   -> Gas t   -> Expr EAddr@@ -1098,8 +1095,8 @@   -> Expr EWord   -> [Expr EWord]   -- continuation with gas available for call-  -> (Gas t -> EVM t s ())-  -> EVM t s ()+  -> (Gas t -> EVM t ())+  -> EVM t () callChecks this xGas xContext xTo xValue xInOffset xInSize xOutOffset xOutSize xs continue = do   vm <- get   let fees = vm.block.schedule@@ -1157,7 +1154,7 @@   -> Expr EWord   -> Expr EWord -> Expr EWord -> Expr EWord -> Expr EWord   -> [Expr EWord]-  -> EVM t s ()+  -> EVM t () precompiledContract this xGas precompileAddr recipient xValue inOffset inSize outOffset outSize xs   = callChecks this xGas (LitAddr recipient) (LitAddr precompileAddr) xValue inOffset inSize outOffset outSize xs $ \gas' ->     do@@ -1183,7 +1180,7 @@   :: (?op :: Word8, VMOps t)   => Addr   -> Gas t -> Expr EWord -> Expr EWord -> Expr EWord -> Expr EWord -> [Expr EWord]-  -> EVM t s ()+  -> EVM t () executePrecompile preCompileAddr gasCap inOffset inSize outOffset outSize xs  = do   vm <- get   input <- readMemory inOffset inSize@@ -1368,35 +1365,27 @@ pushToSequence :: MonadState s m => Setter s s (Seq a) (Seq a) -> a -> m () pushToSequence f x = f %= (Seq.|> x) -getCodeLocation :: VM t s -> CodeLocation+getCodeLocation :: VM t -> CodeLocation getCodeLocation vm = (vm.state.contract, vm.state.pc) -query :: Query t s -> EVM t s ()+query :: Query t -> EVM t () query q = assign #result $ Just $ HandleEffect (Query q) -runBoth :: Maybe Int -> Int -> RunBoth s -> EVM Symbolic s ()-runBoth depthLimit exploreDepth c = do-  if (isNothing depthLimit || (exploreDepth < fromJust depthLimit)) then do-    assign #result $ Just $ HandleEffect (RunBoth c)-  else do-    vm <- get-    assign #result $ Just $ Unfinished (BranchTooDeep {pc = vm.state.pc, addr = vm.state.contract})--runAll :: Maybe Int -> Int -> RunAll s -> EVM Symbolic s ()-runAll depthLimit exploreDepth c = do+fork :: Maybe Int -> Int -> BranchContext -> EVM Symbolic ()+fork depthLimit exploreDepth forkContext = do   if (isNothing depthLimit || (exploreDepth < fromJust depthLimit)) then do-    assign #result $ Just $ HandleEffect (RunAll c)+    assign #result $ Just $ HandleEffect (Branch forkContext)   else do     vm <- get     assign #result $ Just $ Unfinished (BranchTooDeep {pc = vm.state.pc, addr = vm.state.contract}) -fetchAccount :: VMOps t => Expr EAddr -> (Contract -> EVM t s ()) -> EVM t s ()+fetchAccount :: VMOps t => Expr EAddr -> (Contract -> EVM t ()) -> EVM t () fetchAccount addr continue =   let fallback = unexpectedSymArgW "trying to access a symbolic address that isn't already present in storage"   in fetchAccountWithFallback addr fallback continue  -- | Construct RPC Query and halt execution until resolved-fetchAccountWithFallback :: VMOps t => Expr EAddr -> (Expr EAddr -> EVM t s ()) -> (Contract -> EVM t s ()) -> EVM t s ()+fetchAccountWithFallback :: VMOps t => Expr EAddr -> (Expr EAddr -> EVM t ()) -> (Contract -> EVM t ()) -> EVM t () fetchAccountWithFallback addr fallback continue =   use (#env % #contracts % at addr) >>= \case     Just c -> continue c@@ -1411,10 +1400,16 @@             continue c       GVar _ -> internalError "Unexpected GVar" -accessStorage :: forall s t . (?conf :: Config, VMOps t, Typeable t) => Expr EAddr+accessConcreteStorage :: Expr Storage -> W256 -> W256+accessConcreteStorage storage slot' =+  case storage of+    (ConcreteStore m) -> fromMaybe 0 $ Map.lookup slot' m+    _ -> internalError "Storage must be concrete"++accessStorage :: forall t . (?conf :: Config, VMOps t, Typeable t) => Expr EAddr   -> Expr EWord-  -> (Expr EWord -> EVM t s ())-  -> EVM t s ()+  -> (Expr EWord -> EVM t ())+  -> EVM t () accessStorage addr slot continue = do   let slotConc = Expr.concKeccakSimpExpr slot   use (#env % #contracts % at addr) >>= \case@@ -1450,7 +1445,7 @@           -- So we store and return 0, as it is the only sound option           modifying (#env % #contracts % ix addr % #storage) (writeStorage slot (Lit 0))           continue $ Lit 0-      mkQuery :: Addr -> W256 -> EVM t s ()+      mkQuery :: Addr -> W256 -> EVM t ()       mkQuery a s = query $ PleaseFetchSlot a s $ \x -> do         modifying (#env % #contracts % ix (LitAddr a) % #storage) (writeStorage (Lit s) (Lit x))         assign #result Nothing@@ -1459,8 +1454,8 @@ accessTStorage   :: VMOps t => Expr EAddr   -> Expr EWord-  -> (Expr EWord -> EVM t s ())-  -> EVM t s ()+  -> (Expr EWord -> EVM t ())+  -> EVM t () accessTStorage addr slot continue = do   let slotConc = Expr.concKeccakSimpExpr slot   use (#env % #contracts % at addr) >>= \case@@ -1476,10 +1471,10 @@       fetchAccount addr $ \_ ->         accessTStorage addr slot continue -clearTStorages :: EVM t s ()+clearTStorages :: EVM t () clearTStorages = (#env % #contracts) %= fmap (\c -> c { tStorage = ConcreteStore mempty } :: Contract) -accountExists :: Expr EAddr -> VM t s -> Bool+accountExists :: Expr EAddr -> VM t -> Bool accountExists addr vm =   case Map.lookup addr vm.env.contracts of     Just c -> not (accountEmpty c)@@ -1498,7 +1493,7 @@  -- Adds constraints such that two symbolic addresses cannot alias each other -- and symbolic addresses cannot alias concrete addresses-addAliasConstraints :: EVM t s ()+addAliasConstraints :: EVM t () addAliasConstraints = do   vm <- get   let addrConstr = noClash $ Map.keys vm.env.contracts@@ -1507,7 +1502,7 @@     noClash addrs = [a ./= b | a <- addrs, b <- addrs, Expr.isSymAddr b, a < b]  -- * How to finalize a transaction-finalize :: VMOps t => EVM t s ()+finalize :: VMOps t => EVM t () finalize = do   let     revertContracts  = use (#tx % #txReversion) >>= assign (#env % #contracts)@@ -1565,7 +1560,7 @@       (\k a -> not ((k `elem` touchedAddresses) && accountEmpty a)))  -- | Loads the selected contract as the current contract to execute-loadContract :: Expr EAddr -> State (VM t s) ()+loadContract :: Expr EAddr -> State (VM t) () loadContract target =   preuse (#env % #contracts % ix target % #code) >>=     \case@@ -1576,14 +1571,14 @@         assign (#state % #code)     targetCode         assign (#state % #codeContract) target -limitStack :: VMOps t => Int -> EVM (t :: VMType) s () -> EVM t s ()+limitStack :: VMOps t => Int -> EVM (t :: VMType) () -> EVM t () limitStack n continue = do   stk <- use (#state % #stack)   if length stk + n > 1024     then vmError StackLimitExceeded     else continue -notStatic :: VMOps t => EVM t s () -> EVM t s ()+notStatic :: VMOps t => EVM t () -> EVM t () notStatic continue = do   bad <- use (#state % #static)   if bad@@ -1593,7 +1588,7 @@ -- Ensures the account `addr` exists on the VM environment. -- Useful when `addr` needs to e.g. keep a eth balance or -- be the source of contract deployments via pranks-touchAddress :: VMOps t => Expr EAddr -> EVM t s ()+touchAddress :: VMOps t => Expr EAddr -> EVM t () touchAddress addr = do   baseState <- use (#config % #baseState)   let mkc = case baseState of@@ -1601,21 +1596,21 @@               EmptyBase -> const emptyContract   (#env % #contracts) %= (Map.insertWith (\_ e -> e) addr (mkc addr)) -onlyDeployed :: forall t s . (?conf :: Config, VMOps t, Typeable t) =>+onlyDeployed :: forall t . (?conf :: Config, VMOps t, Typeable t) =>   Expr EWord-  -> (Expr EWord -> EVM t s ())-  -> (Expr EAddr -> EVM t s ())-  -> EVM t s ()+  -> (Expr EWord -> EVM t ())+  -> (Expr EAddr -> EVM t ())+  -> EVM t () onlyDeployed addrExpr fallback continue = do     vm <- get     if not (?conf.onlyDeployed) then fallback addrExpr     else case eqT @t @Symbolic of       Just Refl -> do         let deployedAddrs = map forceEAddrToEWord $ mapMaybe (codeMustExist vm) $ Map.keys vm.env.contracts-        runAll (?conf.maxDepth) vm.exploreDepth $ PleaseRunAll addrExpr deployedAddrs runAllPaths+        fork (?conf.maxDepth) vm.exploreDepth $ PleaseRunAll deployedAddrs runAllPaths       _ -> internalError "Unknown address in Concrete mode"   where-    codeMustExist :: (VM t s) -> Expr EAddr -> Maybe (Expr EAddr)+    codeMustExist :: (VM t) -> Expr EAddr -> Maybe (Expr EAddr)     codeMustExist vm addr = do       contr <- Map.lookup addr vm.env.contracts       case contr.code of@@ -1626,11 +1621,11 @@         pushTo #constraints $ Expr.simplifyProp (addrExpr .== val)         continue (forceEWordToEAddr val) -forceAddr :: forall t s . (?conf :: Config, VMOps t, Typeable t) =>+forceAddr :: forall t . (?conf :: Config, VMOps t, Typeable t) =>   Expr EWord-  -> (Expr EWord -> EVM t s ())-  -> (Expr EAddr -> EVM t s ())-  -> EVM t s ()+  -> (Expr EWord -> EVM t ())+  -> (Expr EAddr -> EVM t ())+  -> EVM t () forceAddr addrExpr fallback continue = case wordToAddr addrExpr of   Nothing -> manySolutions (?conf).maxDepth addrExpr 20 $ \case     Just sol -> continue $ LitAddr (truncateToAddr sol)@@ -1638,20 +1633,20 @@   Just c -> continue c  -unexpectedSymArg :: (Typeable a, VMOps t) => String -> [Expr a] -> EVM t s ()+unexpectedSymArg :: (Typeable a, VMOps t) => String -> [Expr a] -> EVM t () unexpectedSymArg msg n = do   pc <- use (#state % #pc)   state <- use #state   let opName = getOpName state   partial $ UnexpectedSymbolicArg pc state.contract opName msg (wrap n) -unexpectedSymArgW :: (Typeable a, VMOps t) => String -> Expr a -> EVM t s ()+unexpectedSymArgW :: (Typeable a, VMOps t) => String -> Expr a -> EVM t () unexpectedSymArgW msg n = unexpectedSymArg msg [n] -unknownCode :: VMOps t => Expr EAddr -> EVM t s ()+unknownCode :: VMOps t => Expr EAddr -> EVM t () unknownCode n = unexpectedSymArg "call target has unknown code" [n] -freshBufFallback :: (?conf :: Config, VMOps t, ?op :: Word8) => [Expr EWord] -> EVM t s ()+freshBufFallback :: (?conf :: Config, VMOps t, ?op :: Word8) => [Expr EWord] -> EVM t () freshBufFallback xs = do   -- Reset caller if needed   resetCaller <- use $ #state % #resetCaller@@ -1667,7 +1662,7 @@   assign (#state % #returndata) freshReturndataExpr   next >> assign' (#state % #stack) (freshVarExpr:xs) -freshVarFallback:: (VMOps t, ?op :: Word8) => [Expr EWord] -> Expr a -> EVM t s ()+freshVarFallback:: (VMOps t, ?op :: Word8) => [Expr EWord] -> Expr a -> EVM t () freshVarFallback xs _ = do   -- Reset caller if needed   resetCaller <- use $ #state % #resetCaller@@ -1679,55 +1674,55 @@   let freshVarExpr = Var (opName <> "-result-stack-fresh-" <> (pack . show) freshVar)   next >> assign' (#state % #stack) (freshVarExpr:xs) -forceConcrete :: (?conf :: Config, VMOps t) => Expr EWord -> String -> (W256 -> EVM t s ()) -> EVM t s ()+forceConcrete :: (?conf :: Config, VMOps t) => Expr EWord -> String -> (W256 -> EVM t ()) -> EVM t () forceConcrete n = forceConcreteLimitSz n 32 -forceConcreteLimitSz :: (?conf :: Config, VMOps t) => Expr EWord -> Int -> String -> (W256 -> EVM t s ()) -> EVM t s ()+forceConcreteLimitSz :: (?conf :: Config, VMOps t) => Expr EWord -> Int -> String -> (W256 -> EVM t ()) -> EVM t () forceConcreteLimitSz n bytes msg continue = case maybeLitWordSimp n of   Nothing -> manySolutions (?conf).maxDepth n bytes $ maybe fallback continue   Just c -> continue c   where fallback = unexpectedSymArg msg [n] -forceConcreteAddr :: (?conf :: Config, VMOps t) => Expr EAddr -> String -> (Addr -> EVM t s ()) -> EVM t s ()+forceConcreteAddr :: (?conf :: Config, VMOps t) => Expr EAddr -> String -> (Addr -> EVM t ()) -> EVM t () forceConcreteAddr n msg continue = case maybeLitAddrSimp n of   Nothing -> manySolutions (?conf).maxDepth (WAddr n) 20 $ maybe fallback $ \c -> continue (truncateToAddr c)   Just c -> continue c   where fallback = unexpectedSymArg msg [n] -forceConcreteAddr2 :: VMOps t => (Expr EAddr, Expr EAddr) -> String -> ((Addr, Addr) -> EVM t s ()) -> EVM t s ()+forceConcreteAddr2 :: VMOps t => (Expr EAddr, Expr EAddr) -> String -> ((Addr, Addr) -> EVM t ()) -> EVM t () forceConcreteAddr2 (n,m) msg continue = case (maybeLitAddrSimp n, maybeLitAddrSimp m) of   (Just c, Just d) -> continue (c,d)   _ -> unexpectedSymArg msg [n, m] -forceConcrete2 :: VMOps t => (Expr EWord, Expr EWord) -> String -> ((W256, W256) -> EVM t s ()) -> EVM t s ()+forceConcrete2 :: VMOps t => (Expr EWord, Expr EWord) -> String -> ((W256, W256) -> EVM t ()) -> EVM t () forceConcrete2 (n,m) msg continue = case (maybeLitWordSimp n, maybeLitWordSimp m) of   (Just c, Just d) -> continue (c, d)   _ -> unexpectedSymArg msg [n, m] -forceConcreteBuf :: VMOps t => Expr Buf -> String -> (ByteString -> EVM t s ()) -> EVM t s ()+forceConcreteBuf :: VMOps t => Expr Buf -> String -> (ByteString -> EVM t ()) -> EVM t () forceConcreteBuf (ConcreteBuf b) _ continue = continue b forceConcreteBuf b msg _ = unexpectedSymArg msg [b]  -- * Substate manipulation-refund :: Word64 -> EVM t s ()+refund :: Word64 -> EVM t () refund n = do   self <- use (#state % #contract)   pushTo (#tx % #subState % #refunds) (self, n) -unRefund :: Word64 -> EVM t s ()+unRefund :: Word64 -> EVM t () unRefund n = do   self <- use (#state % #contract)   refs <- use (#tx % #subState % #refunds)   assign (#tx % #subState % #refunds)     (filter (\(a,b) -> not (a == self && b == n)) refs) -touchAccount :: Expr EAddr -> EVM t s ()+touchAccount :: Expr EAddr -> EVM t () touchAccount = pushTo ((#tx % #subState) % #touchedAccounts) -selfdestruct :: Expr EAddr -> EVM t s ()+selfdestruct :: Expr EAddr -> EVM t () selfdestruct = pushTo ((#tx % #subState) % #selfdestructs) -accessAndBurn :: VMOps t => Expr EAddr -> EVM t s () -> EVM t s ()+accessAndBurn :: VMOps t => Expr EAddr -> EVM t () -> EVM t () accessAndBurn x cont = do   FeeSchedule {..} <- use (#block % #schedule)   acc <- accessAccountForGas x@@ -1736,7 +1731,7 @@  -- | returns a wrapped boolean- if true, this address has been touched before in the txn (warm gas cost as in EIP 2929) -- otherwise cold-accessAccountForGas :: Expr EAddr -> EVM t s Bool+accessAccountForGas :: Expr EAddr -> EVM t Bool accessAccountForGas addr = do   accessedAddrs <- use (#tx % #subState % #accessedAddresses)   let accessed = member addr accessedAddrs@@ -1745,15 +1740,12 @@  -- | returns a wrapped boolean- if true, this slot has been touched before in the txn (warm gas cost as in EIP 2929) -- otherwise cold-accessStorageForGas :: Expr EAddr -> Expr EWord -> EVM t s Bool+accessStorageForGas :: Expr EAddr -> W256 -> EVM t Bool accessStorageForGas addr key = do   accessedStrkeys <- use (#tx % #subState % #accessedStorageKeys)-  case maybeLitWordSimp key of-    Just litword -> do-      let accessed = member (addr, litword) accessedStrkeys-      assign (#tx % #subState % #accessedStorageKeys) (insert (addr, litword) accessedStrkeys)-      pure accessed-    _ -> pure False+  let accessed = member (addr, key) accessedStrkeys+  unless accessed $ assign (#tx % #subState % #accessedStorageKeys) (insert (addr, key) accessedStrkeys)+  pure accessed  -- * Cheat codes @@ -1765,9 +1757,9 @@ cheatCode = LitAddr $ unsafeInto (keccak' "hevm cheat code")  cheat-  :: forall t s . (?conf :: Config, ?op :: Word8, VMOps t, Typeable t)+  :: forall t . (?conf :: Config, ?op :: Word8, VMOps t, Typeable t)   => Gas t -> (Expr EWord, Expr EWord) -> (Expr EWord, Expr EWord) -> [Expr EWord]-  -> EVM t s ()+  -> EVM t () cheat gas (inOffset, inSize) (outOffset, outSize) xs = do   vm <- get   input <- readMemory (Expr.add inOffset (Lit 4)) (Expr.sub inSize (Lit 4))@@ -1789,7 +1781,7 @@       Nothing -> unexpectedSymArg "symbolic cheatcode selector" [abi]     Just concAbi -> runCheat concAbi input   where-    runCheat :: W256 -> Expr 'Buf -> EVM t s ()+    runCheat :: W256 -> Expr 'Buf -> EVM t ()     runCheat abi input =  do       let abi' = unsafeInto abi       case Map.lookup abi' cheatActions of@@ -1798,9 +1790,9 @@           whenSymbolicElse (partial $ CheatCodeMissing vm.state.pc vm.state.contract abi') (vmError $ BadCheatCode "Cannot understand cheatcode." abi')         Just action -> action input -type CheatAction t s = Expr Buf -> EVM t s ()+type CheatAction t = Expr Buf -> EVM t () -cheatActions :: (?conf :: Config, VMOps t, Typeable t) => Map FunctionSelector (CheatAction t s)+cheatActions :: (?conf :: Config, VMOps t, Typeable t) => Map FunctionSelector (CheatAction t) cheatActions = Map.fromList   [ action "ffi(string[])" $       \sig input -> do@@ -2057,13 +2049,13 @@   where     action s f = (abiKeccak s, f (abiKeccak s))     either' v l r = either l r v-    frameReturn :: VMOps t => AbiValue -> EVM t s ()+    frameReturn :: VMOps t => AbiValue -> EVM t ()     frameReturn v = frameReturnBuf $ encodeAbiValue v-    frameReturnBuf :: VMOps t => ByteString -> EVM t s ()+    frameReturnBuf :: VMOps t => ByteString -> EVM t ()     frameReturnBuf buf = frameReturnExpr $ ConcreteBuf buf-    frameReturnExpr :: VMOps t => Expr Buf -> EVM t s ()+    frameReturnExpr :: VMOps t => Expr Buf -> EVM t ()     frameReturnExpr e = finishFrame (FrameReturned e)-    frameRevert :: VMOps t => ByteString -> EVM t s ()+    frameRevert :: VMOps t => ByteString -> EVM t ()     frameRevert err = finishFrame (FrameReverted $ errorMsg err)     errorMsg :: ByteString -> Expr Buf     errorMsg err = ConcreteBuf $ selector "Error(string)" <> encodeAbiValue (AbiTuple $ V.fromList [AbiString err])@@ -2125,7 +2117,7 @@ -- * General call implementation ("delegateCall") -- note that the continuation is ignored in the precompile case delegateCall-  :: forall t s . (VMOps t, ?op :: Word8, ?conf :: Config, Typeable t)+  :: forall t . (VMOps t, ?op :: Word8, ?conf :: Config, Typeable t)   => Contract   -> Gas t   -> Expr EAddr@@ -2136,9 +2128,9 @@   -> Expr EWord   -> Expr EWord   -> [Expr EWord]-  -> (Expr EAddr -> EVM t s ()) -- fallback-  -> (Expr EAddr -> EVM t s ()) -- continue-  -> EVM t s ()+  -> (Expr EAddr -> EVM t ()) -- fallback+  -> (Expr EAddr -> EVM t ()) -- continue+  -> EVM t () delegateCall this gasGiven xTo xContext xValue xInOffset xInSize xOutOffset xOutSize xs fallback continue   | isPrecompileAddr xTo       = forceConcreteAddr2 (xTo, xContext) "Cannot call precompile with symbolic addresses" $@@ -2156,7 +2148,7 @@               UnknownCode _ -> betterFallback xGas vm0 xTo               _ -> actualCall target xTo xGas vm0   where-    betterFallback :: Gas t -> (VM t s) -> Expr 'EAddr -> EVM t s ()+    betterFallback :: Gas t -> (VM t) -> Expr 'EAddr -> EVM t ()     betterFallback xGas vm0 addr = onlyDeployed (forceEAddrToEWord addr) (fallback . forceEWordToEAddr) $ \a -> do         let target = fromJust $ Map.lookup a vm0.env.contracts         actualCall target a xGas vm0@@ -2213,9 +2205,9 @@     _ -> True   Nothing -> False -create :: forall t s. (?op :: Word8, ?conf::Config, VMOps t)+create :: forall t. (?op :: Word8, ?conf::Config, VMOps t)   => Expr EAddr -> Contract-  -> Expr EWord -> Gas t -> Expr EWord -> [Expr EWord] -> Expr EAddr -> Expr Buf -> EVM t s ()+  -> Expr EWord -> Gas t -> Expr EWord -> [Expr EWord] -> Expr EAddr -> Expr Buf -> EVM t () create self this xSize xGas xValue xs newAddr initCode = do   vm0 <- get   -- are we exceeding the max init code size@@ -2301,7 +2293,7 @@               , state   = vm1.state { stack = xs }               } -            state :: FrameState t s <- lift blankState+            state :: FrameState t <- lift blankState             assign #state $ state               { contract     = newAddr               , codeContract = newAddr@@ -2335,7 +2327,7 @@  -- | Replace a contract's code, like when CREATE returns -- from the constructor code.-replaceCode :: Expr EAddr -> ContractCode -> EVM t s ()+replaceCode :: Expr EAddr -> ContractCode -> EVM t () replaceCode target newCode =   zoom (#env % #contracts % at target) $     get >>= \case@@ -2354,25 +2346,25 @@       Nothing ->         internalError "Can't replace code of nonexistent contract" -replaceCodeOfSelf :: ContractCode -> EVM t s ()+replaceCodeOfSelf :: ContractCode -> EVM t () replaceCodeOfSelf newCode = do   vm <- get   replaceCode vm.state.contract newCode -resetState :: VMOps t => EVM t s ()+resetState :: VMOps t => EVM t () resetState = do   state <- lift blankState   modify' $ \vm -> vm { result = Nothing, frames = [], state }  -- * VM error implementation -vmError :: VMOps t => EvmError -> EVM t s ()+vmError :: VMOps t => EvmError -> EVM t () vmError e = finishFrame (FrameErrored e)  wrap :: Typeable a => [Expr a] -> [SomeExpr] wrap = fmap SomeExpr -underrun :: VMOps t => EVM t s ()+underrun :: VMOps t => EVM t () underrun = vmError StackUnderrun  -- | A stack frame can be popped in three ways.@@ -2382,7 +2374,7 @@   | FrameErrored EvmError -- ^ Any other error   deriving Show -finishAllFramesAndStop :: VMOps t => EVM t s ()+finishAllFramesAndStop :: VMOps t => EVM t () finishAllFramesAndStop = do   vm <- get   case vm.frames of@@ -2396,7 +2388,7 @@ -- -- It also handles the case when the current stack frame is the only one; -- in this case, we set the final '_result' of the VM execution.-finishFrame :: VMOps t => FrameResult -> EVM t s ()+finishFrame :: VMOps t => FrameResult -> EVM t () finishFrame how = do   oldVm <- get @@ -2524,8 +2516,8 @@ accessUnboundedMemoryRange   :: VMOps t => Word64   -> Word64-  -> EVM t s ()-  -> EVM t s ()+  -> EVM t ()+  -> EVM t () accessUnboundedMemoryRange _ 0 continue = continue accessUnboundedMemoryRange f l continue = do   m0 <- use (#state % #memorySize)@@ -2539,8 +2531,8 @@   :: VMOps t   => Expr EWord   -> Expr EWord-  -> EVM t s ()-  -> EVM t s ()+  -> EVM t ()+  -> EVM t () accessMemoryRange _ (Lit 0) continue = continue accessMemoryRange (Lit offs) (Lit sz) continue =   case (,) <$> toWord64 offs <*> toWord64 sz of@@ -2559,11 +2551,11 @@ accessMemoryRange _ _ continue = continue  accessMemoryWord-  :: VMOps t => Expr EWord -> EVM t s () -> EVM t s ()+  :: VMOps t => Expr EWord -> EVM t () -> EVM t () accessMemoryWord x = accessMemoryRange x (Lit 32)  copyBytesToMemory-  :: Expr Buf -> Expr EWord -> Expr EWord -> Expr EWord -> EVM t s ()+  :: Expr Buf -> Expr EWord -> Expr EWord -> Expr EWord -> EVM t () copyBytesToMemory bs size srcOffset memOffset =   if size == Lit 0 then noop   else do@@ -2589,11 +2581,11 @@         assign (#state % #memory) $ SymbolicMemory $ copySlice srcOffset memOffset size bs mem  copyCallBytesToMemory-  :: Expr Buf -> Expr EWord -> Expr EWord -> EVM t s ()+  :: Expr Buf -> Expr EWord -> Expr EWord -> EVM t () copyCallBytesToMemory bs size yOffset =   copyBytesToMemory bs (Expr.min size (bufLength bs)) (Lit 0) yOffset -readMemory :: Expr EWord -> Expr EWord -> EVM t s (Expr Buf)+readMemory :: Expr EWord -> Expr EWord -> EVM t (Expr Buf) readMemory offset' size' = do   vm <- get   case vm.state.memory of@@ -2621,7 +2613,7 @@  -- * Tracing -withTraceLocation :: TraceData -> EVM t s Trace+withTraceLocation :: TraceData -> EVM t Trace withTraceLocation x = do   vm <- get   let this = fromJust $ currentContract vm@@ -2631,19 +2623,19 @@     , opIx = fromMaybe 0 $ this.opIxMap VS.!? vm.state.pc     } -pushTrace :: TraceData -> EVM t s ()+pushTrace :: TraceData -> EVM t () pushTrace x = do   trace <- withTraceLocation x   modifying #traces $     \t -> Zipper.children $ Zipper.insert (Node trace []) t -insertTrace :: TraceData -> EVM t s ()+insertTrace :: TraceData -> EVM t () insertTrace x = do   trace <- withTraceLocation x   modifying #traces $     \t -> Zipper.nextSpace $ Zipper.insert (Node trace []) t -popTrace :: EVM t s ()+popTrace :: EVM t () popTrace =   modifying #traces $     \t -> case Zipper.parent t of@@ -2656,24 +2648,22 @@     Nothing -> Zipper.toForest z     Just z' -> zipperRootForest (Zipper.nextSpace z') -traceForest :: VM t s -> Forest Trace+traceForest :: VM t -> Forest Trace traceForest vm = zipperRootForest vm.traces  traceForest' :: Expr End -> Forest Trace traceForest' (Success _ (TraceContext f _ _) _ _) = f traceForest' (Partial _ (TraceContext f _ _) _) = f traceForest' (Failure _ (TraceContext f _ _) _) = f-traceForest' (ITE {}) = internalError"Internal Error: ITE does not contain a trace" traceForest' (GVar {}) = internalError"Internal Error: Unexpected GVar"  traceContext :: Expr End -> TraceContext traceContext (Success _ c _ _) = c traceContext (Partial _ c _) = c traceContext (Failure _ c _) = c-traceContext (ITE {}) = internalError"Internal Error: ITE does not contain a trace" traceContext (GVar {}) = internalError"Internal Error: Unexpected GVar" -traceTopLog :: [Expr Log] -> EVM t s ()+traceTopLog :: [Expr Log] -> EVM t () traceTopLog [] = noop traceTopLog ((LogEntry addr bytes topics) : _) = do   trace <- withTraceLocation (EventTrace addr bytes topics)@@ -2683,13 +2673,13 @@  -- * Stack manipulation -push :: W256 -> EVM t s ()+push :: W256 -> EVM t () push = pushSym . Lit -pushSym :: Expr EWord -> EVM t s ()+pushSym :: Expr EWord -> EVM t () pushSym x = modifying' (#state % #stack) (x :) -pushAddr :: Expr EAddr -> EVM t s ()+pushAddr :: Expr EAddr -> EVM t () pushAddr (LitAddr x) = modifying' (#state % #stack) (Lit (into x) :) pushAddr x@(SymAddr _) = modifying' (#state % #stack) (WAddr x :) pushAddr (GVar _) = internalError "Unexpected GVar"@@ -2698,7 +2688,7 @@   :: (?op :: Word8, VMOps t)   => Word64   -> (Expr EWord -> Expr EWord)-  -> EVM t s ()+  -> EVM t () stackOp1 cost f =   use (#state % #stack) >>= \case     x:xs ->@@ -2713,7 +2703,7 @@   :: (?op :: Word8, VMOps t)   => Word64   -> (Expr EWord -> Expr EWord -> Expr EWord)-  -> EVM t s ()+  -> EVM t () stackOp2 cost f =   use (#state % #stack) >>= \case     x:y:xs ->@@ -2727,7 +2717,7 @@   :: (?op :: Word8, VMOps t)   => Word64   -> (Expr EWord -> Expr EWord -> Expr EWord -> Expr EWord)-  -> EVM t s ()+  -> EVM t () stackOp3 cost f =   use (#state % #stack) >>= \case     x:y:z:xs ->@@ -2739,7 +2729,7 @@  -- * Bytecode data functions -checkJump :: VMOps t => Int -> [Expr EWord] -> EVM t s ()+checkJump :: VMOps t => Int -> [Expr EWord] -> EVM t () checkJump x xs = noJumpIntoInitData x $ do   vm <- get   case isValidJumpDest vm x of@@ -2749,7 +2739,7 @@     False -> vmError BadJumpDestination  -- fails with partial if we're trying to jump into the symbolic region of an `InitCode`-noJumpIntoInitData :: VMOps t => Int -> EVM t s () -> EVM t s ()+noJumpIntoInitData :: VMOps t => Int -> EVM t () -> EVM t () noJumpIntoInitData idx cont = do   vm <- get   case vm.state.code of@@ -2764,7 +2754,7 @@     -- we're not executing init code, so nothing to check here     _ -> cont -isValidJumpDest :: VM t s -> Int -> Bool+isValidJumpDest :: VM t -> Int -> Bool isValidJumpDest vm x = let     code = vm.state.code     self = vm.state.codeContract@@ -2830,7 +2820,7 @@           {- PUSH data. -}        (n - 1,        i + 1, j,     m >> VS.Mutable.write v i j)  -vmOp :: VM t s -> Maybe Op+vmOp :: VM t -> Maybe Op vmOp vm =   let i  = vm ^. #state % #pc       code' = vm ^. #state % #code@@ -2846,7 +2836,7 @@      then Nothing      else Just (readOp op pushdata) -vmOpIx :: VM t s -> Maybe Int+vmOpIx :: VM t -> Maybe Int vmOpIx vm =   do self <- currentContract vm      self.opIxMap VS.!? vm.state.pc@@ -2975,22 +2965,22 @@ toBuf (RuntimeCode (ConcreteRuntimeCode ops)) = Just $ ConcreteBuf ops toBuf (RuntimeCode (SymbolicRuntimeCode ops)) = Just $ Expr.fromList ops -codeloc :: EVM t s CodeLocation+codeloc :: EVM t CodeLocation codeloc = do   vm <- get   pure (vm.state.contract, vm.state.pc) -createAddress :: Expr EAddr -> Maybe W64 -> EVM t s (Expr EAddr)+createAddress :: Expr EAddr -> Maybe W64 -> EVM t (Expr EAddr) createAddress (LitAddr a) (Just n) = pure $ Concrete.createAddress a n createAddress (GVar _) _ = internalError "Unexpected GVar" createAddress _ _ = freshSymAddr -create2Address :: Expr EAddr -> W256 -> ByteString -> EVM t s (Expr EAddr)+create2Address :: Expr EAddr -> W256 -> ByteString -> EVM t (Expr EAddr) create2Address (LitAddr a) s b = pure $ Concrete.create2Address a s b create2Address (SymAddr _) _ _ = freshSymAddr create2Address (GVar _) _ _ = internalError "Unexpected GVar" -freshSymAddr :: EVM t s (Expr EAddr)+freshSymAddr :: EVM t (Expr EAddr) freshSymAddr = do   modifying (#env % #freshAddresses) (+ 1)   n <- use (#env % #freshAddresses)@@ -3013,7 +3003,7 @@ log2 :: FiniteBits b => b -> Int log2 x = finiteBitSize x - 1 - countLeadingZeros x -writeMemory :: MutableMemory s -> Int -> ByteString -> EVM t s ()+writeMemory :: MutableMemory -> Int -> ByteString -> EVM t () writeMemory memory offset buf = do   memory' <- expandMemory (offset + BS.length buf)   VS.iforM_ (byteStringToVector buf) $ \i v -> do@@ -3036,7 +3026,7 @@     else       pure memory -freezeMemory :: MutableMemory s -> EVM t s (Expr Buf)+freezeMemory :: MutableMemory -> EVM t (Expr Buf) freezeMemory memory =   ConcreteBuf . vectorToByteString <$> VS.freeze memory @@ -3074,12 +3064,11 @@     vm <- get     query $ PleaseAskSMT cond pathconds (runBothPaths loc vm.exploreDepth)     where-      condSimp = Expr.simplify cond-      condSimpConc = Expr.concKeccakSimpExpr condSimp       runBothPaths loc _ (Case v) = do         assign #result Nothing-        pushTo #constraints $ if v then Expr.simplifyProp (Lit 0 ./= condSimpConc)-                                   else Expr.simplifyProp (Lit 0 .== condSimpConc)+        let condSimp = Expr.simplify cond+        pushTo #constraints $ if v then Expr.simplifyProp (Lit 0 ./= condSimp)+                                   else Expr.simplifyProp (Lit 0 .== condSimp)         (iteration, _) <- use (#iterations % at loc % non (0,[]))         stack <- use (#state % #stack)         assign (#pathsVisited % at (loc, iteration)) (Just v)@@ -3087,7 +3076,7 @@         continue v       -- Both paths are possible; we ask for more input       runBothPaths loc exploreDepth UnknownBranch =-        (runBoth depthLimit exploreDepth ) . PleaseRunBoth condSimp $ (runBothPaths loc exploreDepth) . Case+        (fork depthLimit exploreDepth ) . PleaseRunBoth $ (runBothPaths loc exploreDepth) . Case    -- numBytes allows us to specify how many bytes of the returned value is relevant   -- if it's e.g.a JUMP, only 2 bytes can be relevant. This allows us to avoid@@ -3106,7 +3095,7 @@             assign #result Nothing             pushTo #constraints $ Expr.simplifyProp (ewordExpr .== (Lit val))             continue $ Just val-          _ -> runAll maxDepth vm.exploreDepth $ PleaseRunAll ewordExpr (map Lit concVals) runAllPaths+          _ -> fork maxDepth vm.exploreDepth $ PleaseRunAll (map Lit concVals) runAllPaths       Nothing -> do         assign #result Nothing         continue Nothing@@ -3248,7 +3237,7 @@   manySolutions _ _ _ = internalError "SMT solver should never be needed in concrete mode"  -- Create symbolic VM from concrete VM-symbolify :: VM Concrete s -> VM Symbolic s+symbolify :: VM Concrete -> VM Symbolic symbolify vm =   vm { result = symbolifyResult <$> vm.result      , state  = symbolifyFrameState vm.state@@ -3256,13 +3245,13 @@      , burned = ()      } -symbolifyFrameState :: FrameState Concrete s -> FrameState Symbolic s+symbolifyFrameState :: FrameState Concrete -> FrameState Symbolic symbolifyFrameState state = state { gas = () } -symbolifyFrame :: Frame Concrete s -> Frame Symbolic s+symbolifyFrame :: Frame Concrete -> Frame Symbolic symbolifyFrame frame = frame { state = symbolifyFrameState frame.state } -symbolifyResult :: VMResult Concrete s -> VMResult Symbolic s+symbolifyResult :: VMResult Concrete -> VMResult Symbolic symbolifyResult result =   case result of     HandleEffect _ -> internalError "shouldn't happen"@@ -3270,5 +3259,5 @@     VMSuccess b -> VMSuccess b  -burn :: VMOps t => Word64 -> EVM t s () -> EVM t s ()+burn :: VMOps t => Word64 -> EVM t () -> EVM t () burn = burn' . toGas

@@ -9,14 +9,14 @@ import Data.ByteString (ByteString) import Data.Maybe (isNothing) import Optics.Core-import Control.Monad.ST (ST)+import Control.Monad.ST (ST, RealWorld) import EVM.Effects (Config) import Data.Data (Typeable)  ethrunAddress :: Addr ethrunAddress = Addr 0x00a329c0648769a73afac7f9381e08fb43dbea72 -vmForEthrunCreation :: VMOps t => ByteString -> ST s (VM t s)+vmForEthrunCreation :: VMOps t => ByteString -> ST RealWorld (VM t) vmForEthrunCreation creationCode =   (makeVm $ VMOpts     { contract = initialContract (InitCode creationCode mempty)@@ -48,21 +48,21 @@     }) <&> set (#env % #contracts % at (LitAddr ethrunAddress))              (Just (initialContract (RuntimeCode (ConcreteRuntimeCode "")))) -exec :: (VMOps t, Typeable t) => Config -> EVM t s (VMResult t s)+exec :: (VMOps t, Typeable t) => Config -> EVM t (VMResult t) exec conf = do   vm <- get   case vm.result of     Nothing -> exec1 conf >> exec conf     Just r -> pure r -run :: (VMOps t, Typeable t) => Config -> EVM t s (VM t s)+run :: (VMOps t, Typeable t) => Config -> EVM t (VM t) run conf = do   vm <- get   case vm.result of     Nothing -> exec1 conf >> run conf     Just _ -> pure vm -execWhile :: (VM t s -> Bool) -> State (VM t s) Int+execWhile :: (VM t -> Bool) -> State (VM t) Int execWhile p = go 0   where     go i = do

@@ -9,7 +9,7 @@ import Prelude hiding (LT, GT) import Control.Monad (unless, when) import Control.Monad.ST (ST)-import Control.Monad.State (put, get, modify, execState, State)+import Control.Monad.State (put, get, execState, State) import Data.Bits hiding (And, Xor) import Data.ByteString (ByteString) import Data.ByteString qualified as BS@@ -177,7 +177,7 @@ not = op1 Not complement  shl :: Expr EWord -> Expr EWord -> Expr EWord-shl = op2 SHL (\x y -> if x > 256 then 0 else shiftL y (fromIntegral x))+shl = op2 SHL (\x y -> if x >= 256 then 0 else shiftL y (fromIntegral x))  shr :: Expr EWord -> Expr EWord -> Expr EWord shr = op2@@ -1001,20 +1001,6 @@     go (ReadByte idx buf) = readByte idx buf     go (BufLength buf) = bufLength buf -    -- We can zero out any bytes in a base ConcreteBuf that we know will be overwritten by a later write-    -- TODO: make this fully general for entire write chains, not just a single write.-    go o@(WriteWord (Lit idx) val (ConcreteBuf b))-      | idx >= maxBytes = o-      | BS.length b >= (unsafeInto idx + 32) =-          let-            slot = BS.take 32 (BS.drop (unsafeInto idx) b)-            isSlotZero = BS.all (== 0) slot-            content = if isSlotZero-              then b-              else (BS.take (unsafeInto idx) b)-                <> (BS.replicate 32 0)-                <> (BS.drop (unsafeInto idx + 32) b)-          in writeWord (Lit idx) val (ConcreteBuf content)     go (WriteWord a b c) = writeWord a b c      go (WriteByte a b c) = writeByte a b c@@ -1063,6 +1049,7 @@     go (IsZero (IsZero (IsZero a))) = iszero a     go (IsZero (IsZero (LT x y))) = lt x y     go (IsZero (IsZero (Eq x y))) = eq x y+    go (IsZero (IsZero a)) = lt (Lit 0) a     go (IsZero (Xor x y)) = eq x y     go (IsZero a) = iszero a @@ -1076,11 +1063,47 @@       | a == b = Lit 1       | otherwise = eq a b -    -- redundant ITE-    go (ITE (Lit x) a b)-      | x == 0 = b-      | otherwise = a+    -- COMPARISONS+    -- First special cases +    -- we write at least 32, so if x <= 32, it's FALSE+    go o@(EVM.Types.LT (BufLength (WriteWord {})) (Lit x))+      | x <= 32 = Lit 0+      | otherwise = o+    -- we write at least 32, so if x < 32, it's TRUE+    go o@(EVM.Types.LT (Lit x) (BufLength (WriteWord {})))+      | x < 32 = Lit 1+      | otherwise = o++    -- If a >= b then the value of the `Max` expression can never be < b+    go o@(LT (Max (Lit a) _) (Lit b))+      | a >= b = Lit 0+      | otherwise = o+    go o@(SLT (Sub (Max (Lit a) _) (Lit b)) (Lit c))+      = let sa, sb, sc :: Int256+            sa = fromIntegral a+            sb = fromIntegral b+            sc = fromIntegral c+        in if sa >= sb && sa - sb >= sc+           then Lit 0+           else o++    -- normalize all comparisons in terms of (S)LT+    go (EVM.Types.GT a b) = lt b a+    go (EVM.Types.GEq a b) = iszero (lt a b)+    go (EVM.Types.LEq a b) = iszero (lt b a)+    go (SGT a b) = slt b a++    -- LT+    go (EVM.Types.LT _ (Lit 0)) = Lit 0+    go (EVM.Types.LT a (Lit 1)) = iszero a+    go (EVM.Types.LT a b) = lt a b++    -- SLT+    go (SLT _ (Lit a)) | a == minLitSigned = Lit 0+    go (SLT (Lit a) _) | a == maxLitSigned = Lit 0+    go (SLT a b) = slt a b+     -- Masking as as per Solidity bit-packing of e.g. function parameters     go (And (Lit mask1) (Or (And (Lit mask2) _) x)) | (mask1 .&. mask2 == 0)          = And (Lit mask1) x@@ -1172,12 +1195,6 @@       where l = sort [a, b, c]             an = EVM.Expr.and -    -- A special pattern sometimes generated from Solidity that uses exponentiation to simulate bit shift.-    -- We can rewrite the exponentiation into a bit-shift under certain conditions.-    go (Exp (Lit 0x100) offset@(Mul (Lit a) (Mod _ (Lit b))))-      | a * b <= 32 && (maxWord256 `Prelude.div` a) > b = shl (mul (Lit 8) offset) (Lit 1)-    go (Exp (Lit 0x100) offset@(Mod _ (Lit 32))) = (shl (mul (Lit 8) offset)) (Lit 1)-     -- redundant add / sub     go (Sub (Add a b) c)       | a == c = b@@ -1228,22 +1245,6 @@       | b == (Lit 0) = a       | otherwise = EVM.Expr.or a b -    -- If x is ever non zero the Or will always evaluate to some non zero value and the false branch will be unreachable-    -- NOTE: with AND this does not work, because and(0x8, 0x4) = 0-    go (ITE (Or (Lit x) a) t f)-      | x == 0 = ITE a t f-      | otherwise = t-    go (ITE (Or a b@(Lit _)) t f) = ITE (Or b a) t f--    -- we write at least 32, so if x <= 32, it's FALSE-    go o@(EVM.Types.LT (BufLength (WriteWord {})) (Lit x))-      | x <= 32 = Lit 0-      | otherwise = o-    -- we write at least 32, so if x < 32, it's TRUE-    go o@(EVM.Types.LT (Lit x) (BufLength (WriteWord {})))-      | x < 32 = Lit 1-      | otherwise = o-     -- Double NOT is a no-op, since it's a bitwise inversion     go (EVM.Types.Not (EVM.Types.Not a)) = a @@ -1268,42 +1269,21 @@     go (SDiv _ (Lit 0)) = Lit 0 -- divide anything by 0 is zero in EVM     go (SDiv a (Lit 1)) = a     -- NOTE: Div x x is NOT 1, because Div 0 0 is 0, not 1.-    --++    --- Some trivial exp eliminations     go (Exp _ (Lit 0)) = Lit 1 -- everything, including 0, to the power of 0 is 1     go (Exp a (Lit 1)) = a -- everything, including 0, to the power of 1 is itself     go (Exp (Lit 1) _) = Lit 1 -- 1 to any value (including 0) is 1     -- NOTE: we can't simplify (Lit 0)^k. If k is 0 it's 1, otherwise it's 0.     --       this is encoded in SMT.hs instead, via an SMT "ite"--    -- If a >= b then the value of the `Max` expression can never be < b-    go o@(LT (Max (Lit a) _) (Lit b))-      | a >= b = Lit 0-      | otherwise = o-    go o@(SLT (Sub (Max (Lit a) _) (Lit b)) (Lit c))-      = let sa, sb, sc :: Int256-            sa = fromIntegral a-            sb = fromIntegral b-            sc = fromIntegral c-        in if sa >= sb && sa - sb >= sc-           then Lit 0-           else o--    -- normalize all comparisons in terms of (S)LT-    go (EVM.Types.GT a b) = lt b a-    go (EVM.Types.GEq a b) = leq b a-    go (EVM.Types.LEq a b) = iszero (lt b a)-    go (SGT a b) = slt b a--    -- LT-    go (EVM.Types.LT _ (Lit 0)) = Lit 0-    go (EVM.Types.LT a (Lit 1)) = iszero a-    go (EVM.Types.LT (Lit 0) a) = iszero (Eq (Lit 0) a)-    go (EVM.Types.LT a b) = lt a b--    -- SLT-    go (SLT _ (Lit a)) | a == minLitSigned = Lit 0-    go (SLT (Lit a) _) | a == maxLitSigned = Lit 0-    go (SLT a b) = slt a b+    --+    -- A special pattern sometimes generated from Solidity that uses exponentiation to simulate bit shift.+    -- We can rewrite the exponentiation into a bit-shift under certain conditions.+    go (Exp (Lit 0x100) offset@(Mul (Lit a) (Mod _ (Lit b))))+      | a * b <= 32 && (maxWord256 `Prelude.div` a) > b = shl (mul (Lit 8) offset) (Lit 1)+    go (Exp (Lit 0x100) offset@(Mod _ (Lit 32))) = (shl (mul (Lit 8) offset)) (Lit 1)+    go (Exp (Lit 2) k) = shl k (Lit 1)+    go (Exp a b) = EVM.Expr.exp a b      -- simple div/mod/add/sub     go (Div  o1 o2) = EVM.Expr.div  o1 o2@@ -1333,6 +1313,16 @@   let new = mapProp' go (simpInnerExpr prop)   in if (new == prop) then prop else simplifyProp new   where+    isBoolLike :: Expr EWord -> Bool+    isBoolLike = \case+      LT{} -> True+      SLT{} -> True+      Eq{} -> True+      IsZero{} -> True+      GT{} -> internalError "Should not encounter GT at this point!"+      LEq{} -> internalError "Should not encounter LEq at this point!"+      GEq{} -> internalError "Should not encounter GEq at this point!"+      _ -> False     go :: Prop -> Prop      -- Rewrite PGT/GEq to PLT/PLEq@@ -1355,16 +1345,29 @@     go (PLEq (Sub a b) c) | a == c = PLEq b a     go (PLEq a (Lit 0)) = peq (Lit 0) a     go (PLT (Max (Lit a) b) (Lit c)) | a < c = PLT b (Lit c)-    go (PLT (Lit 0) (Eq a b)) = peq a b-    go (PLEq a b) = pleq a b -    -- when it's PLT but comparison on the RHS then it's just (PEq 1 RHS)-    go (PLT (Lit 0) (a@LT {})) = peq (Lit 1) a-    go (PLT (Lit 0) (a@LEq {})) = peq (Lit 1) a-    go (PLT (Lit 0) (a@SLT {})) = peq (Lit 1) a-    go (PLT (Lit 0) (a@GT {})) = peq (Lit 1) a-    go (PLT (Lit 0) (a@GEq {})) = peq (Lit 1) a-    go (PLT (Lit 0) (a@SGT {})) = peq (Lit 1) a+    go (PLT (Lit 0) e)+      | isBoolLike e = peq (Lit 1) e++    -- all possible simplifications for PLT and PLEq have to be covered by this point+    go p@(PLT {}) = p+    go p@(PLEq {}) = p++    go (PEq (Lit 1) (Eq a b)) = peq a b+    go (PEq (Lit 1) (LT a b)) = PLT a b+    go (PEq (Lit 1) (IsZero e)) = PEq (Lit 0) e++    go (PEq (Lit 0) (IsZero e))+      | isBoolLike e = PEq (Lit 1) e+    go (PEq (Lit 0) (IsZero e)) = PNeg (PEq (Lit 0) e)+    go (PEq (Lit 0) (Eq a b)) = PNeg (peq a b)+    go (PEq (Lit 0) (LT a b)) = PLEq b a++    go (PEq (Lit 0) (Sub a b)) = peq a b+    go (PEq (Lit 0) (Or a b)) = peq (Lit 0) a `PAnd` peq (Lit 0) b+    go (PEq a1 (Add a2 y)) | a1 == a2 = peq (Lit 0) y+    go (PEq l r) = peq l r+     go (POr (PLEq a1 (Lit b)) (PLEq (Lit c) a2)) | a1 == a2 && c == b+1 = PBool True      -- negations@@ -1372,39 +1375,14 @@     go (PNeg (PNeg a)) = a     go (PNeg (PGT a b)) = PLEq a b     go (PNeg (PGEq a b)) = PLT a b-    go (PNeg (PLT a b)) = PGEq a b-    go (PNeg (PLEq a b)) = PGT a b+    go (PNeg (PLT a b)) = PLEq b a+    go (PNeg (PLEq a b)) = PLT b a     go (PNeg (PAnd a b)) = POr (PNeg a) (PNeg b)     go (PNeg (POr a b)) = PAnd (PNeg a) (PNeg b)-    go (PNeg (PEq (Lit 1) (IsZero b))) = PEq (Lit 0) (IsZero b)--    -- Empty buf-    go (PEq (Lit 0) (BufLength k)) = peq k (ConcreteBuf "")-    go (PEq (Lit 0) (Or a b)) = peq (Lit 0) a `PAnd` peq (Lit 0) b--    -- PEq rewrites (notice -- GT/GEq is always rewritten to LT by simplify)-    go (PEq (Lit 1) (IsZero (LT a b))) = PLT a b-    go (PEq (Lit 1) (IsZero (LEq a b))) = PLEq a b-    go (PEq (Lit 0) (IsZero a)) = PLT (Lit 0) a-    go (PEq a1 (Add a2 y)) | a1 == a2 = peq (Lit 0) y--    -- solc specific stuff-    go (PLT (Lit 0) (IsZero (Eq a b))) = PNeg (peq a b)--    -- iszero(a) -> (a == 0)-    -- iszero(iszero(a))) -> ~(a == 0) -> a > 0-    -- iszero(iszero(a)) == 0 -> ~~(a == 0) -> a == 0-    -- ~(iszero(iszero(a)) == 0) -> ~~~(a == 0) -> ~(a == 0) -> a > 0-    go (PNeg (PEq (Lit 0) (IsZero (IsZero a)))) = PLT (Lit 0) a--    -- iszero(a) -> (a == 0)-    -- iszero(a) == 0 -> ~(a == 0)-    -- ~(iszero(a) == 0) -> ~~(a == 0) -> a == 0-    go (PNeg (PEq (Lit 0) (IsZero a))) = peq (Lit 0) a--    -- a < b == 0 -> ~(a < b)-    -- ~(a < b == 0) -> ~~(a < b) -> a < b-    go (PNeg (PEq (Lit 0) (LT a b))) = PLT a b+    go (PNeg (PEq (Lit 1) e))+      | isBoolLike e = PEq (Lit 0) e+    go (PNeg (PEq (Lit 0) e))+      | isBoolLike e = PEq (Lit 1) e      -- And/Or     go (PAnd (PBool l) (PBool r)) = PBool (l && r)@@ -1423,20 +1401,7 @@     go (PImpl (PBool True) b) = b     go (PImpl (PBool False) _) = PBool True -    -- Double negation (no need for GT/GEq, as it's rewritten to LT/LEq) -    -- Eq-    go (PEq (Lit 0) (Eq a b)) = PNeg (peq a b)-    go (PEq (Lit 1) (Eq a b)) = peq a b-    go (PEq (Lit 0) (Sub a b)) = peq a b-    go (PEq (Lit 0) (LT a b)) = PLEq b a-    go (PEq (Lit 0) (LEq a b)) = PLT b a-    go (PEq (Lit 1) (LT a b)) = PLT a b-    go (PEq (Lit 1) (LEq a b)) = PLEq a b-    go (PEq (Lit 1) (GT a b)) = PGT a b-    go (PEq (Lit 1) (GEq a b)) = PGEq a b-    go (PEq l r) = peq l r-     go p = p  @@ -1672,10 +1637,6 @@ max x (Lit 0) = x max x y = normArgs Max Prelude.max x y -numBranches :: Expr End -> Int-numBranches (ITE _ t f) = numBranches t + numBranches f-numBranches _ = 1- allLit :: [Expr Byte] -> Bool allLit = all isLitByte @@ -1698,8 +1659,11 @@ -- | images of keccak(bytes32(x)) where 0 <= x < 256 preImageLookupMap :: Map.Map W256 Word8 preImageLookupMap = Map.fromList preImages+ data ConstState = ConstState   { values :: Map.Map (Expr EWord) W256+  , lowerBounds :: Map.Map (Expr EWord) W256+  , upperBounds :: Map.Map (Expr EWord) W256   , canBeSat :: Bool   }   deriving (Show)@@ -1707,7 +1671,7 @@ -- | Performs constant propagation constPropagate :: [Prop] -> [Prop] constPropagate ps =- let consts = collectConsts ps (ConstState mempty True)+ let consts = collectConsts ps emptyState  in if consts.canBeSat then substitute consts ps ++ fixVals consts     else [PBool False]   where@@ -1720,7 +1684,7 @@     --       hence we need the fixVals function to add them back in     substitute :: ConstState -> [Prop] -> [Prop]     substitute cs ps2 = map (mapProp (subsGo cs)) ps2-    subsGo :: ConstState -> Expr a-> Expr a+    subsGo :: ConstState -> Expr a -> Expr a     subsGo cs (Var v) = case Map.lookup (Var v) cs.values of       Just x -> Lit x       Nothing -> Var v@@ -1728,20 +1692,96 @@      -- Collects all the constants in the given props, and sets canBeSat to False if UNSAT     collectConsts ps2 startState = execState (mapM go ps2) startState+    emptyState = ConstState mempty mempty mempty True+    conflictState = ConstState mempty mempty mempty False+    conflict = put conflictState++    setExactValue :: Expr EWord -> W256 -> State ConstState ()+    setExactValue e v = do+      s <- get+      case Map.lookup e s.values of+        Just old -> when (old /= v) conflict+        _ -> put s { values = Map.insert e v s.values }++    updateLower :: Expr EWord -> W256 -> State ConstState ()+    updateLower a l = do+      s <- get+      let currentL = fromMaybe 0 (Map.lookup a s.lowerBounds)+          currentU = fromMaybe maxLit (Map.lookup a s.upperBounds)+          newL = Prelude.max currentL l+      if newL > currentU+        then conflict+        else put s { lowerBounds = Map.insert a newL s.lowerBounds }+      when (newL == currentU) $ setExactValue a newL++    updateUpper :: Expr EWord -> W256 -> State ConstState ()+    updateUpper a u = do+      s <- get+      let currentL = fromMaybe 0 (Map.lookup a s.lowerBounds)+          currentU = fromMaybe maxLit (Map.lookup a s.upperBounds)+          newU = Prelude.min currentU u+      if currentL > newU+        then conflict+        else put s { upperBounds = Map.insert a newU s.upperBounds }+      -- Check if equal to lower, then it's a constant+      when (currentL == newU) $ setExactValue a newU++    genericEq :: Expr EWord -> W256 -> State ConstState ()+    genericEq a v = do+      setExactValue a v+      updateLower a v+      updateUpper a v+     go :: Prop -> State ConstState ()     go = \case-        PEq (Lit l) a -> do-          s <- get-          case Map.lookup a s.values of-            Just l2 -> unless (l==l2) $ put ConstState {canBeSat=False, values=mempty}-            Nothing -> modify (\s' -> s'{values=Map.insert a l s'.values})-        PEq a b@(Lit _) -> go (PEq b a)+        -- signed inequalities+        PEq (Lit 1) term@(SLT a (Lit 0)) -> do+            genericEq term 1+            updateLower a minLitSigned+        PEq (Lit 1) term@(SLT (Lit 0) a) -> do+            genericEq term 1+            updateLower a 1+            updateUpper a maxLitSigned++        -- normal equality propagation+        PEq (Lit l) a -> genericEq a l+        PEq a (Lit l) -> genericEq a l+         PNeg (PEq (Lit l) a) -> do           s <- get           case Map.lookup a s.values of-            Just l2 -> when (l==l2) $ put ConstState {canBeSat=False, values=mempty}+            Just l2 -> when (l == l2) conflict             Nothing -> pure ()         PNeg (PEq a b@(Lit _)) -> go $ PNeg (PEq b a)++        -- inequalities (with overflow checks to prevent wraparound)+        -- PLT a (Lit b) means a < b, so a <= b-1+        PLT a (Lit b) ->+          if b == 0+            then conflict+            else updateUpper a (b - 1)+        -- PLT (Lit a) b means a < b, so b >= a+1+        PLT (Lit a) b ->+          if a == maxLit+            then conflict+            else updateLower b (a + 1)+        -- PLEq a (Lit b) means a <= b+        PLEq a (Lit b) -> updateUpper a b+        PLEq (Lit a) b -> updateLower b a+        -- PGT a (Lit b) means a > b, so a >= b+1+        PGT a (Lit b) ->+          if b == maxLit+            then conflict+            else updateLower a (b + 1)+        -- PGT (Lit a) b means a > b, so b <= a-1+        PGT (Lit a) b ->+          if a == 0+            then conflict+            else updateUpper b (a - 1)+        -- PGEq a (Lit b) means a >= b+        PGEq a (Lit b) -> updateLower a b+        PGEq (Lit a) b -> updateUpper b a+         PAnd a b -> do           go a           go b@@ -1752,7 +1792,7 @@             v2 = collectConsts [b] s           unless v1.canBeSat $ go b           unless v2.canBeSat $ go a-        PBool False -> put $ ConstState {canBeSat=False, values=mempty}+        PBool False -> conflict         _ -> pure ()  -- Concretize & simplify Keccak expressions until fixed-point.@@ -1827,4 +1867,3 @@ maybeConcStoreSimp e = case concKeccakSimpExpr e of   ConcreteStore s -> Just s   _ -> Nothing-

@@ -2,21 +2,30 @@ module EVM.Fetch   ( fetchContractWithSession   , fetchBlockWithSession-  , fetchSlotWithSession-  , fetchWithSession   , fetchQuery   , oracle   , Fetcher   , RpcInfo (..)   , RpcQuery (..)   , EVM.Fetch.zero-  , readMockData+  , noRpc+  , noRpcFetcher   , BlockNumber (..)-  , mkRpcInfo   , mkSession+  , mkSessionWithoutCache   , Session (..)   , FetchCache (..)   , addFetchCache+  , saveCache+  , RPCContract (..)+  , makeContractFromRPC+  -- Below 4 are needed for Echidna+  , fetchSlotWithSession+  , fetchSlotWithCache+  , fetchWithSession+  , getCacheState+  , FetchStatus(..)+  , FetchResult(..)   ) where  import Prelude hiding (Foldable(..))@@ -27,22 +36,29 @@ import EVM.Format (hexText) import EVM.SMT import EVM.Solvers-import EVM.Types+import EVM.Types hiding (ByteStringS)+import EVM.Types (ByteStringS(..)) import EVM (emptyContract)  import Optics.Core+import GHC.Generics (Generic)+import System.FilePath ((</>))+import System.Directory (createDirectoryIfMissing, doesFileExist)+import Data.Aeson.Encode.Pretty (encodePretty)+import qualified Data.ByteString.Lazy as BSL+import Data.Bifunctor (first)+import Control.Exception (try, SomeException) -import Control.Monad.Trans.Maybe-import Control.Applicative (Alternative(..)) import Data.Aeson hiding (Error) import Data.Aeson.Optics import Data.ByteString qualified as BS import Data.Text (Text, unpack, pack) import Data.Text qualified as T-import Data.Text.Encoding qualified as T import Data.Foldable (Foldable(..)) import Data.Map.Strict qualified as Map-import Data.Maybe (fromMaybe, isJust, fromJust)+import Data.Maybe (fromMaybe, fromJust, isNothing)+import Data.Set qualified as Set+import Data.Set (Set) import Data.Vector qualified as RegularVector import Network.Wreq import Network.Wreq.Session qualified as NetSession@@ -53,31 +69,66 @@ import Control.Monad (when) import EVM.Effects import qualified EVM.Expr as Expr-import Data.Aeson.Encode.Pretty (encodePretty)-import Data.ByteString.Base16 qualified as BS16-import qualified Data.ByteString.Lazy as BSL-import Data.ByteString.Char8 qualified as Char8 import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_) -type Fetcher t m s = App m => Query t s -> m (EVM t s ())+type Fetcher t m = App m => Query t -> m (EVM t ()) +data FetchStatus = Cached | Fresh+  deriving (Show, Eq)++data FetchResult a+  = FetchSuccess a FetchStatus+  | FetchFailure FetchStatus+  | FetchError Text+  deriving (Show, Eq)+ data Session = Session-  { sess           :: NetSession.Session-  , latestBlockNum :: MVar (Maybe W256)-  , sharedCache    :: MVar FetchCache+  { sess            :: NetSession.Session+  , latestBlockNum  :: MVar (Maybe W256)+  , sharedCache     :: MVar FetchCache+  , cacheDir        :: Maybe FilePath+  -- Track ephemeral failures (network errors, not found, etc.)+  -- These are NOT persisted to disk+  , failedContracts :: MVar (Set Addr)+  , failedSlots     :: MVar (Set (Addr, W256))   }  data FetchCache = FetchCache-  { contractCache :: Map.Map Addr Contract+  { contractCache :: Map.Map Addr RPCContract   , slotCache     :: Map.Map (Addr, W256) W256   , blockCache    :: Map.Map W256 Block-  }+  } deriving (Generic)+++instance ToJSON FetchCache where+  toJSON (FetchCache cs ss bs) = object+    [ "contracts" .= Map.toList cs+    , "slots"     .= map (first (T.pack . show)) (Map.toList ss)+    , "blocks"    .= bs+    ]++instance FromJSON FetchCache where+  parseJSON = withObject "FetchCache" $ \v -> FetchCache+    <$> (Map.fromList <$> v .: "contracts")+    <*> (Map.fromList . map (first (read . T.unpack)) <$> v .: "slots")+    <*> (v .:? "blocks" .!= Map.empty)+ instance Show FetchCache where   show (FetchCache c s b) =     "FetchCache { contractCache: " ++ show (Map.keys c) ++     ", slotCache: " ++ show (Map.keys s) ++     ", blockCache: " ++ show (Map.keys b) ++ " }" +data Signedness = Signed | Unsigned+  deriving (Show)++showDec :: Signedness -> W256 -> T.Text+showDec signed (W256 w) = T.pack (show (i :: Integer))+  where+    i = case signed of+          Signed   -> fromIntegral (fromIntegral w :: Int)+          Unsigned -> fromIntegral w+ -- | Abstract representation of an RPC fetch request data RpcQuery a where   QueryCode    :: Addr         -> RpcQuery BS.ByteString@@ -93,27 +144,21 @@ deriving instance Show (RpcQuery a)  data RPCContract = RPCContract-  { mcCode    :: BS.ByteString-  , mcNonce   :: W64-  , mcBalance :: W256+  { code    :: ByteStringS+  , nonce   :: W64+  , balance :: W256   }-  deriving (Eq, Show)+  deriving (Eq, Show, Generic) -data RpcInfo = RpcInfo-  { blockNumURL  :: Maybe (BlockNumber, Text) -- ^ (block number, RPC url)-  , mockContract :: Maybe (Map.Map Addr RPCContract) -- ^ mock contracts (addr -> contract)-  , mockSlot     :: Maybe (Map.Map (Addr, W256) W256) -- ^ mock storage slots (addr, slot) -> value-  , mockBlock    :: Maybe (Map.Map W256 Block) -- ^ mock blocks (block number -> block)-  }+instance ToJSON RPCContract++instance FromJSON RPCContract++newtype RpcInfo = RpcInfo { blockNumURL  :: Maybe (BlockNumber, Text)} -- ^ (block number, RPC url)   deriving (Show)-instance Semigroup RpcInfo where-  RpcInfo a1 a2 a3 a4 <> RpcInfo b1 b2 b3 b4 =-    RpcInfo (a1 <|> b1) (a2 <|> b2) (a3 <|> b3) (a4 <|> b4)-instance Monoid RpcInfo where-  mempty = RpcInfo Nothing Nothing Nothing Nothing -mkRpcInfo :: Maybe (BlockNumber, Text) -> MockData -> RpcInfo-mkRpcInfo blockNumURL (MockData {..}) = RpcInfo blockNumURL mockContract mockSlot mockBlock+noRpc :: RpcInfo+noRpc = RpcInfo Nothing  rpc :: String -> [Value] -> Value rpc method args = object@@ -142,7 +187,7 @@ readText :: Read a => Text -> a readText = read . unpack -addFetchCache :: Session -> Addr -> Contract -> IO ()+addFetchCache :: Session -> Addr -> RPCContract -> IO () addFetchCache sess address ctrct = do   cache <- readMVar sess.sharedCache   liftIO $ modifyMVar_ sess.sharedCache $ \c -> pure $ c { contractCache = (Map.insert address ctrct cache.contractCache) }@@ -150,40 +195,34 @@ fetchQuery   :: Show a   => BlockNumber-  -> (Value -> IO (Maybe Value))+  -> (Value -> IO (Either Text Value))   -> RpcQuery a-  -> IO (Maybe a)+  -> IO (Either Text a) fetchQuery n f q =   case q of     QueryCode addr -> do         m <- f (rpc "eth_getCode" [toRPC addr, toRPC n])-        pure $ do-          t <- preview _String <$> m-          hexText <$> t+        pure $ m >>= \v -> maybeToRight "Parse error" (hexText <$> preview _String v)     QueryNonce addr -> do         m <- f (rpc "eth_getTransactionCount" [toRPC addr, toRPC n])-        pure $ do-          t <- preview _String <$> m-          readText <$> t+        pure $ m >>= \v -> maybeToRight "Parse error" (readText <$> preview _String v)     QueryBlock -> do       m <- f (rpc "eth_getBlockByNumber" [toRPC n, toRPC False])-      pure $ m >>= parseBlock+      pure $ m >>= \v -> maybeToRight "Parse error" (parseBlock v)     QueryBalance addr -> do         m <- f (rpc "eth_getBalance" [toRPC addr, toRPC n])-        pure $ do-          t <- preview _String <$> m-          readText <$> t+        pure $ m >>= \v -> maybeToRight "Parse error" (readText <$> preview _String v)     QuerySlot addr slot -> do         m <- f (rpc "eth_getStorageAt" [toRPC addr, toRPC slot, toRPC n])-        pure $ do-          t <- preview _String <$> m-          readText <$> t+        pure $ m >>= \v -> maybeToRight "Parse error" (readText <$> preview _String v)     QueryChainId -> do         m <- f (rpc "eth_chainId" [toRPC n])-        pure $ do-          t <- preview _String <$> m-          readText <$> t+        pure $ m >>= \v -> maybeToRight "Parse error" (readText <$> preview _String v) +maybeToRight :: b -> Maybe a -> Either b a+maybeToRight _ (Just x) = Right x+maybeToRight y Nothing  = Left y+ parseBlock :: (AsValue s, Show s) => s -> Maybe Block parseBlock j = do   coinbase   <- LitAddr . readText <$> j ^? key "miner" % _String@@ -237,80 +276,56 @@       <*> v .: "maxCodeSize"       <*> pure feeSchedule -data MockData = MockData-  { mockContract :: Maybe (Map.Map Addr RPCContract) -- ^ mock contracts (addr -> contract)-  , mockSlot     :: Maybe (Map.Map (Addr, W256) W256) -- ^ mock storage slots (addr, slot) -> value-  , mockBlock    :: Maybe (Map.Map W256 Block) -- ^ mock blocks (block number -> block)-  }-instance Semigroup MockData where-  MockData a1 a2 a3 <> MockData b1 b2 b3 =-    MockData (a1 <|> b1) (a2 <|> b2) (a3 <|> b3)-instance Monoid MockData where-  mempty = MockData Nothing Nothing Nothing-instance ToJSON RPCContract where-  toJSON (RPCContract code nonce balance) = object-    [ "mcCode" .= (T.pack $ "0x" ++ (concatMap (paddedShowHex 2) . BS.unpack $ code))-    , "mcNonce" .= nonce-    , "mcBalance" .= balance-    ]--instance FromJSON RPCContract where-  parseJSON = withObject "RPCContract" $ \v -> do-    codeHex <- v .: "mcCode"-    case (BS16.decodeBase16Untyped . strip0x . T.encodeUtf8) codeHex of-       Left _ -> fail "Invalid hex encoding for mcCode"-       Right bs -> RPCContract bs <$> v .: "mcNonce" <*> v .: "mcBalance"-    where-      strip0x :: BS.ByteString -> BS.ByteString-      strip0x bs = if "0x" `Char8.isPrefixOf` bs then Char8.drop 2 bs else bs--instance ToJSON MockData where-  toJSON (MockData contracts slots blocks) = object-    [ "mockContract" .= contracts-    , "mockSlot" .= slots-    , "mockBlock" .= blocks-    ]--instance FromJSON MockData where-  parseJSON = withObject "MockData" $ \v ->-    MockData <$> v .:? "mockContract" <*> v .:? "mockSlot" <*> v .:? "mockBlock"--readMockData :: FilePath -> IO (Either String MockData)-readMockData filePath = do-  jsonData <- BSL.readFile filePath-  pure $ eitherDecode jsonData--writeMockDataToFile :: FilePath -> MockData -> IO ()-writeMockDataToFile filePath mockData = do-  let jsonData = encodePretty mockData-  BSL.writeFile filePath jsonData-  putStrLn $ "Successfully wrote JSON to: " ++ filePath--fetchWithSession :: Text -> NetSession.Session -> Value -> IO (Maybe Value)+fetchWithSession :: Text -> NetSession.Session -> Value -> IO (Either Text Value) fetchWithSession url sess x = do   r <- asValue =<< NetSession.post sess (unpack url) x-  pure (r ^? (lensVL responseBody) % key "result")+  let body = r ^. (lensVL responseBody)+  case body ^? key "result" of+    Just val -> pure $ Right val+    Nothing -> case body ^? key "error" of+      Just err -> pure $ Left $ pack $ show err+      Nothing -> pure $ Left "Unknown RPC error" -fetchContractWithSession :: Config -> Session -> BlockNumber -> Text -> Addr -> IO (Maybe Contract)+fetchContractWithSession :: Config -> Session -> BlockNumber -> Text -> Addr -> IO (FetchResult RPCContract) fetchContractWithSession conf sess nPre url addr = do   n <- getLatestBlockNum conf sess nPre url+  -- Check successful cache first   cache <- readMVar sess.sharedCache   case Map.lookup addr cache.contractCache of     Just c -> do       when (conf.debug) $ putStrLn $ "-> Using cached contract at " ++ show addr-      pure $ Just c-    Nothing -> runMaybeT $ do-      let fetch :: Show a => RpcQuery a -> IO (Maybe a)-          fetch = fetchQuery n (fetchWithSession url sess.sess)-          fname  = "fetched_contract_" ++ show addr ++ ".json"-      code    <- MaybeT $ fetch (QueryCode addr)-      nonce   <- MaybeT $ fetch (QueryNonce addr)-      balance <- MaybeT $ fetch (QueryBalance addr)-      when (conf.debug) $ liftIO $ writeMockDataToFile fname (MockData (Just (Map.singleton addr (RPCContract code nonce balance))) Nothing Nothing)-      let contr = makeContractFromRPC (RPCContract code nonce balance)-      liftIO $ modifyMVar_ sess.sharedCache $ \c -> pure $ c { contractCache = (Map.insert addr contr cache.contractCache) }-      pure contr+      pure (FetchSuccess c Cached)+    Nothing -> do+      -- Check failure cache+      failures <- readMVar sess.failedContracts+      if Set.member addr failures+      then do+        when (conf.debug) $ putStrLn $ "-> Skipping previously failed contract " ++ show addr+        pure (FetchFailure Cached)+      else do+        -- Attempt fetch+        when (conf.debug) $ putStrLn $ "-> Fetching contract at " ++ show addr+        let fetch :: Show a => RpcQuery a -> IO (Either Text a)+            fetch = fetchQuery n (fetchWithSession url sess.sess) +        codeRes <- fetch (QueryCode addr)+        nonceRes <- fetch (QueryNonce addr)+        balRes <- fetch (QueryBalance addr)++        case (codeRes, nonceRes, balRes) of+          (Right c, Right no, Right ba) -> do+            let contr = RPCContract (ByteStringS c) no ba+            if c /= BS.empty +              then do+                modifyMVar_ sess.sharedCache $ \x -> pure $ x { contractCache = Map.insert addr contr x.contractCache }+                pure (FetchSuccess contr Fresh)+              else do+                modifyMVar_ sess.failedContracts $ \f -> pure $ Set.insert addr f+                pure (FetchFailure Fresh)+          (Left e, _, _) -> pure (FetchError e)+          (_, Left e, _) -> pure (FetchError e)+          (_, _, Left e) -> pure (FetchError e)+ -- In case the user asks for Latest, and we have not yet established what Latest is, -- we fetch the block to find out. Otherwise, we update Latest to the value we have stored getLatestBlockNum :: Config -> Session -> BlockNumber -> Text -> IO BlockNumber@@ -332,73 +347,165 @@    _ -> pure n  makeContractFromRPC :: RPCContract -> Contract-makeContractFromRPC (RPCContract code nonce balance) =+makeContractFromRPC (RPCContract (ByteStringS code) nonce balance) =     initialContract (RuntimeCode (ConcreteRuntimeCode code))       & set #nonce    (Just nonce)       & set #balance  (Lit balance)       & set #external True -fetchSlotWithSession :: NetSession.Session -> BlockNumber -> Text -> Addr -> W256 -> IO (Maybe W256)+-- Needed for Echidna only+fetchSlotWithCache :: Config -> Session -> BlockNumber -> Text -> Addr -> W256 -> IO (FetchResult W256)+fetchSlotWithCache conf sess nPre url addr slot = do+  n <- getLatestBlockNum conf sess nPre url+  -- Check successful cache+  cache <- readMVar sess.sharedCache+  case Map.lookup (addr, slot) cache.slotCache of+    Just s -> do+      when (conf.debug) $ putStrLn $ "-> Using cached slot value for slot " <> show slot <> " at " <> show addr+      pure (FetchSuccess s Cached)+    Nothing -> do+      -- Check failure cache+      failures <- readMVar sess.failedSlots+      if Set.member (addr, slot) failures+      then do+        when (conf.debug) $ putStrLn $ "-> Skipping previously failed slot " <> show slot <> " at " <> show addr+        pure (FetchFailure Cached)+      else do+        -- Attempt fetch+        when (conf.debug) $ putStrLn $ "-> Fetching slot " <> show slot <> " at " <> show addr+        ret <- fetchSlotWithSession sess.sess n url addr slot+        case ret of+          Right val -> do+            -- Success: cache it+            modifyMVar_ sess.sharedCache $ \c ->+              pure $ c { slotCache = Map.insert (addr, slot) val c.slotCache }+            pure (FetchSuccess val Fresh)+          Left err -> do+            pure (FetchError err)++-- | Get the complete cache state including both successes and failures+-- Returns in the format expected by Echidna's UI:+--   - Map Addr (Maybe Contract): Just = success, Nothing = failure+--   - Map Addr (Map W256 (Maybe W256)): Just = success, Nothing = failure+getCacheState+  :: Session+  -> IO (Map.Map Addr (Maybe Contract), Map.Map Addr (Map.Map W256 (Maybe W256)))+getCacheState sess = do+  cache <- readMVar sess.sharedCache+  failedContracts <- readMVar sess.failedContracts+  failedSlots <- readMVar sess.failedSlots++  -- Convert contract cache+  let successfulContracts = fmap (Just . makeContractFromRPC) cache.contractCache+  let allContracts = successfulContracts+                  <> Map.fromSet (const Nothing) failedContracts++  -- Convert slot cache: group by address+  let successfulSlotsByAddr = Map.foldrWithKey+        (\(addr, slot) value acc ->+          Map.insertWith Map.union addr (Map.singleton slot (Just value)) acc)+        Map.empty+        cache.slotCache++  -- Add failed slots+  let allSlots = Set.foldr+        (\(addr, slot) acc ->+          Map.insertWith Map.union addr (Map.singleton slot Nothing) acc)+        successfulSlotsByAddr+        failedSlots++  pure (allContracts, allSlots)++fetchSlotWithSession :: NetSession.Session -> BlockNumber -> Text -> Addr -> W256 -> IO (Either Text W256) fetchSlotWithSession sess n url addr slot =   fetchQuery n (fetchWithSession url sess) (QuerySlot addr slot)  fetchBlockWithSession :: Config -> Session  -> BlockNumber -> Text -> IO (Maybe Block) fetchBlockWithSession conf sess nPre url = do   n <- getLatestBlockNum conf sess nPre url-  internalBlockFetch conf sess n url+  case n of+    Latest -> internalBlockFetch conf sess n url+    EVM.Fetch.BlockNumber blockNum -> do+      cache <- readMVar sess.sharedCache+      case Map.lookup blockNum cache.blockCache of+        Just b -> do+          when (conf.debug) $ putStrLn $ "-> Using cached block " ++ show n+          pure (Just b)+        Nothing -> internalBlockFetch conf sess n url  internalBlockFetch :: Config -> Session -> BlockNumber -> Text -> IO (Maybe Block) internalBlockFetch conf sess n url = do   when (conf.debug) $ putStrLn $ "Fetching block " ++ show n ++ " from " ++ unpack url   ret <- fetchQuery n (fetchWithSession url sess.sess) QueryBlock   case ret of-    Nothing -> pure ret-    Just b -> do+    Left _ -> pure Nothing+    Right b -> do       let bn = forceLit b.number-      cache <- readMVar sess.sharedCache-      liftIO $ modifyMVar_ sess.sharedCache $ \c -> pure $ c { blockCache = (Map.insert bn b cache.blockCache) }-      when (conf.debug) $ do-        let fname = "fetched_block_" ++ show bn ++ ".json"-        writeMockDataToFile fname (MockData Nothing Nothing (Just (Map.singleton bn b)))-      pure ret+      liftIO $ modifyMVar_ sess.sharedCache $ \c ->+        pure $ c { blockCache = Map.insert bn b c.blockCache }+      pure (Just b) -fetchSlotFrom :: App m => Session -> BlockNumber -> Text -> Addr -> W256 -> m (Maybe W256)-fetchSlotFrom sess nPre url addr slot = do-  conf <- readConfig-  n <- liftIO $ getLatestBlockNum conf sess nPre url-  cache <- liftIO $ readMVar sess.sharedCache-  case Map.lookup (addr, slot) cache.slotCache of-    Just s -> do-      when (conf.debug) $ liftIO $ putStrLn $ "-> Using cached slot value for slot " <> show slot <> " at " <> show addr-      pure $ Just s-    Nothing -> do-      ret <- liftIO $ fetchSlotWithSession sess.sess n url addr slot-      when (isJust ret) $ let val = fromJust ret in-        liftIO $ modifyMVar_ sess.sharedCache $ \c -> pure $ c { slotCache = (Map.insert (addr,slot) val cache.slotCache) }-      when (conf.debug) $ liftIO $ do-        let fname = "fetched_slot_" ++ show addr ++ "_" ++ show slot ++ ".json"-        case ret of-          Just v -> writeMockDataToFile fname (MockData Nothing (Just (Map.singleton (addr, slot) v)) Nothing)-          Nothing -> pure ()-      pure ret+cacheFileName :: W256 -> FilePath+cacheFileName n = "rpc-cache-" ++ T.unpack (showDec Unsigned n) ++ ".json" -mkSession :: App m => m Session-mkSession = do+emptyCache :: FetchCache+emptyCache = FetchCache Map.empty Map.empty Map.empty++loadCache :: FilePath -> W256 -> IO FetchCache+loadCache dir n = do+  let fp = dir </> cacheFileName n+  exists <- doesFileExist fp+  if exists+    then do+      res <- try (BSL.readFile fp) :: IO (Either SomeException BSL.ByteString)+      case res of+        Left e -> do+          putStrLn $ "Warning: could not read cache file " ++ fp ++ ": " ++ show e+          pure emptyCache+        Right content ->+          case eitherDecode content of+            Left err -> do+              putStrLn $ "Warning: could not parse cache file " ++ fp ++ ": " ++ err+              pure emptyCache+            Right cache -> pure cache+    else+      pure emptyCache++saveCache :: FilePath -> W256 -> FetchCache -> IO ()+saveCache dir n cache = do+  createDirectoryIfMissing True dir+  let fp = dir </> cacheFileName n+  putStrLn $ "Saving RPC cache to " ++ fp+  BSL.writeFile fp (encodePretty cache)++mkSession :: App m => Maybe FilePath -> Maybe W256 -> m Session+mkSession cacheDir mblock = do   sess <- liftIO NetSession.newAPISession-  let emptyCache = FetchCache Map.empty Map.empty Map.empty-  cache <- liftIO $ newMVar emptyCache+  initialCache <- case (cacheDir, mblock) of+      (Just dir, Just block) -> liftIO $ loadCache dir block+      _ -> pure emptyCache+  cache <- liftIO $ newMVar initialCache   latestBlockNum <- liftIO $ newMVar Nothing-  pure $ Session sess latestBlockNum cache+  -- Initialize ephemeral failure tracking+  failedContracts <- liftIO $ newMVar Set.empty+  failedSlots <- liftIO $ newMVar Set.empty+  pure $ Session sess latestBlockNum cache cacheDir failedContracts failedSlots +mkSessionWithoutCache :: App m => m Session+mkSessionWithoutCache = mkSession Nothing Nothing+ -- Only used for testing (test.hs, BlockchainTests.hs)-zero :: Natural -> Maybe Natural -> Fetcher t m s+zero :: Natural -> Maybe Natural -> Fetcher t m zero smtjobs smttimeout q = do-  sess <- mkSession+  sess <- mkSessionWithoutCache   withSolvers Z3 smtjobs 1 smttimeout $ \s ->-    oracle s (Just sess) mempty q+    oracle s (Just sess) noRpc q +noRpcFetcher :: forall t m . App m => SolverGroup -> Fetcher t m+noRpcFetcher sg = oracle sg Nothing noRpc+ -- SMT solving + RPC data fetching + reading from environment-oracle :: forall t m s . App m => SolverGroup -> Maybe Session -> RpcInfo -> Fetcher t m s+oracle :: forall t m . App m => SolverGroup -> Maybe Session -> RpcInfo -> Fetcher t m oracle solvers preSess rpcInfo q = do   case q of     PleaseDoFFI vals envs continue -> case vals of@@ -414,59 +521,70 @@     PleaseAskSMT branchcondition pathconditions continue -> do          let pathconds = foldl' PAnd (PBool True) pathconditions          -- Is is possible to satisfy the condition?-         continue <$> checkBranch solvers (branchcondition ./= (Lit 0)) pathconds+         case branchcondition of+           Lit 0 -> pure $ continue (Case False)+           Lit _ -> pure $ continue (Case True)+           _     -> continue <$> checkBranch solvers (branchcondition ./= (Lit 0)) pathconds      PleaseGetSols symExpr numBytes pathconditions continue -> do          let pathconds = foldl' PAnd (PBool True) pathconditions          continue <$> getSolutions solvers symExpr numBytes pathconds -    PleaseFetchContract addr base continue -> withSession addr (continue (nothingContract base addr)) $ \sess -> do-      conf <- readConfig-      when (conf.debug) $ liftIO $ putStrLn $ "Fetching contract at " ++ show addr-      when (addr == 0 && conf.verb > 0) $ liftIO $ putStrLn "Warning: fetching contract at address 0"-      contract <- case rpcInfo.mockContract >>= Map.lookup addr of-        Just c  -> do-          when (conf.debug) $ liftIO $ putStrLn $ "Using mocked contract at " ++ show addr-          pure $ Just (makeContractFromRPC c)-        Nothing -> case rpcInfo.blockNumURL of-            Nothing -> pure $ Just $ nothingContract base addr-            Just (block, url) -> liftIO $ fetchContractWithSession conf sess block url addr-      case contract of-        Just x -> pure $ continue x-        Nothing -> internalError $ "oracle error: " ++ show q+    PleaseFetchContract addr base continue+      | isAddressSpecial addr -> pure $ continue nothingContract+      | isNothing rpcInfo.blockNumURL -> pure $ continue nothingContract+      | otherwise -> do+        let sess = fromMaybe (internalError $ "oracle: no session provided for fetch addr: " ++ show addr) preSess+        conf <- readConfig+        cache <- liftIO $ readMVar sess.sharedCache+        case Map.lookup addr cache.contractCache of+          Just c -> do+            when (conf.debug) $ liftIO $ putStrLn $ "-> Using cached contract at " ++ show addr+            pure $ continue $ makeContractFromRPC c+          Nothing -> do+            when (conf.debug) $ liftIO $ putStrLn $ "Fetching contract at " ++ show addr+            let (block, url) = fromJust rpcInfo.blockNumURL+            res <- liftIO $ fetchContractWithSession conf sess block url addr+            case res of+              FetchSuccess x _ -> pure $ continue (makeContractFromRPC x)+              FetchFailure _ -> internalError $ "oracle error: " ++ show q+              FetchError e -> internalError $ "oracle error: " ++ show e+      where+        nothingContract = case base of+          AbstractBase -> unknownContract (LitAddr addr)+          EmptyBase -> emptyContract -    PleaseFetchSlot addr slot continue -> withSession addr (continue 0)$ \sess -> do-      conf <- readConfig-      when (conf.debug) $ liftIO $ putStrLn $ "Fetching slot " <> (show slot) <> " at " <> (show addr)-      when (addr == 0 && conf.verb > 0) $ liftIO $ putStrLn "Warning: fetching slot from a contract at address 0"-      case rpcInfo.mockSlot >>= Map.lookup (addr, slot) of-        Just v  -> do-          when (conf.debug) $ liftIO $ putStrLn $ "Using mocked slot value for slot " <> show slot <> " at " <> show addr-          pure $ continue v-        Nothing -> case rpcInfo.blockNumURL of-            Nothing -> pure $ continue 0-            Just (block, url) -> fetchSlotFrom sess block url addr slot >>= \case-               Just x  -> pure $ continue x-               Nothing -> internalError $ "oracle error: " ++ show q+    PleaseFetchSlot addr slot continue+      | isAddressSpecial addr -> pure $ continue 0+      | isNothing rpcInfo.blockNumURL -> pure $ continue 0+      | otherwise -> do+        let sess = fromMaybe (internalError $ "oracle: no session provided for fetch addr: " ++ show addr) preSess+        conf <- readConfig+        cache <- liftIO $ readMVar sess.sharedCache+        case Map.lookup (addr, slot) cache.slotCache of+          Just s -> do+            when (conf.debug) $ liftIO $ putStrLn $ "-> Using cached slot value for slot " <> show slot <> " at " <> show addr+            pure $ continue s+          Nothing -> do+            when (conf.debug) $ liftIO $ putStrLn $ "Fetching slot " <> (show slot) <> " at " <> (show addr)+            let (block, url) = fromJust rpcInfo.blockNumURL+            n <- liftIO $ getLatestBlockNum conf sess block url+            ret <- liftIO $ fetchSlotWithSession sess.sess n url addr slot+            case ret of+              Right val -> do+                liftIO $ modifyMVar_ sess.sharedCache $ \c ->+                  pure $ c { slotCache = Map.insert (addr, slot) val c.slotCache }+                pure $ continue val+              Left err -> internalError $ "oracle error: " ++ show err      PleaseReadEnv variable continue -> do       value <- liftIO $ lookupEnv variable       pure . continue $ fromMaybe "" value      where-      nothingContract base addr =-        case base of-          AbstractBase -> unknownContract (LitAddr addr)-          EmptyBase -> emptyContract-      withSession addr def f =-        case addr of-          -- special values such as 0, 0xdeadbeef, 0xacab, hevm cheatcodes, and the precompile addresses-          -- do not require a session, there is nothing deployed there, it's way too small or special, RPC would be pointless-          a | a <= 0xdeadbeef -> pure def-          0x7109709ECfa91a80626fF3989D68f67F5b1DD12D -> pure def-          _ -> case preSess of-            Just sess  -> f sess-            Nothing -> internalError $ "oracle: no session provided for fetch addr: " ++ show addr+      -- special values such as 0, 0xdeadbeef, 0xacab, hevm cheatcodes, and the precompile addresses+      isAddressSpecial addr = addr <= 0xdeadbeef || addr == 0x7109709ECfa91a80626fF3989D68f67F5b1DD12D+  getSolutions :: forall m . App m => SolverGroup -> Expr EWord -> Int -> Prop -> m (Maybe [W256]) getSolutions solvers symExprPreSimp numBytes pathconditions = do

@@ -16,6 +16,7 @@   , showTraceTree'   , showValues   , prettyvmresult+  , prettyvmresults   , showCall   , showWordExact   , showWordExplanation@@ -191,7 +192,7 @@     format (AbstractBuf t) = "<" <> t <> " abstract buf>"     format e2 = T.pack $ "Symbolic expression: " <> show e2 -showTraceTree :: DappInfo -> VM t s -> Text+showTraceTree :: DappInfo -> VM t -> Text showTraceTree dapp vm =   let ?context = DappContext { info = dapp                              , contracts = vm.env.contracts@@ -201,7 +202,6 @@   in pack $ concatMap showTree traces  showTraceTree' :: DappInfo -> Expr End -> Text-showTraceTree' _ (ITE {}) = internalError "ITE does not contain a trace" showTraceTree' dapp leaf =   let ?context = DappContext { info = dapp, contracts, labels }   in let forest = traceForest' leaf@@ -453,6 +453,10 @@ prettyvmresult (Partial _ _ p) = T.unpack $ formatPartial p prettyvmresult r = internalError $ "Invalid result: " <> show r +prettyvmresults :: [Expr End] -> String+prettyvmresults results =+  T.unpack $ indent 2 $ T.unlines $ zipWith (\i r -> T.pack ("Result " <> show (i :: Integer) <> ": " <> prettyvmresult r)) [0..] results+ indent :: Int -> Text -> Text indent n = rstrip . T.unlines . fmap (T.replicate n (T.pack [' ']) <>) . T.lines @@ -520,7 +524,7 @@     ]  -formatPartialDetailed :: Maybe (WarningData s t) -> PartialExec -> Text+formatPartialDetailed :: Maybe (WarningData t) -> PartialExec -> Text formatPartialDetailed warnData p =   let toTxt addr pc = pack $ getSrcInfo warnData addr pc   in case p of@@ -531,7 +535,7 @@     PrecompileMissing {..}     -> "Precompile at address " <> pack (show preAddr) <> " does not exist, called from" <> toTxt addr pc     BranchTooDeep {..}         -> "Branches too deep" <> toTxt addr pc -getSrcInfo :: Maybe (WarningData s t) -> Expr EAddr -> Int -> String+getSrcInfo :: Maybe (WarningData t) -> Expr EAddr -> Int -> String getSrcInfo Nothing addr pc = " at addr: " <> show addr <> " at pc: " <> show pc getSrcInfo (Just dat) addr pc = fromMaybe (getSrcInfo Nothing addr pc) $ do   contr <- Map.lookup addr dat.vm.env.contracts@@ -565,14 +569,6 @@       (GVar v) -> "(GVar " <> T.pack (show v) <> ")"       LitByte w -> T.pack $ show w -      ITE c t f -> T.unlines-        [ "(ITE"-        , indent 2 $ T.unlines-          [ formatExpr c-          , formatExpr t-          , formatExpr f-          ]-        , ")"]       Success asserts _ buf store -> T.unlines         [ "(Success"         , indent 2 $ T.unlines

@@ -432,12 +432,16 @@   Sub a b -> op2 "bvsub" a b   Mul a b -> op2 "bvmul" a b   Exp a b -> case a of-    -- Lit 1 has already been handled via Expr.simplify     Lit 0 -> do       benc <- exprToSMT b       pure $ "(ite (= " <> benc `sp` zero <> " ) " <> one `sp` zero <> ")"+    Lit 1 -> pure one+    Lit 2 -> do+        benc <- exprToSMT b+        pure $ "(bvshl " <> one `sp` benc <> ")"     _ -> case b of-      Lit b' -> expandExp a b'+      -- b is limited below, otherwise SMT query will be huge, and eventually Haskell stack overflows+      Lit b' | b' < 1000 -> expandExp a b'       _ -> Left $ "Cannot encode symbolic exponent into SMT. Offending symbolic value: " <> show b   Min a b -> do     aenc <- exprToSMT a

@@ -232,10 +232,10 @@   modifierDepth :: {-# UNPACK #-} !Int } deriving (Show, Eq, Ord, Generic) -data WarningData s t = WarningData+data WarningData t = WarningData   {solcContr :: SolcContract,    sourceCache :: SourceCache,-   vm :: VM s t+   vm :: VM t   }  data SrcMapParseState

@@ -23,7 +23,7 @@  import Control.Monad.IO.Class import Control.Monad.Operational (Program, ProgramViewT(..), ProgramView, singleton, view)-import Control.Monad.ST (stToIO, RealWorld)+import Control.Monad.ST (stToIO) import Control.Monad.State.Strict (execStateT, get, StateT(..)) import Data.Text (Text) @@ -34,43 +34,39 @@ import EVM.Types  -- | The instruction type of the operational monad-data Action t s a where+data Action t a where   -- | Keep executing until an intermediate result is reached-  Exec :: Action t s (VMResult t s)+  Exec :: Action t (VMResult t)   -- | Embed a VM state transformation-  EVM  :: EVM t s a -> Action t s a+  EVM  :: EVM t a -> Action t a   -- | Wait for a query to be resolved-  Wait :: Query t s -> Action t s ()-  -- | Two things can happen-  Fork :: RunBoth s -> Action Symbolic s ()-  -- | Many (>2) things can happen-  ForkMany :: RunAll s -> Action Symbolic s ()+  Wait :: Query t -> Action t ()+  -- | More than one thing can happen+  Fork :: BranchContext -> Action Symbolic () + -- | Type alias for an operational monad of @Action@-type Stepper t s a = Program (Action t s) a+type Stepper t a = Program (Action t) a  -- Singleton actions -exec :: Stepper t s (VMResult t s)+exec :: Stepper t (VMResult t) exec = singleton Exec -run :: Stepper t s (VM t s)+run :: Stepper t (VM t) run = exec >> evm get -wait :: Query t s -> Stepper t s ()+wait :: Query t -> Stepper t () wait = singleton . Wait -fork :: RunBoth s -> Stepper Symbolic s ()+fork :: BranchContext -> Stepper Symbolic () fork = singleton . Fork -forkMany :: RunAll s -> Stepper Symbolic s ()-forkMany = singleton . ForkMany--evm :: EVM t s a -> Stepper t s a+evm :: EVM t a -> Stepper t a evm = singleton . EVM  -- | Run the VM until final result, resolving all queries-execFully :: Stepper Concrete s (Either EvmError (Expr Buf))+execFully :: Stepper Concrete (Either EvmError (Expr Buf)) execFully =   exec >>= \case     HandleEffect (Query q) ->@@ -81,32 +77,31 @@       pure (Right x)  -- | Run the VM until its final state-runFully :: Stepper t s (VM t s)+runFully :: Stepper t (VM t) runFully = do   vm <- run   case vm.result of     Nothing -> internalError "should not occur"     Just (HandleEffect (Query q)) ->       wait q >> runFully-    Just (HandleEffect (RunBoth q)) ->-      fork q >> runFully-    Just (HandleEffect (RunAll q)) ->-      forkMany q >> runFully+    Just (HandleEffect (Branch context)) ->+      fork context >> runFully     Just _ ->       pure vm -enter :: Text -> Stepper t s ()+enter :: Text -> Stepper t () enter t = evm (EVM.pushTrace (EntryTrace t)) +-- Concrete interpretation interpret   :: forall m a . (App m)-  => Fetch.Fetcher Concrete m RealWorld-  -> VM Concrete RealWorld-  -> Stepper Concrete RealWorld a+  => Fetch.Fetcher Concrete m+  -> VM Concrete+  -> Stepper Concrete a   -> m a interpret fetcher vm = eval . view   where-    eval :: ProgramView (Action Concrete RealWorld) a -> m a+    eval :: ProgramView (Action Concrete) a -> m a     eval (Return x) = pure x     eval (action :>>= k) =       case action of

@@ -1,26 +1,31 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DisambiguateRecordFields #-}  module EVM.SymExec where  import Prelude hiding (Foldable(..)) -import Control.Arrow ((>>>))-import Control.Concurrent.Async (concurrently, mapConcurrently)+import Control.Concurrent (forkIO, killThread)+import Control.Concurrent.Async ( mapConcurrently)+import Control.Concurrent.Chan (Chan, newChan, writeChan, readChan) import Control.Concurrent.Spawn (parMapIO, pool)-import Control.Monad (when, forM_, forM)-import Control.Monad.IO.Unlift+import Control.Concurrent.STM (writeTChan, newTChan, TChan, readTChan, atomically, isEmptyTChan, STM)+import Control.Concurrent.STM.TVar (TVar, newTVarIO, modifyTVar, readTVar, writeTVar)+import Control.Concurrent.STM.TMVar (TMVar, putTMVar, takeTMVar, newEmptyTMVarIO)+import Control.Monad (when, forM_, forM, forever)+import Control.Monad.Loops (whileM)+import Control.Monad.IO.Unlift (MonadUnliftIO, toIO, withRunInIO) import Control.Monad.Operational qualified as Operational import Control.Monad.ST (RealWorld, stToIO, ST)-import Control.Monad.State.Strict (runStateT)+import Control.Monad.State.Strict (liftIO, runStateT) import Data.ByteString (ByteString) import Data.ByteString qualified as BS-import Data.Containers.ListUtils (nubOrd) import Data.DoubleWord (Word256)-import Data.Foldable (Foldable(..))+import Data.Foldable (length, foldl', foldr) import Data.List (sortBy, sort) import Data.List.NonEmpty qualified as NE-import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)+import Data.Maybe (fromMaybe, listToMaybe, mapMaybe, catMaybes) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Map.Merge.Strict qualified as Map@@ -28,15 +33,23 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T+import Data.Text.Encoding (encodeUtf8) import Data.Text.IO qualified as T import Data.Tree.Zipper qualified as Zipper import Data.Tuple (swap) import Data.Vector qualified as V import Data.Vector.Storable qualified as VS import Data.Vector.Storable.ByteString (vectorToByteString)+import GHC.Conc (numCapabilities, getNumProcessors)+import GHC.Generics (Generic)+import GHC.Num.Natural (Natural)+import Optics.Core+import Options.Generic (ParseField, ParseFields, ParseRecord)+import Text.Printf (printf)+import Witch (into, unsafeInto)  import EVM (makeVm, abstractContract, initialContract, getCodeLocation, isValidJumpDest)-import EVM.Exec+import EVM.Exec (exec) import EVM.Fetch qualified as Fetch import EVM.ABI import EVM.Effects@@ -44,20 +57,12 @@ import EVM.FeeSchedule (feeSchedule) import EVM.Format (formatExpr, formatPartial, formatPartialDetailed, showVal, indent, formatBinary, formatProp, formatState, formatError) import EVM.SMT qualified as SMT-import EVM.Solvers+import EVM.Solvers (SolverGroup, checkSatWithProps) import EVM.Stepper (Stepper) import EVM.Stepper qualified as Stepper-import EVM.Traversals+import EVM.Traversals (mapExpr, mapExprM, foldTerm) import EVM.Types hiding (Comp) import EVM.Types qualified-import EVM.Expr (maybeConcStoreSimp)-import GHC.Conc (getNumProcessors)-import GHC.Generics (Generic)-import Optics.Core-import Options.Generic (ParseField, ParseFields, ParseRecord)-import Text.Printf (printf)-import Witch (into, unsafeInto)-import Data.Text.Encoding (encodeUtf8) import EVM.Solidity (WarningData (..))  data LoopHeuristic@@ -74,7 +79,7 @@     getIssue _ = Nothing     grouped = NE.group $ sort $ mapMaybe getIssue results -groupPartials :: Maybe (WarningData s t) -> [Expr End] -> [(Integer, String)]+groupPartials :: Maybe (WarningData t) -> [Expr End] -> [(Integer, String)] groupPartials warnData e = map (\g -> (into (length g), NE.head g)) grouped   where     getPartial :: Expr End -> Maybe String@@ -105,12 +110,9 @@ defaultVeriOpts :: VeriOpts defaultVeriOpts = VeriOpts   { iterConf = defaultIterConf-  , rpcInfo = mempty+  , rpcInfo = Fetch.noRpc   } -rpcVeriOpts :: (Fetch.BlockNumber, Text) -> VeriOpts-rpcVeriOpts info = defaultVeriOpts { rpcInfo  = mempty { Fetch.blockNumURL = Just info }}- extractCex :: VerifyResult -> Maybe (Expr End, SMTCex) extractCex (Cex c) = Just c extractCex _ = Nothing@@ -213,9 +215,9 @@ abstractVM   :: (Expr Buf, [Prop])   -> ByteString-  -> Maybe (Precondition s)+  -> Maybe (Precondition)   -> Bool-  -> ST s (VM Symbolic s)+  -> ST RealWorld (VM Symbolic) abstractVM cd contractCode maybepre create = do   let value = TxValue   let code = if create then InitCode contractCode (fst cd) else RuntimeCode (ConcreteRuntimeCode contractCode)@@ -230,7 +232,7 @@   :: ContractCode   -> Expr EWord   -> (Expr Buf, [Prop])-  -> ST s (VM Symbolic s)+  -> ST RealWorld (VM Symbolic) loadEmptySymVM x callvalue cd =   (makeVm $ VMOpts     { contract = initialContract x@@ -267,7 +269,7 @@   -> Expr EWord   -> (Expr Buf, [Prop])   -> Bool-  -> ST s (VM Symbolic s)+  -> ST RealWorld (VM Symbolic) loadSymVM x callvalue cd create =   (makeVm $ VMOpts     { contract = if create then initialContract x else abstractContract x (SymAddr "entrypoint")@@ -299,16 +301,16 @@     })  -- freezes any mutable refs, making it safe to share between threads-freezeVM :: VM Symbolic RealWorld -> ST RealWorld (VM Symbolic RealWorld)+freezeVM :: VM Symbolic -> ST RealWorld (VM Symbolic) freezeVM vm = do     state' <- do       mem' <- freeze (vm.state.memory)       pure $ vm.state { memory = mem' }-    frames' <- forM (vm.frames :: [Frame Symbolic RealWorld]) $ \frame -> do+    frames' <- forM (vm.frames :: [Frame Symbolic]) $ \frame -> do       mem' <- freeze frame.state.memory-      pure $ (frame :: Frame Symbolic RealWorld) { state = frame.state { memory = mem' } }+      pure $ (frame :: Frame Symbolic) { state = frame.state { memory = mem' } } -    pure (vm :: VM Symbolic RealWorld)+    pure (vm :: VM Symbolic)       { state = state'       , frames = frames'       }@@ -317,60 +319,192 @@       ConcreteMemory m -> SymbolicMemory . ConcreteBuf . vectorToByteString <$> VS.freeze m       m@(SymbolicMemory _) -> pure m --- | Interpreter which explores all paths at branching points. Returns an--- 'Expr End' representing the possible executions.-interpret-  :: forall m . App m-  => Fetch.Fetcher Symbolic m RealWorld+data InterpTask m a = InterpTask+  {fetcher :: Fetch.Fetcher Symbolic m+  , iterConf :: IterConfig+  , vm :: VM Symbolic+  , taskQ :: Chan (InterpTask m a)+  , numTasks :: TVar Natural+  , stepper :: Stepper Symbolic (Expr End)+  , handler :: Expr End -> m a+  }++data Process m a = Process+  { result :: Expr End+  , handler :: Expr End -> m a+  }++interpret :: forall m a . App m+  => Fetch.Fetcher Symbolic m   -> IterConfig-  -> VM Symbolic RealWorld-  -> Stepper Symbolic RealWorld (Expr End)+  -> VM Symbolic+  -> Stepper Symbolic (Expr End)+  -> (Expr End -> m a)+  -> m [a]+interpret fetcher iterConf vm stepper handler = do+  conf <- readConfig+  taskQ <- liftIO newChan+  processQ <- liftIO newChan++  -- spawn interpreters and process instances+  let interpInstances = replicate numCapabilities ()+      procInstances = replicate numCapabilities ()++  -- result channel+  resChan <- liftIO . atomically $ newTChan++  -- spawn orchestration thread with queues and flags+  availableInstances <- liftIO newChan+  liftIO $ forM_ interpInstances (writeChan availableInstances)+  availableProcs <- liftIO newChan+  liftIO $ forM_ procInstances (writeChan availableProcs)+  numTasks <- liftIO $ newTVarIO 1+  numProcs <- liftIO $ newTVarIO 0+  allProcessDone <- liftIO newEmptyTMVarIO++  -- spawn task orchestration thread+  taskOrchestrate' <- toIO $ taskOrchestrate taskQ availableInstances processQ numTasks numProcs+  taskOrchestrateId <- liftIO $ forkIO taskOrchestrate'++  -- spawn processing orchestration thread+  processOrchestrate' <- toIO $ processOrchestrate processQ availableProcs resChan numProcs numTasks allProcessDone+  processOrchestrateId <- liftIO $ forkIO processOrchestrate'++  -- Add in the first task, further tasks will be added by the interpreters themselves+  let interpTask = InterpTask+        { fetcher = fetcher+        , iterConf = iterConf+        , vm = vm+        , taskQ = taskQ+        , numTasks = numTasks+        , stepper = stepper+        , handler = handler+        }+  liftIO $ writeChan taskQ interpTask++  -- Wait for all done+  liftIO . atomically $ takeTMVar allProcessDone+  liftIO $ killThread taskOrchestrateId+  liftIO $ killThread processOrchestrateId+  res <- liftIO $ atomically (whileM (not <$> isEmptyTChan resChan) (readTChan resChan) :: STM [a])+  when (conf.debug) $ liftIO $ do+    putStrLn $ "Interpretation finished, collected " <> show (length res) <> " results."+  pure res+  where+    -- orchestrator loop+    taskOrchestrate :: App m+      => Chan (InterpTask m a)+      -> Chan () -> Chan (Process m a)+      -> TVar Natural -> TVar Natural -> m b+    taskOrchestrate taskQ avail processQ numTasks numProcs = forever $ do+      _ <- liftIO $ readChan avail+      task <- liftIO $ readChan taskQ+      runTask' <- toIO $ getOneExpr task avail processQ numTasks numProcs+      liftIO $ forkIO runTask'++    -- processing orchestrator loop+    processOrchestrate :: App m => Chan (Process m a) -> Chan () -> TChan a -> TVar Natural -> TVar Natural -> TMVar () -> m b+    processOrchestrate processQ availProcessors resChan numProcs numTasks allProcessDone = forever $ do+      _ <- liftIO $ readChan availProcessors+      proc <- liftIO $ readChan processQ+      runProcess' <- toIO $ processOne proc availProcessors resChan numProcs numTasks allProcessDone+      liftIO $ forkIO runProcess'++    -- process one task+    processOne :: App m => Process m a -> Chan () -> TChan a -> TVar Natural -> TVar Natural -> TMVar () -> m ()+    processOne task availProcs resChan numProcs numTasks allProcessDone = do+      processed <- task.handler task.result+      liftIO . atomically $ writeTChan resChan processed++      -- Return instance to pool immediately after processing+      liftIO $ writeChan availProcs ()++      -- Decrement and check if all done+      liftIO $ atomically $ do+        np <- readTVar numProcs+        let np' = np - 1+        writeTVar numProcs np'+        -- Check if both interpretation and processing are done+        nt <- readTVar numTasks+        when (np' == 0 && nt == 0) $ putTMVar allProcessDone ()++getOneExpr :: forall m a . App m+  => InterpTask m a+  -> Chan ()+  -> Chan (Process m a)+  -> TVar Natural+  -> TVar Natural+  -> m ()+getOneExpr task availableInstances processQ numTasks numProcs = do+  out <- interpretInternal task++  -- Enqueue for processing+  let process = Process { result = out, handler = task.handler }+  liftIO . atomically $ modifyTVar numProcs (+1)++  -- Return instance to pool & decrement tasks+  liftIO $ writeChan availableInstances ()+  liftIO $ atomically $ modifyTVar numTasks (subtract 1)++  -- Finally write to process queue. Must be done after numTasks decrement,+  -- or it could be that when we check in processOne, numTasks is still non-zero+  liftIO $ writeChan processQ process++-- | Symbolic interpreter that explores all paths. Returns an+-- '[Expr End]' representing the possible execution leafs.+interpretInternal :: forall m a . App m+  => InterpTask m a   -> m (Expr End)-interpret fetcher iterConf vm =-  eval . Operational.view+interpretInternal t@InterpTask{..} = eval (Operational.view stepper)   where-  eval :: Operational.ProgramView (Stepper.Action Symbolic RealWorld) (Expr End) -> m (Expr End)+  eval :: Operational.ProgramView (Stepper.Action Symbolic) (Expr End) -> m (Expr End)   eval (Operational.Return x) = pure x   eval (action Operational.:>>= k) =     case action of       Stepper.Exec -> do         conf <- readConfig         (r, vm') <- liftIO $ stToIO $ runStateT (exec conf) vm-        interpret fetcher iterConf vm' (k r)+        interpretInternal t { vm = vm', stepper =  (k r) }       Stepper.EVM m -> do         (r, vm') <- liftIO $ stToIO $ runStateT m vm-        interpret fetcher iterConf vm' (k r)-      Stepper.ForkMany (PleaseRunAll expr vals continue) -> do+        interpretInternal t { vm = vm', stepper = (k r) }+      Stepper.Fork (PleaseRunAll vals continue) -> do         when (length vals < 2) $ internalError "PleaseRunAll requires at least 2 branches"         frozen <- liftIO $ stToIO $ freezeVM vm         let newDepth = vm.exploreDepth+1-        ends <- withRunInIO $ \runInIO -> mapConcurrently (runInIO . runOne frozen newDepth) vals-        pure $ goITE (zip vals ends)+        runOne frozen newDepth vals         where-          goITE :: [(Expr EWord, Expr End)] -> Expr End-          goITE [] = internalError "goITE: empty list"-          goITE [(_, end)] = end-          goITE ((val,end):ps) = ITE (Eq expr val) end (goITE ps)-          runOne :: App m => VM 'Symbolic RealWorld -> Int -> Expr EWord -> m (Expr 'End)-          runOne frozen newDepth v = do+          runOne :: App m => VM 'Symbolic -> Int -> [Expr EWord] -> m (Expr End)+          runOne frozen newDepth [v] = do+            conf <- readConfig             (ra, vma) <- liftIO $ stToIO $ runStateT (continue v) frozen { result = Nothing, exploreDepth = newDepth }-            interpret fetcher iterConf vma (k ra)-      Stepper.Fork (PleaseRunBoth cond continue) -> do+            when (conf.debug && conf.verb >= 2) $ liftIO $ putStrLn $ "Running last task for ForkMany at depth " <> show newDepth+            interpretInternal t { vm = vma, stepper = (k ra) }+          runOne frozen newDepth (v:rest) = do+            conf <- readConfig+            (ra, vma) <- liftIO $ stToIO $ runStateT (continue v) frozen { result = Nothing, exploreDepth = newDepth }+            liftIO $ atomically $ modifyTVar numTasks (+1)+            when (conf.debug && conf.verb >=2) $ liftIO $ putStrLn $ "Queuing new task for ForkMany at depth " <> show newDepth+            liftIO $ writeChan taskQ t { vm = vma, stepper = (k ra) }+            runOne frozen newDepth rest+          runOne _ _ [] = internalError "unreachable"+      Stepper.Fork (PleaseRunBoth continue) -> do+        conf <- readConfig         frozen <- liftIO $ stToIO $ freezeVM vm         let newDepth = vm.exploreDepth+1-        evalLeft <- toIO $ do-          (ra, vma) <- liftIO $ stToIO $ runStateT (continue True) frozen { result = Nothing, exploreDepth = newDepth }-          interpret fetcher iterConf vma (k ra)-        evalRight <- toIO $ do-          (rb, vmb) <- liftIO $ stToIO $ runStateT (continue False) frozen { result = Nothing, exploreDepth = newDepth }-          interpret fetcher iterConf vmb (k rb)-        (a, b) <- liftIO $ concurrently evalLeft evalRight-        pure $ ITE cond a b+        (ra, vma) <- liftIO $ stToIO $ runStateT (continue True) frozen { result = Nothing, exploreDepth = newDepth }+        liftIO $ atomically $ modifyTVar numTasks (+1)+        liftIO $ writeChan taskQ $ t { vm = vma, stepper = (k ra) }+        when (conf.debug && conf.verb >= 2) $ liftIO $ putStrLn $ "Queued new task for Fork at depth " <> show newDepth++        (rb, vmb) <- liftIO $ stToIO $ runStateT (continue False) frozen { result = Nothing, exploreDepth = newDepth }+        when (conf.debug && conf.verb >=2) $ liftIO $ putStrLn $ "Continuing task for Fork at depth " <> show newDepth+        interpretInternal t { vm = vmb, stepper = (k rb) }       Stepper.Wait q -> do         let performQuery = do               m <- fetcher q               (r, vm') <- liftIO$ stToIO $ runStateT m vm-              interpret fetcher iterConf vm' (k r)+              interpretInternal t { vm = vm', stepper = (k r) }          case q of           PleaseAskSMT cond preconds continue -> do@@ -385,7 +519,7 @@                   -- No. keep executing                   _ -> do                     (r, vm') <- liftIO $ stToIO $ runStateT (continue (Case (c > 0))) vm-                    interpret fetcher iterConf vm' (k r)+                    interpretInternal t { vm = vm', stepper = (k r) }                -- the condition is symbolic               _ ->@@ -394,10 +528,12 @@                   -- we're in a loop and maxIters has been reached                   (Just True, _, Just n) -> do                     -- continue execution down the opposite branch than the one that-                    -- got us to this point and return a partial leaf for the other side+                    -- got us to this point and queue a task to return a partial leaf for the other side+                    let partialLeaf = Partial [] (TraceContext (Zipper.toForest vm.traces) vm.env.contracts vm.labels) (MaxIterationsReached vm.state.pc vm.state.contract)+                    liftIO $ atomically $ modifyTVar numTasks (+1)+                    liftIO $ writeChan taskQ $ t { vm = vm, stepper = pure partialLeaf }                     (r, vm') <- liftIO $ stToIO $ runStateT (continue (Case $ not n)) vm-                    a <- interpret fetcher iterConf vm' (k r)-                    pure $ ITE cond a (Partial [] (TraceContext (Zipper.toForest vm.traces) vm.env.contracts vm.labels) (MaxIterationsReached vm.state.pc vm.state.contract))+                    interpretInternal t { vm = vm', stepper = (k r) }                   -- we're in a loop and askSmtIters has been reached                   (Just True, True, _) ->                     -- ask the smt solver about the loop condition@@ -408,10 +544,10 @@                       [PBool False] -> liftIO $ stToIO $ runStateT (continue (Case False)) vm                       [] -> liftIO $ stToIO $ runStateT (continue (Case True)) vm                       _ -> liftIO $ stToIO $ runStateT (continue UnknownBranch) vm-                    interpret fetcher iterConf vm' (k r)+                    interpretInternal t { vm = vm', stepper = (k r) }           _ -> performQuery -maxIterationsReached :: VM Symbolic s -> Maybe Integer -> Maybe Bool+maxIterationsReached :: VM Symbolic -> Maybe Integer -> Maybe Bool maxIterationsReached _ Nothing = Nothing maxIterationsReached vm (Just maxIter) =   let codelocation = getCodeLocation vm@@ -420,7 +556,7 @@      then Map.lookup (codelocation, iters - 1) vm.pathsVisited      else Nothing -askSmtItersReached :: VM Symbolic s -> Integer -> Bool+askSmtItersReached :: VM Symbolic -> Integer -> Bool askSmtItersReached vm askSmtIters = let     codelocation = getCodeLocation vm     (iters, _) = view (at codelocation % non (0, [])) vm.iterations@@ -434,7 +570,7 @@   This heuristic is not perfect, and can certainly be tricked, but should generally be good enough for most compiler generated and non pathological user generated loops.  -}-isLoopHead :: LoopHeuristic -> VM Symbolic s -> Maybe Bool+isLoopHead :: LoopHeuristic -> VM Symbolic -> Maybe Bool isLoopHead Naive _ = Just True isLoopHead StackBased vm = let     loc = getCodeLocation vm@@ -445,8 +581,8 @@        Just (_, oldStack) -> Just $ filter isValid oldStack == filter isValid vm.state.stack        Nothing -> Nothing -type Precondition s = VM Symbolic s -> Prop-type Postcondition s = VM Symbolic s -> Expr End -> Prop+type Precondition = VM Symbolic -> Prop+type Postcondition = VM Symbolic -> Expr End -> Prop  -- Used only in testing checkAssert@@ -457,23 +593,9 @@   -> Maybe Sig   -> [String]   -> VeriOpts-  -> m (Expr End, [VerifyResult])+  -> m ([Expr End], [VerifyResult]) checkAssert solvers errs c signature' concreteArgs opts = do-  checkAssertWithSession solvers Nothing errs c signature' concreteArgs opts---- Used only in testing-checkAssertWithSession-  :: App m-  => SolverGroup-  -> Maybe Fetch.Session-  -> [Word256]-  -> ByteString-  -> Maybe Sig-  -> [String]-  -> VeriOpts-  -> m (Expr End, [VerifyResult])-checkAssertWithSession solvers sess errs c signature' concreteArgs opts = do-  verifyContractWithSession solvers sess c signature' concreteArgs opts Nothing (Just $ checkAssertions errs)+  verifyContract solvers c signature' concreteArgs opts Nothing (checkAssertions errs)  -- Used only in testing getExprEmptyStore@@ -483,13 +605,13 @@   -> Maybe Sig   -> [String]   -> VeriOpts-  -> m (Expr End)+  -> m [Expr End] getExprEmptyStore solvers c signature' concreteArgs opts = do   conf <- readConfig   calldata <- mkCalldata signature' concreteArgs   preState <- liftIO $ stToIO $ loadEmptySymVM (RuntimeCode (ConcreteRuntimeCode c)) (Lit 0) calldata-  exprInter <- interpret (Fetch.oracle solvers Nothing opts.rpcInfo) opts.iterConf preState runExpr-  if conf.simp then (pure $ Expr.simplify exprInter) else pure exprInter+  paths <- interpret (Fetch.oracle solvers Nothing opts.rpcInfo) opts.iterConf preState runExpr pure+  if conf.simp then (pure $ map Expr.simplify paths) else pure paths  -- Used only in testing getExpr@@ -499,13 +621,13 @@   -> Maybe Sig   -> [String]   -> VeriOpts-  -> m (Expr End)+  -> m [Expr End] getExpr solvers c signature' concreteArgs opts = do   conf <- readConfig   calldata <- mkCalldata signature' concreteArgs   preState <- liftIO $ stToIO $ abstractVM calldata c Nothing False-  exprInter <- interpret (Fetch.oracle solvers Nothing opts.rpcInfo) opts.iterConf preState runExpr-  if conf.simp then (pure $ Expr.simplify exprInter) else pure exprInter+  paths <- interpret (Fetch.oracle solvers Nothing opts.rpcInfo) opts.iterConf preState runExpr pure+  if conf.simp then (pure $ map Expr.simplify paths) else pure paths  {- | Checks if an assertion violation has been encountered @@ -527,7 +649,7 @@   see: https://docs.soliditylang.org/en/v0.8.6/control-structures.html?highlight=Panic#panic-via-assert-and-error-via-require   NOTE: does not deal with e.g. `assertEq()` -}-checkAssertions :: [Word256] -> Postcondition s+checkAssertions :: [Word256] -> Postcondition checkAssertions errs _ = \case   Failure _ _ (UnrecognizedOpcode 0xfe)  -> PBool False   Failure _ _ (Revert (ConcreteBuf msg)) -> PBool $ msg `notElem` (fmap panicMsg errs)@@ -567,31 +689,32 @@   -> Maybe Sig   -> [String]   -> VeriOpts-  -> Maybe (Precondition RealWorld)-  -> Maybe (Postcondition RealWorld)-  -> m (Expr End, [VerifyResult])-verifyContract solvers theCode signature' concreteArgs opts maybepre maybepost = do-  verifyContractWithSession solvers Nothing theCode signature' concreteArgs opts maybepre maybepost+  -> Maybe Precondition+  -> Postcondition+  -> m ([Expr End], [VerifyResult])+verifyContract solvers theCode signature' concreteArgs opts maybepre post = do+  calldata <- mkCalldata signature' concreteArgs+  preState <- liftIO $ stToIO $ abstractVM calldata theCode maybepre False+  let fetcher = Fetch.oracle solvers Nothing opts.rpcInfo+  verify solvers fetcher opts preState post Nothing  -- Used only in testing-verifyContractWithSession :: forall m . App m+exploreContract :: forall m . App m   => SolverGroup-  -> Maybe Fetch.Session   -> ByteString   -> Maybe Sig   -> [String]   -> VeriOpts-  -> Maybe (Precondition RealWorld)-  -> Maybe (Postcondition RealWorld)-  -> m (Expr End, [VerifyResult])-verifyContractWithSession solvers sess theCode signature' concreteArgs opts maybepre maybepost = do+  -> Maybe Precondition+  -> m [Expr End]+exploreContract solvers theCode signature' concreteArgs opts maybepre = do   calldata <- mkCalldata signature' concreteArgs   preState <- liftIO $ stToIO $ abstractVM calldata theCode maybepre False-  let fetcher = Fetch.oracle solvers sess opts.rpcInfo-  verify solvers fetcher opts preState maybepost+  let fetcher = Fetch.oracle solvers Nothing opts.rpcInfo+  executeVM fetcher opts.iterConf preState pure  -- | Stepper that parses the result of Stepper.runFully into an Expr End-runExpr :: Stepper.Stepper Symbolic RealWorld (Expr End)+runExpr :: Stepper.Stepper Symbolic (Expr End) runExpr = do   vm <- Stepper.runFully   let traces = TraceContext (Zipper.toForest vm.traces) vm.env.contracts vm.labels@@ -604,53 +727,12 @@ toEContract :: Contract -> Expr EContract toEContract c = C c.code c.storage c.tStorage c.balance c.nonce --- | Converts a given top level expr into a list of final states and the--- associated path conditions for each state.-flattenExpr :: Expr End -> [Expr End]-flattenExpr = go []-  where-    go :: [Prop] -> Expr End -> [Expr End]-    go pcs = \case-      ITE c t f -> go (PNeg ((PEq (Lit 0) c)) : pcs) t <> go (PEq (Lit 0) c : pcs) f-      Success ps trace msg store -> [Success (nubOrd $ ps <> pcs) trace msg store]-      Failure ps trace e -> [Failure (nubOrd $ ps <> pcs) trace e]-      Partial ps trace p -> [Partial (nubOrd $ ps <> pcs) trace p]-      GVar _ -> internalError "cannot flatten an Expr containing a GVar"---- | Strips unreachable branches from a given expr--- Returns a list of executed SMT queries alongside the reduced expression for debugging purposes--- Note that the reduced expression loses information relative to the original--- one if jump conditions are removed. This restriction can be removed once--- Expr supports attaching knowledge to AST nodes.--- Although this algorithm currently parallelizes nicely, it does not exploit--- the incremental nature of the task at hand. Introducing support for--- incremental queries might let us go even faster here.--- TODO: handle errors properly-reachable :: App m => SolverGroup -> Expr End -> m (Expr End)-reachable solvers e = do-  res <- go [] e-  pure $ fromMaybe (internalError "no reachable paths found") res+-- | Strips unreachable branches from a given list of Expr End nodes+reachable :: App m => SolverGroup -> [Expr End] -> m [Expr End]+reachable solvers e = catMaybes <$> mapM go e   where-    {--       Walk down the tree and collect pcs.-       Dispatch a reachability query at each leaf.-       If reachable return the expr wrapped in a Just. If not return Nothing.-       When walking back up the tree drop unreachable subbranches.-    -}-    go :: (App m, MonadUnliftIO m) => [Prop] -> Expr End -> m (Maybe (Expr End))-    go pcs = \case-      ITE c t f -> do-        (tres, fres) <- withRunInIO $ \env -> concurrently-          (env $ go (PEq (Lit 1) c : pcs) t)-          (env $ go (PEq (Lit 0) c : pcs) f)-        let subexpr = case (tres, fres) of-              (Just t', Just f') -> Just $ ITE c t' f'-              (Just t', Nothing) -> Just t'-              (Nothing, Just f') -> Just f'-              (Nothing, Nothing) -> Nothing-        pure subexpr-      leaf -> do-        res <- checkSatWithProps solvers pcs+    go leaf = do+        res <- checkSatWithProps solvers (extractProps leaf)         case res of           Qed -> pure Nothing           Cex _ -> pure (Just leaf)@@ -661,7 +743,6 @@ -- | Extract constraints stored in Expr End nodes extractProps :: Expr End -> [Prop] extractProps = \case-  ITE _ _ _ -> []   Success asserts _ _ _ -> asserts   Failure asserts _ _ -> asserts   Partial asserts _ _ -> asserts@@ -669,7 +750,6 @@  extractEndStates :: Expr End -> Map (Expr EAddr) (Expr EContract) extractEndStates = \case-  ITE {} -> mempty   Success _ _ _ contr -> contr   Failure {} -> mempty   Partial  {} -> mempty@@ -694,96 +774,100 @@       e@(Partial _ _ p) -> Just (p, e)       _ -> Nothing ++-- | Symbolically execute the VM and return the representention of the execution+executeVM :: forall m a . App m => Fetch.Fetcher Symbolic m -> IterConfig -> VM Symbolic -> (Expr End -> m a) -> m [a]+executeVM fetcher iterConfig preState handlePath = interpret fetcher iterConfig preState runExpr handlePath+ -- | Symbolically execute the VM and check all endstates against the -- postcondition, if available. verify :: App m   => SolverGroup-  -> Fetch.Fetcher Symbolic m RealWorld+  -> Fetch.Fetcher Symbolic m   -> VeriOpts-  -> VM Symbolic RealWorld-  -> Maybe (Postcondition RealWorld)-  -> m (Expr End, [VerifyResult])-verify solvers fetcher opts preState maybepost = do-  (expr, res, _) <- verifyInputs solvers opts fetcher preState maybepost-  pure $ verifyResults preState expr res+  -> VM Symbolic+  -> Postcondition+  -> Maybe (VM Symbolic -> SMTResult -> Expr End -> m ())+  -> m ([Expr End], [VerifyResult])+verify solvers fetcher opts preState post cexHandler = do+  (ends1, partials) <- verifyInputsWithHandler solvers opts fetcher preState post cexHandler+  let (ends2, results) = unzip $ map (verifyResult preState) ends1+  pure (ends2 <> fmap snd partials, filter (not . isQed) results) -verifyResults :: VM Symbolic RealWorld -> Expr End -> [(SMTResult, Expr End)] -> (Expr End, [VerifyResult])-verifyResults preState expr cexs = if null cexs then (expr, [Qed]) else (expr, fmap toVRes cexs)+verifyResult :: VM Symbolic-> (SMTResult, Expr End) -> (Expr End, VerifyResult)+verifyResult preState res = (snd res, toVRes res)   where     toVRes :: (SMTResult, Expr End) -> VerifyResult-    toVRes (res, leaf) = case res of+    toVRes (res2, leaf) = case res2 of       Cex model -> Cex (leaf, expandCex preState model)       Unknown reason -> Unknown (reason, leaf)       Error e -> Error e       Qed -> Qed --- | Symbolically execute the VM and find possible inputs given the--- postcondition, if available.-verifyInputs+-- | Symbolically execute the VM with optional custom handler for immediate Cex processing+verifyInputsWithHandler   :: App m   => SolverGroup   -> VeriOpts-  -> Fetch.Fetcher Symbolic m RealWorld-  -> VM Symbolic RealWorld-  -> Maybe (Postcondition RealWorld)-  -> m (Expr End, [(SMTResult, Expr End)], [(PartialExec, Expr End)])-verifyInputs solvers opts fetcher preState maybepost = do+  -> Fetch.Fetcher Symbolic m+  -> VM Symbolic+  -> Postcondition+  -> Maybe (VM Symbolic -> SMTResult -> Expr End -> m ())+  -> m ([(SMTResult, Expr End)], [(PartialExec, Expr End)])+verifyInputsWithHandler solvers opts fetcher preState post cexHandler = do   conf <- readConfig   let call = mconcat ["prefix 0x", getCallPrefix preState.state.calldata]-  when conf.debug $ liftIO $ putStrLn $ "   Exploring call " <> call--  expr <- interpret fetcher opts.iterConf preState runExpr-  when conf.dumpExprs $ liftIO $ T.writeFile "unsimplified.expr" (formatExpr expr)-  let flattened = flattenExpr expr-  when (conf.dumpExprs && conf.simp) $ liftIO $ do-    let exprSimplified = Expr.simplify expr-    T.writeFile "simplified.expr" (formatExpr exprSimplified)-    T.writeFile "simplified-conc.expr" (formatExpr $ Expr.simplify $ mapExpr Expr.concKeccakOnePass exprSimplified)--  let partials = getPartials flattened   when conf.debug $ liftIO $ do-    putStrLn "   Flattening expression"-    printPartialIssues flattened ("the call " <> call)-    putStrLn $ "   Exploration finished, " <> show (Expr.numBranches expr) <> " branch(es) to check in call " <> call     putStrLn $ "   Keccak preimages in state: " <> (show $ length preState.keccakPreImgs)-  case maybepost of-    Nothing -> pure (expr, [(Qed, expr)], partials)-    Just post -> do-      let-        -- Filter out any leaves from `flattened` that can be statically shown to be safe-        tocheck = flip map flattened $ \leaf -> (toProps leaf preState post, leaf)-        withQueries = filter canBeSat tocheck-      when conf.debug $ liftIO $ putStrLn $ "   Checking for reachability of " <> show (length withQueries)-        <> " potential property violation(s) in call " <> call+    putStrLn $ "   Exploring call " <> call -      -- Dispatch the remaining branches to the solver to check for violations-      results <- withRunInIO $ \env -> flip mapConcurrently withQueries $ \(query, leaf) -> do-        res <- env $ checkSatWithProps solvers query-        when conf.debug $ putStrLn $ "   SMT result: " <> show res+  results <- executeVM fetcher opts.iterConf preState $ \leaf -> do+    -- Extract partial if applicable+    let mPartial = case leaf of+          Partial _ _ p -> Just (p, leaf)+          _ -> Nothing++    -- Check if this leaf needs SMT checking+    let props = toProps leaf preState.keccakPreImgs post+    smtResult <- if canBeSat (props, leaf)+      then do+        res <- checkSatWithProps solvers props+        when (conf.debug && conf.verb >=2) $ liftIO $ putStrLn $ "   Checking leaf with props: " <> show props <> " SMT result: " <> show res+        -- Call custom handler if provided (for immediate Cex processing/validation/printing)+        case (cexHandler, res) of+          (Just handler, cex@(Cex _)) -> handler preState cex leaf+          _ -> pure ()         pure (res, leaf)-      let cexs = filter (\(res, _) -> not . isQed $ res) results-      when conf.debug $ liftIO $-        putStrLn $ "   Found " <> show (length cexs) <> " potential counterexample(s) in call " <> call-      pure (expr, cexs, partials)+      else pure (Qed, leaf)+    pure (smtResult, mPartial)++  let (smtResults, partials) = unzip results+  when conf.debug $ liftIO $ do+    putStrLn $ "   Exploration and solving finished, " <> show (length results) <> " branch(es) checked in call " <> call <> " of which partial: "+                <> show (length smtResults)+    let cexs = filter (\(res, _) -> not . isQed $ res) smtResults+    putStrLn $ "   Found " <> show (length cexs) <> " counterexample(s) in call " <> call++  pure (smtResults, catMaybes partials)   where     getCallPrefix :: Expr Buf -> String     getCallPrefix (WriteByte (Lit 0) (LitByte a) (WriteByte (Lit 1) (LitByte b) (WriteByte (Lit 2) (LitByte c) (WriteByte (Lit 3) (LitByte d) _)))) = mconcat $ map (printf "%02x") [a,b,c,d]     getCallPrefix _ = "unknown"-    toProps leaf vm post = let-      postCondition = post preState leaf-      keccakConstraints = map (\(bs, k)-> PEq (Keccak (ConcreteBuf bs)) (Lit k)) (Set.toList vm.keccakPreImgs)+    toProps leaf keccakPreImgs post' = let+      postCondition = post' preState leaf+      keccakConstraints = map (\(bs, k)-> PEq (Keccak (ConcreteBuf bs)) (Lit k)) (Set.toList keccakPreImgs)      in case postCondition of       PBool True -> [PBool False]-      _ -> PNeg postCondition : vm.constraints <> extractProps leaf <> keccakConstraints+      _ -> PNeg postCondition : extractProps leaf <> keccakConstraints      canBeSat (a, _) = case a of         [PBool False] -> False         _ -> True -expandCex :: VM Symbolic s -> SMTCex -> SMTCex+expandCex :: VM Symbolic -> SMTCex -> SMTCex expandCex prestate c = c { store = Map.union c.store concretePreStore }   where-    concretePreStore = Map.mapMaybe (maybeConcStoreSimp . (.storage))+    concretePreStore = Map.mapMaybe (Expr.maybeConcStoreSimp . (.storage))                      . Map.filter (\v -> Expr.containsNode isConcreteStore v.storage)                      $ (prestate.env.contracts)     isConcreteStore = \case@@ -813,13 +897,14 @@ equivalenceCheck   :: forall m . App m   => SolverGroup+  -> Maybe Fetch.Session   -> ByteString   -> ByteString   -> VeriOpts   -> (Expr Buf, [Prop])   -> Bool   -> m EqIssues-equivalenceCheck solvers bytecodeA bytecodeB opts calldata create = do+equivalenceCheck solvers sess bytecodeA bytecodeB opts calldata create = do   conf <- readConfig   case bytecodeA == bytecodeB of     True -> liftIO $ do@@ -840,24 +925,16 @@       let branchesA = rewriteFresh "A-" branchesAorig           branchesB = rewriteFresh "B-" branchesBorig       let partialIssues = EqIssues mempty (filter isPartial branchesA <> filter isPartial branchesB)-      issues <- equivalenceCheck' solvers branchesA branchesB create-      pure $ oneQedOrNoQed issues <> partialIssues+      issues <- equivalenceCheck' solvers sess branchesA branchesB create+      pure $ filterQeds (issues <> partialIssues)   where     -- decompiles the given bytecode into a list of branches     getBranches :: App m => ByteString -> m [Expr End]     getBranches bs = do-      conf <- readConfig       let bytecode = if BS.null bs then BS.pack [0] else bs       prestate <- liftIO $ stToIO $ abstractVM calldata bytecode Nothing create-      expr <- interpret (Fetch.oracle solvers Nothing mempty) opts.iterConf prestate runExpr-      let simpl = if conf.simp then Expr.simplify expr else expr-      pure $ flattenExpr simpl-    oneQedOrNoQed :: EqIssues -> EqIssues-    oneQedOrNoQed (EqIssues res partials) =-      let allQed = all (\(r, _) -> isQed r) res-      in if allQed then EqIssues [(Qed, "")] partials-          else EqIssues (filter (\(r, _) -> not $ isQed r) res) partials-+      interpret (Fetch.oracle solvers sess Fetch.noRpc) opts.iterConf prestate runExpr pure+    filterQeds (EqIssues res partials) = EqIssues (filter (\(r, _) -> not . isQed $ r) res) partials  rewriteFresh :: Text -> [Expr a] -> [Expr a] rewriteFresh prefix exprs = fmap (mapExpr mymap) exprs@@ -871,8 +948,8 @@  equivalenceCheck'   :: forall m . App m-  => SolverGroup -> [Expr End] -> [Expr End] -> Bool -> m EqIssues-equivalenceCheck' solvers branchesA branchesB create = do+  => SolverGroup -> Maybe Fetch.Session -> [Expr End] -> [Expr End] -> Bool -> m EqIssues+equivalenceCheck' solvers sess branchesA branchesB create = do       conf <- readConfig       when conf.debug $ do         liftIO $ printPartialIssues branchesA "codeA"@@ -972,8 +1049,6 @@         -- partial end states can't be compared to actual end states, so we always ignore them         (Partial {}, _) -> pure (Nothing, mempty)         (_, Partial {}) -> pure (Nothing, mempty)-        (ITE _ _ _, _) -> internalError "Expressions must be flattened"-        (_, ITE _ _ _) -> internalError "Expressions must be flattened"         (GVar _, _) -> internalError "GVar in equivalence check"         (_, GVar _) -> internalError "GVar in equivalence check" @@ -1005,7 +1080,7 @@             liftIO $ putStrLn $ "create deployed code B: " <> bsToHex codeB               <> " with constraints: " <> (T.unpack . T.unlines $ map formatProp bProps)           calldata <- mkCalldata Nothing []-          equivalenceCheck solvers codeA codeB defaultVeriOpts calldata False+          equivalenceCheck solvers sess codeA codeB defaultVeriOpts calldata False         _ -> internalError $ "Symbolic code returned from constructor." <> " A: " <> show simpA <> " B: " <> show simpB      statesDiffer :: Map (Expr EAddr) (Expr EContract) -> Map (Expr EAddr) (Expr EContract) -> Prop@@ -1035,10 +1110,9 @@ both' :: (a -> b) -> (a, a) -> (b, b) both' f (x, y) = (f x, f y) -produceModels :: App m => SolverGroup -> Expr End -> m [(Expr End, SMTResult)]-produceModels solvers expr = do-  let flattened = flattenExpr expr-      withQueries = fmap (\e -> (extractProps e, e)) flattened+produceModels :: App m => SolverGroup -> [Expr End] -> m [(Expr End, SMTResult)]+produceModels solvers exprs = do+  let withQueries = fmap (\e -> (extractProps e, e)) exprs   results <- withRunInIO $ \runInIO -> (flip mapConcurrently) withQueries $ \(query, leaf) -> do     res <- runInIO $ checkSatWithProps solvers query     pure (res, leaf)@@ -1158,7 +1232,7 @@  calldataFromCex :: App m => SMTCex -> Expr Buf -> Sig -> m (Err ByteString) calldataFromCex cex buf sig = do-  let sigKeccak = keccakSig $ encodeUtf8 (callSig sig)+  let sigKeccak = BS.take 4 $ keccakBytes $ encodeUtf8 (callSig sig)   pure $ (sigKeccak <>) <$> body   where     cd = defaultSymbolicValues $ subModel cex buf@@ -1169,8 +1243,6 @@     forceConcrete :: (Expr Buf) -> Err ByteString     forceConcrete (ConcreteBuf k) = Right k     forceConcrete _ = Left "Symbolic buffer in calldata, cannot produce concrete model"-    keccakSig :: ByteString -> ByteString-    keccakSig = keccakBytes >>> BS.take 4  prettyCalldata :: SMTCex -> Expr Buf -> Text -> [AbiType] -> Text prettyCalldata cex buf sig types = headErr errSig (T.splitOn "(" sig) <> "(" <> body <> ")" <> T.pack finalErr

@@ -15,7 +15,7 @@ import Optics.State  import Control.Monad.IO.Class-import Control.Monad.ST (stToIO, RealWorld)+import Control.Monad.ST (stToIO) import Data.Aeson qualified as JSON import Data.Word (Word8, Word64) import GHC.Generics (Generic)@@ -70,14 +70,14 @@ instance JSON.ToJSON VMTraceStepResult where   toEncoding = JSON.genericToEncoding JSON.defaultOptions -type TraceState s = (VM Concrete s, [VMTraceStep])+type TraceState = (VM Concrete, [VMTraceStep]) -execWithTrace :: App m => StateT (TraceState RealWorld) m (VMResult Concrete RealWorld)+execWithTrace :: App m => StateT (TraceState) m (VMResult Concrete) execWithTrace = do   _ <- runWithTrace   fromJust <$> use (_1 % #result) -runWithTrace :: App m => StateT (TraceState RealWorld) m (VM Concrete RealWorld)+runWithTrace :: App m => StateT (TraceState) m (VM Concrete) runWithTrace = do   -- This is just like `exec` except for every instruction evaluated,   -- we also increment a counter indexed by the current code location.@@ -100,16 +100,16 @@  interpretWithTrace   :: forall m a . App m-  => Fetch.Fetcher Concrete m RealWorld-  -> Stepper Concrete RealWorld a-  -> StateT (TraceState RealWorld) m a+  => Fetch.Fetcher Concrete m+  -> Stepper Concrete a+  -> StateT TraceState m a interpretWithTrace fetcher =   eval . Operational.view   where     eval       :: App m-      => Operational.ProgramView (Action Concrete RealWorld) a-      -> StateT (TraceState RealWorld) m a+      => Operational.ProgramView (Action Concrete) a+      -> StateT TraceState m a     eval (Operational.Return x) = pure x     eval (action Operational.:>>= k) =       case action of@@ -127,7 +127,7 @@           assign _1 vm'           interpretWithTrace fetcher (k r) -vmTraceStep :: VM Concrete s -> VMTraceStep+vmTraceStep :: VM Concrete -> VMTraceStep vmTraceStep vm =   let     memsize = vm.state.memorySize@@ -143,11 +143,11 @@     , error = readoutError vm.result     }   where-    readoutError :: Maybe (VMResult t s) -> Maybe String+    readoutError :: Maybe (VMResult t) -> Maybe String     readoutError (Just (VMFailure e)) = Just $ evmErrToString e     readoutError _ = Nothing -getOpFromVM :: VM t s -> Word8+getOpFromVM :: VM t -> Word8 getOpFromVM vm =   let pcpos  = vm ^. #state % #pc       code' = vm ^. #state % #code

@@ -254,7 +254,7 @@ -- | Given a valid tx loaded into the vm state, -- subtract gas payment from the origin, increment the nonce -- and pay receiving address-initTx :: VM t s -> VM t s+initTx :: VM t -> VM t initTx vm =   let     toAddr   = vm.state.contract

@@ -96,7 +96,6 @@       e@(Failure a _ (Revert c)) -> f e <> (foldl' (foldProp f) mempty a) <> go c       e@(Failure a _ _) -> f e <> (foldl' (foldProp f) mempty a)       e@(Partial a _ _) -> f e <> (foldl' (foldProp f) mempty a)-      e@(ITE a b c) -> f e <> (go a) <> (go b) <> (go c)        -- integers @@ -358,11 +357,6 @@         pure (k',v')       pure $ Map.fromList x'     f (Success a' b c' d')-  ITE a b c -> do-    a' <- mapExprM f a-    b' <- mapExprM f b-    c' <- mapExprM f c-    f (ITE a' b' c')    -- integers 

@@ -17,7 +17,7 @@ import GHC.ByteOrder (targetByteOrder, ByteOrder(..)) import Control.Arrow ((>>>)) import Control.Monad (mzero)-import Control.Monad.ST (ST)+import Control.Monad.ST (ST, RealWorld) import Control.Monad.State.Strict (StateT) import Crypto.Hash (hash, Keccak_256, Digest) import Data.Aeson qualified as JSON@@ -231,7 +231,6 @@   Partial        :: [Prop] -> TraceContext -> PartialExec -> Expr End   Failure        :: [Prop] -> TraceContext -> EvmError -> Expr End   Success        :: [Prop] -> TraceContext -> Expr Buf -> Map (Expr EAddr) (Expr EContract) -> Expr End-  ITE            :: Expr EWord -> Expr End -> Expr End -> Expr End    -- integers @@ -598,34 +597,29 @@   deriving (Show, Eq, Ord)  -- | Effect types used by the vm implementation for side effects & control flow-data Effect t s where-  Query :: Query t s -> Effect t s-  RunBoth :: RunBoth s -> Effect Symbolic s-  RunAll :: RunAll s -> Effect Symbolic s-deriving instance Show (Effect t s)+data Effect t where+  Query :: Query t -> Effect t+  Branch :: BranchContext -> Effect Symbolic+deriving instance Show (Effect t)  -- | Queries halt execution until resolved through RPC calls or SMT queries-data Query t s where-  PleaseFetchContract :: Addr -> BaseState -> (Contract -> EVM t s ()) -> Query t s-  PleaseFetchSlot     :: Addr -> W256 -> (W256 -> EVM t s ()) -> Query t s-  PleaseAskSMT        :: Expr EWord -> [Prop] -> (BranchCondition -> EVM Symbolic s ()) -> Query Symbolic s-  PleaseGetSols       :: Expr EWord -> Int -> [Prop] -> (Maybe [W256] -> EVM Symbolic s ()) -> Query Symbolic s-  PleaseDoFFI         :: [String] -> Map String String -> (ByteString -> EVM t s ()) -> Query t s-  PleaseReadEnv       :: String -> (String -> EVM t s ()) -> Query t s---- | Execution could proceed down one of two branches-data RunBoth s where-  PleaseRunBoth    :: Expr EWord -> (Bool -> EVM Symbolic s ()) -> RunBoth s+data Query t where+  PleaseFetchContract :: Addr -> BaseState -> (Contract -> EVM t ()) -> Query t+  PleaseFetchSlot     :: Addr -> W256 -> (W256 -> EVM t ()) -> Query t+  PleaseAskSMT        :: Expr EWord -> [Prop] -> (BranchCondition -> EVM Symbolic ()) -> Query Symbolic+  PleaseGetSols       :: Expr EWord -> Int -> [Prop] -> (Maybe [W256] -> EVM Symbolic ()) -> Query Symbolic+  PleaseDoFFI         :: [String] -> Map String String -> (ByteString -> EVM t ()) -> Query t+  PleaseReadEnv       :: String -> (String -> EVM t ()) -> Query t --- | Execution could proceed down one of several branches-data RunAll s where-  PleaseRunAll    :: Expr EWord -> [Expr EWord] -> (Expr EWord -> EVM Symbolic s ()) -> RunAll s+data BranchContext where+  PleaseRunBoth :: (Bool -> EVM Symbolic ()) -> BranchContext+  PleaseRunAll  :: [Expr EWord] -> (Expr EWord -> EVM Symbolic ()) -> BranchContext  -- | The possible return values of a SMT query data BranchCondition = Case Bool | UnknownBranch   deriving Show -instance Show (Query t s) where+instance Show (Query t) where   showsPrec _ = \case     PleaseFetchContract addr base _ ->       (("<EVM.Query: fetch contract " ++ show addr ++ show base ++ ">") ++)@@ -648,24 +642,22 @@     PleaseReadEnv variable _ ->       (("<EVM.Query: read env: " ++ variable) ++) -instance Show (RunBoth s) where+instance Show (BranchContext) where   showsPrec _ = \case-    PleaseRunBoth _ _ ->+    PleaseRunBoth _ ->       (("<EVM.RunBoth: system running both paths") ++) -instance Show (RunAll s) where-  showsPrec _ = \case-    PleaseRunAll _ _ _ ->+    PleaseRunAll _ _ ->       (("<EVM.RunAll: system running all paths for Expr EWord-s") ++)  -- | The possible result states of a VM-data VMResult (t :: VMType) s where-  Unfinished :: PartialExec -> VMResult Symbolic s -- ^ Execution could not continue further-  VMFailure :: EvmError -> VMResult t s            -- ^ An operation failed-  VMSuccess :: (Expr Buf) -> VMResult t s          -- ^ Reached STOP, RETURN, or end-of-code-  HandleEffect :: (Effect t s) -> VMResult t s     -- ^ An effect must be handled for execution to continue+data VMResult (t :: VMType) where+  Unfinished :: PartialExec -> VMResult Symbolic -- ^ Execution could not continue further+  VMFailure :: EvmError -> VMResult t            -- ^ An operation failed+  VMSuccess :: (Expr Buf) -> VMResult t          -- ^ Reached STOP, RETURN, or end-of-code+  HandleEffect :: (Effect t) -> VMResult t     -- ^ An effect must be handled for execution to continue -deriving instance Show (VMResult t s)+deriving instance Show (VMResult t)   -- VM State ----------------------------------------------------------------------------------------@@ -677,10 +669,10 @@   Gas Concrete = Word64  -- | The state of a stepwise EVM execution-data VM (t :: VMType) s = VM-  { result         :: Maybe (VMResult t s)-  , state          :: FrameState t s-  , frames         :: [Frame t s]+data VM (t :: VMType) = VM+  { result         :: Maybe (VMResult t)+  , state          :: FrameState t+  , frames         :: [Frame t]   , env            :: Env   , block          :: Block   , tx             :: TxState@@ -712,11 +704,11 @@   }   deriving (Show, Generic) -deriving instance Show (VM Symbolic s)-deriving instance Show (VM Concrete s)+deriving instance Show (VM Symbolic)+deriving instance Show (VM Concrete)  -- | Alias for the type of e.g. @exec1@.-type EVM (t :: VMType) s a = StateT (VM t s) (ST s) a+type EVM (t :: VMType) a = StateT (VM t) (ST RealWorld) a  -- | The VM base state (i.e. should new contracts be created with abstract balance / storage?) data BaseState@@ -732,13 +724,13 @@   deriving (Show)  -- | An entry in the VM's "call/create stack"-data Frame (t :: VMType) s = Frame+data Frame (t :: VMType) = Frame   { context :: FrameContext-  , state   :: FrameState t s+  , state   :: FrameState t   } -deriving instance Show (Frame Symbolic s)-deriving instance Show (Frame Concrete s)+deriving instance Show (Frame Symbolic)+deriving instance Show (Frame Concrete)  -- | Call/create info data FrameContext@@ -774,13 +766,13 @@   deriving (Eq, Ord, Show)  -- | The "registers" of the VM along with memory and data stack-data FrameState (t :: VMType) s = FrameState+data FrameState (t :: VMType) = FrameState   { contract     :: Expr EAddr   , codeContract :: Expr EAddr   , code         :: ContractCode   , pc           :: {-# UNPACK #-} !Int -- program counter in BYTES (not ops). PUSH ops will increment pc by more than 1   , stack        :: [Expr EWord]-  , memory       :: Memory s+  , memory       :: Memory   , memorySize   :: Word64   , calldata     :: Expr Buf   , callvalue    :: Expr EWord@@ -793,18 +785,18 @@   }   deriving (Generic) -deriving instance Show (FrameState Symbolic s)-deriving instance Show (FrameState Concrete s)+deriving instance Show (FrameState Symbolic)+deriving instance Show (FrameState Concrete) -data Memory s-  = ConcreteMemory (MutableMemory s)+data Memory+  = ConcreteMemory (MutableMemory)   | SymbolicMemory !(Expr Buf) -instance Show (Memory s) where+instance Show (Memory) where   show (ConcreteMemory _) = "<can't show mutable memory>"   show (SymbolicMemory m) = show m -type MutableMemory s = STVector s Word8+type MutableMemory = STVector RealWorld Word8  -- | The state that spans a whole transaction data TxState = TxState@@ -857,18 +849,18 @@   deriving (Show, Eq, Ord)  class VMOps (t :: VMType) where-  burn' :: Gas t -> EVM t s () -> EVM t s ()+  burn' :: Gas t -> EVM t () -> EVM t ()   -- TODO: change to EvmWord t-  burnExp :: Expr EWord -> EVM t s () -> EVM t s ()-  burnSha3 :: Expr EWord -> EVM t s () -> EVM t s ()-  burnCalldatacopy :: Expr EWord -> EVM t s () -> EVM t s ()-  burnCodecopy :: Expr EWord -> EVM t s () -> EVM t s ()-  burnExtcodecopy :: Expr EAddr -> Expr EWord -> EVM t s () -> EVM t s ()-  burnReturndatacopy :: Expr EWord -> EVM t s () -> EVM t s ()-  burnLog :: Expr EWord -> Word8 -> EVM t s () -> EVM t s ()+  burnExp :: Expr EWord -> EVM t () -> EVM t ()+  burnSha3 :: Expr EWord -> EVM t () -> EVM t ()+  burnCalldatacopy :: Expr EWord -> EVM t () -> EVM t ()+  burnCodecopy :: Expr EWord -> EVM t () -> EVM t ()+  burnExtcodecopy :: Expr EAddr -> Expr EWord -> EVM t () -> EVM t ()+  burnReturndatacopy :: Expr EWord -> EVM t () -> EVM t ()+  burnLog :: Expr EWord -> Word8 -> EVM t () -> EVM t ()    initialGas :: Gas t-  ensureGas :: Word64 -> EVM t s () -> EVM t s ()+  ensureGas :: Word64 -> EVM t () -> EVM t ()   -- TODO: change to EvmWord t   gasTryFrom :: Expr EWord -> Either () (Gas t) @@ -877,20 +869,20 @@    costOfCall     :: FeeSchedule Word64 -> Bool -> Expr EWord -> Gas t -> Gas t -> Expr EAddr-    -> (Word64 -> Word64 -> EVM t s ()) -> EVM t s ()+    -> (Word64 -> Word64 -> EVM t ()) -> EVM t () -  reclaimRemainingGasAllowance :: VM t s -> EVM t s ()-  payRefunds :: EVM t s ()-  pushGas :: EVM t s ()+  reclaimRemainingGasAllowance :: VM t -> EVM t ()+  payRefunds :: EVM t ()+  pushGas :: EVM t ()   enoughGas :: Word64 -> Gas t -> Bool   subGas :: Gas t -> Word64 -> Gas t   toGas :: Word64 -> Gas t -  whenSymbolicElse :: EVM t s a -> EVM t s a -> EVM t s a+  whenSymbolicElse :: EVM t a -> EVM t a -> EVM t a -  partial :: PartialExec -> EVM t s ()-  branch :: Maybe Int -> Expr EWord -> (Bool -> EVM t s ()) -> EVM t s ()-  manySolutions :: Maybe Int -> Expr EWord -> Int -> (Maybe W256 -> EVM t s ()) -> EVM t s ()+  partial :: PartialExec -> EVM t ()+  branch :: Maybe Int -> Expr EWord -> (Bool -> EVM t ()) -> EVM t ()+  manySolutions :: Maybe Int -> Expr EWord -> Int -> (Maybe W256 -> EVM t ()) -> EVM t ()  -- Bytecode Representations ------------------------------------------------------------------------ @@ -1237,7 +1229,9 @@         T.decodeUtf8 . toStrict . toLazyByteString . byteStringHex  instance JSON.FromJSON ByteStringS where-  parseJSON (JSON.String x) = case BS16.decodeBase16Untyped (T.encodeUtf8 x) of+  parseJSON (JSON.String x) =+    let x' = if "0x" `T.isPrefixOf` x then T.drop 2 x else x in+    case BS16.decodeBase16Untyped (T.encodeUtf8 x') of                                 Left _ -> mzero                                 Right bs -> pure (ByteStringS bs)   parseJSON _ = mzero

@@ -15,7 +15,7 @@ import EVM.Fetch qualified as Fetch import EVM.Format import EVM.Solidity-import EVM.SymExec (defaultVeriOpts, symCalldata, verify, extractCex, prettyCalldata, calldataFromCex, panicMsg, VeriOpts(..), flattenExpr, groupIssues, groupPartials, IterConfig(..), defaultIterConf, LoopHeuristic)+import EVM.SymExec (defaultVeriOpts, symCalldata, verify, verifyResult, extractCex, prettyCalldata, calldataFromCex, panicMsg, VeriOpts(..), groupIssues, groupPartials, IterConfig(..), LoopHeuristic, defaultIterConf) import EVM.Types import EVM.Transaction (initTx) import EVM.Stepper (Stepper)@@ -50,7 +50,7 @@ import Data.Vector qualified as V import Data.Char (ord) -data UnitTestOptions s = UnitTestOptions+data UnitTestOptions = UnitTestOptions   { rpcInfo       :: Fetch.RpcInfo   , solvers       :: SolverGroup   , sess          :: Fetch.Session@@ -100,18 +100,18 @@ type ABIMethod = Text  -- | Used in various places for dumping traces-writeTraceDapp :: App m => DappInfo -> VM t RealWorld -> m ()+writeTraceDapp :: App m => DappInfo -> VM t -> m () writeTraceDapp dapp vm = do   conf <- readConfig   liftIO $ when conf.dumpTrace $ Text.writeFile "VM.trace" (showTraceTree dapp vm) -writeTrace :: App m => VM t RealWorld -> m ()+writeTrace :: App m => VM t -> m () writeTrace vm = do   conf <- readConfig   liftIO $ when conf.dumpTrace $ writeFile "VM.trace" (show $ traceForest vm)  -- | Generate VeriOpts from UnitTestOptions-makeVeriOpts :: UnitTestOptions s -> VeriOpts+makeVeriOpts :: UnitTestOptions -> VeriOpts makeVeriOpts opts =    defaultVeriOpts { iterConf = defaultIterConf {maxIter = opts.maxIter, askSmtIters = opts.askSmtIters, loopHeuristic = opts.loopHeuristic}                    , rpcInfo = opts.rpcInfo@@ -119,7 +119,7 @@  -- | Top level CLI endpoint for hevm test -- | Returns tuple of (No Cex, No warnings)-unitTest :: App m => UnitTestOptions RealWorld -> BuildOutput -> m (Bool, Bool)+unitTest :: App m => UnitTestOptions -> BuildOutput -> m (Bool, Bool) unitTest opts bo@(BuildOutput (Contracts cs) _) = do   let unitTestContrs = findUnitTests opts.prefix opts.match $ Map.elems cs   conf <- readConfig@@ -134,7 +134,7 @@  -- | Assuming a constructor is loaded, this stepper will run the constructor -- to create the test contract, give it an initial balance, and run `setUp()'.-initializeUnitTest :: UnitTestOptions s -> SolcContract -> Stepper Concrete s ()+initializeUnitTest :: UnitTestOptions -> SolcContract -> Stepper Concrete () initializeUnitTest opts theContract = do   let addr = opts.testParams.address @@ -164,9 +164,9 @@     _ -> popTrace  validateCex :: forall m . App m-  => UnitTestOptions RealWorld-  -> Fetch.Fetcher Concrete m RealWorld-  -> VM Concrete RealWorld+  => UnitTestOptions+  -> Fetch.Fetcher Concrete m+  -> VM Concrete   -> ReproducibleCex   -> m Bool validateCex uTestOpts fetcher vm repCex = do@@ -203,7 +203,7 @@ -- Returns tuple of (No Cex, No warnings) runUnitTestContract   :: App m-  => UnitTestOptions RealWorld+  => UnitTestOptions   -> BuildOutput   -> (Text, [Sig])   -> m [(Bool, Bool)]@@ -216,7 +216,7 @@     Nothing -> internalError $ "Contract " ++ unpack name ++ " not found"     Just solcContr -> do       -- Construct the initial VM and begin the contract's constructor-      vm0 :: VM Concrete RealWorld <- liftIO $ stToIO $ initialUnitTestVm opts solcContr+      vm0 :: VM Concrete <- liftIO $ stToIO $ initialUnitTestVm opts solcContr       vm1 <- Stepper.interpret (Fetch.oracle solvers (Just sess) rpcInfo) vm0 $ do         Stepper.enter name         initializeUnitTest opts solcContr@@ -233,7 +233,7 @@           forM testSigs $ \s -> symRun opts vm1 s solcContr buildOut.sources         _ -> internalError "setUp() did not end with a result" -dsTestFailedSym :: Map (Expr 'EAddr) (Expr EContract) -> VM s t -> Prop+dsTestFailedSym :: Map (Expr 'EAddr) (Expr EContract) -> VM t -> Prop dsTestFailedSym store vm =   let testContract = fromMaybe (internalError "test contract not found in state") (Map.lookup vm.state.contract store)   in case Map.lookup cheatCode store of@@ -247,7 +247,7 @@  -- Define the thread spawner for symbolic tests -- Returns tuple of (No Cex, No warnings)-symRun :: App m => UnitTestOptions RealWorld -> VM Concrete RealWorld -> Sig -> SolcContract -> SourceCache -> m (Bool, Bool)+symRun :: forall m . App m => UnitTestOptions -> VM Concrete -> Sig -> SolcContract -> SourceCache -> m (Bool, Bool) symRun opts@UnitTestOptions{..} vm sig@(Sig testName types) solcContr sourceCache = do     let cs = callSig sig     liftIO $ putStrLn $ "\x1b[96m[RUNNING]\x1b[0m " <> Text.unpack cs@@ -285,33 +285,29 @@      -- check postconditions against vm     let fetcherSym = Fetch.oracle solvers (Just sess) rpcInfo-    (end, results) <- verify solvers fetcherSym (makeVeriOpts opts) (symbolify vm') (Just postcondition)-    let ends = flattenExpr end+    (ends, results) <- verify solvers fetcherSym (makeVeriOpts opts) (symbolify vm') postcondition (Just $ cexHandler cd fetcherConc)     conf <- readConfig-    when conf.debug $ liftIO $ forM_ (filter Expr.isFailure ends) $ \case-      (Failure _ _ a) ->  putStrLn $ "   -> debug of func: " <> Text.unpack testName <> " Failure at the end of expr: " <> show a;-      _ -> internalError "cannot be, filtered for failure"+    when (conf.debug) $ liftIO $ do+      putStrLn $ "   \x1b[94m[EXPLORATION COMPLETE]\x1b[0m " <> Text.unpack testName <> " -- explored " <> show (length ends) <> " paths."+      when (conf.verb >= 2) $ do+        forM_ (filter Expr.isFailure ends) $ \case+          (Failure _ _ a) ->  putStrLn $ "   -> debug of func: " <> Text.unpack testName <> " Failure at the end of expr: " <> show a;+          _ -> internalError "cannot be, filtered for failure"      -- display results+    when (conf.debug && conf.verb >=2) $ liftIO $ do+      putStrLn $ "Collected END-s:\n" <> prettyvmresults ends+      putStrLn $ "Collected verification results: " <> show results     let warnings = any Expr.isPartial ends || any isUnknown results || any isError results     let allReverts = not . (any Expr.isSuccess) $ ends     let unexpectedAllRevert = allReverts && not shouldFail-    when conf.debug $ liftIO $ putStrLn $ "symRun -- (cex,warnings,unexpectedAllRevert): " <> show (any isCex results, warnings, unexpectedAllRevert)+    when conf.debug $ liftIO $ putStrLn $ "   symRun -- (cex,warnings,unexpectedAllRevert): " <> show (any isCex results, warnings, unexpectedAllRevert)     txtResult <- case (any isCex results, warnings, unexpectedAllRevert) of       (False, False, False) -> do         -- happy case         pure $ "   \x1b[32m[PASS]\x1b[0m " <> Text.unpack testName <> "\n"       (True, _, _) -> do-        -- there are counterexamples (and maybe other things, but Cex is most important)-        let x = mapMaybe extractCex results-        failsToRepro <- getReproFailures (Sig testName types) (fst cd) (map snd x)---        validation <- mapM (traverse $ validateCex opts fetcherConc vm) failsToRepro-        when conf.debug $ liftIO $ putStrLn $ "Cex reproduction runs' results are: " <> show validation-        let toPrintData = zipWith (\(a, b) c -> (a, b, c)) x validation-        txtFails <- symFailure opts testName (fst cd) types toPrintData-        pure $ "   \x1b[31m[FAIL]\x1b[0m " <> Text.unpack testName <> "\n" <> Text.unpack txtFails+        pure $ "   \x1b[31m[FAIL]\x1b[0m " <> Text.unpack testName <> "\n"       (_, True, _) -> do         -- There are errors/unknowns/partials, we fail them         pure $ "   \x1b[31m[FAIL]\x1b[0m " <> Text.unpack testName <> "\n"@@ -327,6 +323,22 @@     liftIO $ printWarnings warnData ends results $ "the test " <> Text.unpack testName     pure (not (any isCex results), not (warnings || unexpectedAllRevert))     where+      cexHandler :: (Expr 'Buf, [Prop])+        -> Fetch.Fetcher Concrete m+        -> VM 'Symbolic+        -> SMTResult+        -> Expr 'End+        -> m ()+      cexHandler cd fetcherConc preState smtRes end = do+          let verifRes = snd $ verifyResult preState (smtRes, end)+          case extractCex verifRes of+            Nothing -> internalError "cexHandler: expected a cex"+            Just (cexEnd, smtCex) -> do+              failsToRepro <- getReproFailure (Sig testName types) (fst cd) smtCex+              validation <- traverse (validateCex opts fetcherConc vm) failsToRepro+              txtFail <- symFailure opts testName (fst cd) types (cexEnd, smtCex, validation)+              liftIO $ Text.putStr txtFail+       -- The offset of the text is: the selector (4B), the offset value (aligned to 32B), and the length of the string (aligned to 32B)       txtOffset = 4+32+32       symbolicFail :: Expr Buf -> Prop@@ -352,7 +364,7 @@               lhs = LitByte (c2w a)               rhs = Expr.readByte (Lit (fromIntegral n)) b ---printWarnings :: Maybe (WarningData s t) -> GetUnknownStr b => [Expr 'End] -> [ProofResult a b] -> String -> IO ()+printWarnings :: Maybe (WarningData t) -> GetUnknownStr b => [Expr 'End] -> [ProofResult a b] -> String -> IO () printWarnings warnData e results testName = do   when (any isUnknown results || any isError results || any Expr.isPartial e) $ do     putStrLn $ "   \x1b[33m[WARNING]\x1b[0m hevm was only able to partially explore " <> testName <> " due to: ";@@ -361,20 +373,20 @@     forM_ (groupPartials warnData e) $ \(num, str) -> putStrLn $ "      " <> show num <> "x -> " <> str   putStrLn "" -getReproFailures :: App m => Sig -> Expr Buf -> [SMTCex] -> m [Err ReproducibleCex]-getReproFailures sig@(Sig testName _) cd cexes = do-  fullCDs <- mapM (\cex -> calldataFromCex cex cd sig) cexes-  pure $ map (\case+getReproFailure :: App m => Sig -> Expr Buf -> SMTCex -> m (Err ReproducibleCex)+getReproFailure sig@(Sig testName _) cd cex = do+  bs <- calldataFromCex cex cd sig+  pure $ (\case     Left err -> Left err-    Right fullCD -> Right $ ReproducibleCex { testName = testName, callData = fullCD}) fullCDs+    Right fullCD -> Right $ ReproducibleCex { testName = testName, callData = fullCD}) bs  symFailure :: App m =>-  UnitTestOptions RealWorld -> Text -> Expr Buf -> [AbiType] ->-  [(Expr End, SMTCex, Err Bool)] ->+  UnitTestOptions -> Text -> Expr Buf -> [AbiType] ->+  (Expr End, SMTCex, Err Bool) ->   m Text-symFailure UnitTestOptions {..} testName cd types fails = do+symFailure UnitTestOptions {..} testName cd types failure = do   conf <- readConfig-  pure $ mconcat [ Text.concat $ indentLines 3 . mkMsg conf <$> fails ]+  pure $ mconcat [ indentLines 3 $ mkMsg conf failure ]   where       showRes = \case         Success _ _ _ _ -> if "proveFail" `isPrefixOf` testName@@ -403,7 +415,7 @@   let p = Text.replicate n " "   in Text.unlines (map (p <>) (Text.lines s)) -failOutput :: App m => VM t s -> UnitTestOptions s -> Text -> m Text+failOutput :: App m => VM t -> UnitTestOptions -> Text -> m Text failOutput vm UnitTestOptions { .. } testName = do   conf <- readConfig   let ?context = DappContext { info = dapp@@ -490,14 +502,14 @@                   _ -> Nothing               _ -> Just "<symbolic decimal>" -abiCall :: VMOps t => TestVMParams -> Either (Text, AbiValue) ByteString -> EVM t s ()+abiCall :: VMOps t => TestVMParams -> Either (Text, AbiValue) ByteString -> EVM t () abiCall params args =   let cd = case args of         Left (sig, args') -> abiMethod sig args'         Right b -> b   in makeTxCall params (ConcreteBuf cd, []) -makeTxCall :: VMOps t => TestVMParams -> (Expr Buf, [Prop]) -> EVM t s ()+makeTxCall :: VMOps t => TestVMParams -> (Expr Buf, [Prop]) -> EVM t () makeTxCall params (cd, cdProps) = do   resetState   assign (#tx % #isCreate) False@@ -512,7 +524,7 @@   vm <- get   put $ initTx vm -initialUnitTestVm :: VMOps t => UnitTestOptions s -> SolcContract -> ST s (VM t s)+initialUnitTestVm :: VMOps t => UnitTestOptions -> SolcContract -> ST RealWorld (VM t) initialUnitTestVm (UnitTestOptions {..}) theContract = do   vm <- makeVm $ VMOpts            { contract = initialContract (InitCode theContract.creationCode mempty)@@ -553,15 +565,7 @@   (miner,ts,blockNum,ran,limit,base) <- case rpcInfo.blockNumURL of     Nothing -> pure (SymAddr "miner", Lit 0, Lit 0, 0, 0, 0)     Just (Fetch.Latest, url) -> fetch Fetch.Latest url-    Just (Fetch.BlockNumber block, url) -> case rpcInfo.mockBlock >>= Map.lookup block of-        Nothing -> fetch (Fetch.BlockNumber block) url-        Just b ->pure (b.coinbase-                      , b.timestamp-                      , b.number-                      , b.prevRandao-                      , b.gaslimit-                      , b.baseFee-                      )+    Just (Fetch.BlockNumber block, url) -> fetch (Fetch.BlockNumber block) url   let ts' = fromMaybe (internalError "received unexpected symbolic timestamp via rpc") (maybeLitWordSimp ts)   pure $ TestVMParams     -- TODO: make this symbolic! It needs some tweaking to the way that our

@@ -1,43 +1,36 @@-module EVM.Test.BlockchainTests where+module EVM.Test.BlockchainTests (prepareTests, problematicTests, Case, vmForCase, checkExpectation, allTestCases) where  import EVM (initialContract, makeVm, setEIP4788Storage) import EVM.Concrete qualified as EVM+import EVM.Effects+import EVM.Expr (maybeLitAddrSimp) import EVM.FeeSchedule (feeSchedule) import EVM.Fetch qualified-import EVM.Format (hexText)+import EVM.Solvers (withSolvers, Solver(..)) import EVM.Stepper qualified import EVM.Transaction-import EVM.UnitTest (writeTrace) import EVM.Types hiding (Block, Case, Env)-import EVM.Expr (maybeLitWordSimp, maybeLitAddrSimp)-import EVM.Tracing qualified as Tracing-import EVM.Test.FuzzSymExec (compareTraces, EVMToolTraceOutput(..), decodeTraceOutputHelper)+import EVM.UnitTest (writeTrace)  import Optics.Core import Control.Arrow ((***), (&&&)) import Control.Monad-import Control.Monad.ST (RealWorld, stToIO)+import Control.Monad.ST (stToIO) import Control.Monad.State.Strict import Control.Monad.IO.Unlift-import EVM.Effects import Data.Aeson ((.:), (.:?), FromJSON (..)) import Data.Aeson qualified as JSON import Data.Aeson.Types qualified as JSON import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as Lazy-import Data.ByteString.Lazy qualified as LazyByteString-import Data.List (isInfixOf, isPrefixOf) import Data.Map (Map) import Data.Map qualified as Map import Data.Maybe (fromJust, fromMaybe, isNothing, isJust) import Data.Word (Word64)-import System.Environment (lookupEnv, getEnv)+import GHC.Generics (Generic)+import System.Environment (getEnv) import System.FilePath.Find qualified as Find import System.FilePath.Posix (makeRelative, (</>))-import System.IO (hPutStr, hClose)-import System.IO.Temp (withSystemTempFile)-import System.Process (readProcessWithExitCode)-import GHC.IO.Exception (ExitCode(ExitSuccess)) import Witch (into, unsafeInto) import Witherable (Filterable, catMaybes) @@ -59,70 +52,96 @@   , beaconRoot  :: W256   } deriving Show +data BlockchainContract = BlockchainContract+  { code    :: ByteStringS+  , nonce   :: W64+  , balance :: W256+  , storage :: Map W256 W256+  } deriving (Eq, Show, Generic)++instance FromJSON BlockchainContract++asBCContract :: Contract -> BlockchainContract+asBCContract c = BlockchainContract code nonce balance storage+  where+    code = case c.code of+      (RuntimeCode (ConcreteRuntimeCode bs)) -> ByteStringS bs+      _ -> internalError "Expected concrete contract"+    nonce = fromJust c.nonce+    balance = forceLit (c.balance)+    storage = fromConcrete c.storage++makeContract :: BlockchainContract -> Contract+makeContract (BlockchainContract (ByteStringS code) nonce balance storage) =+    initialContract (RuntimeCode (ConcreteRuntimeCode code))+      & set #nonce    (Just nonce)+      & set #balance  (Lit balance)+      & set #storage (ConcreteStore storage)+      & set #origStorage (ConcreteStore storage)++type BlockchainContracts = Map Addr BlockchainContract+ data Case = Case   { vmOpts      :: VMOpts Concrete-  , checkContracts  :: Map Addr Contract-  , testExpectation :: Map Addr Contract+  , checkContracts  :: BlockchainContracts+  , testExpectation :: BlockchainContracts   } deriving Show  data BlockchainCase = BlockchainCase   { blocks  :: [Block]-  , pre     :: Map Addr Contract-  , post    :: Map Addr Contract+  , pre     :: BlockchainContracts+  , post    :: BlockchainContracts   , network :: String   } deriving Show --testEnv :: Env-testEnv = Env { config = defaultConfig }--main :: IO ()-main = do-  tests <- runEnv testEnv prepareTests-  defaultMain tests- prepareTests :: App m => m TestTree prepareTests = do-  repo <- liftIO $ getEnv "HEVM_ETHEREUM_TESTS_REPO"-  let testsDir = "BlockchainTests/GeneralStateTests"-  let dir = repo </> testsDir-  jsonFiles <- liftIO $ Find.find Find.always (Find.extension Find.==? ".json") dir-  liftIO $ putStrLn $ "Loading and parsing json files from ethereum-tests from " <> show dir-  isCI <- liftIO $ isJust <$> lookupEnv "CI"-  let problematicTests = if isCI then commonProblematicTests <> ciProblematicTests else commonProblematicTests-  let ignoredFiles = if isCI then ciIgnoredFiles else []-  groups <- mapM (\f -> testGroup (makeRelative repo f) <$> (if any (`isInfixOf` f) ignoredFiles then pure [] else testsFromFile f problematicTests)) jsonFiles+  rootDir <- liftIO rootDirectory+  liftIO $ putStrLn $ "Loading and parsing json files from ethereum-tests from " <> show rootDir+  cases <- liftIO allTestCases+  groups <- forM (Map.toList cases) (\(f, subtests) -> testGroup (makeRelative rootDir f) <$> (process subtests))   liftIO $ putStrLn "Loaded."   pure $ testGroup "ethereum-tests" groups--testsFromFile-  :: forall m . App m-  => String -> Map String (TestTree -> TestTree) -> m [TestTree]-testsFromFile fname problematicTests = do-  fContents <- liftIO $ LazyByteString.readFile fname-  let parsed = parseBCSuite fContents-  liftIO $ putStrLn $ "Parsed " <> fname-  case parsed of-    Left "No cases to check." -> pure []-    Left _err -> pure []-    Right allTests -> mapM runTest $ Map.toList allTests   where-    runTest :: (String, Case) -> m TestTree+    process :: forall m . App m => (Map String Case) -> m [TestTree]+    process tests = forM (Map.toList tests) runTest++    runTest :: App m => (String, Case) -> m TestTree     runTest (name, x) = do-      exec <- toIO $ runVMTest x+      let fetcher q = withSolvers Z3 0 1 (Just 0) $ \s -> EVM.Fetch.noRpcFetcher s q+      exec <- toIO $ runVMTest fetcher x       pure $ testCase' name exec     testCase' :: String -> Assertion -> TestTree     testCase' name assertion =       case Map.lookup name problematicTests of-        Just f -> f (testCase name (liftIO assertion))-        Nothing -> testCase name (liftIO assertion)+        Just f -> f (testCase name assertion)+        Nothing -> testCase name assertion --- CI has issues with some heaver tests, disable in bulk-ciIgnoredFiles :: [String]-ciIgnoredFiles = []+rootDirectory :: IO FilePath+rootDirectory = do+  repo <- getEnv "HEVM_ETHEREUM_TESTS_REPO"+  let testsDir = "BlockchainTests/GeneralStateTests"+  pure $ repo </> testsDir -commonProblematicTests :: Map String (TestTree -> TestTree)-commonProblematicTests = Map.fromList+collectJsonFiles :: FilePath -> IO [FilePath]+collectJsonFiles rootDir = Find.find Find.always (Find.extension Find.==? ".json") rootDir++allTestCases :: IO (Map FilePath (Map String Case))+allTestCases = do+  root <- rootDirectory+  jsons <- collectJsonFiles root+  cases <- forM jsons (\fname -> do+      fContents <- BS.readFile fname+      let parsed = case (parseBCSuite (Lazy.fromStrict fContents)) of+                    Left "No cases to check." -> mempty+                    Left _err -> mempty -- TODO: This should be an error+                    Right allTests -> allTests+      pure (fname, parsed)+    )+  pure $ Map.fromList cases++problematicTests :: Map String (TestTree -> TestTree)+problematicTests = Map.fromList   [ ("loopMul_d0g0v0_Cancun", ignoreTestBecause "hevm is too slow")   , ("loopMul_d1g0v0_Cancun", ignoreTestBecause "hevm is too slow")   , ("loopMul_d2g0v0_Cancun", ignoreTestBecause "hevm is too slow")@@ -159,71 +178,71 @@   , ("failed_tx_xcf416c53_d0g0v0_Cancun", ignoreTestBecause "EIP-4844 not implemented")   ] -ciProblematicTests :: Map String (TestTree -> TestTree)-ciProblematicTests = Map.fromList-  [ ("Return50000_d0g1v0_Cancun", ignoreTest)-  , ("Return50000_2_d0g1v0_Cancun", ignoreTest)-  , ("randomStatetest177_d0g0v0_Cancun", ignoreTest)-  , ("static_Call50000_d0g0v0_Cancun", ignoreTest)-  , ("static_Call50000_d1g0v0_Cancun", ignoreTest)-  , ("static_Call50000bytesContract50_1_d1g0v0_Cancun", ignoreTest)-  , ("static_Call50000bytesContract50_2_d1g0v0_Cancun", ignoreTest)-  , ("static_Return50000_2_d0g0v0_Cancun", ignoreTest)-  , ("loopExp_d10g0v0_Cancun", ignoreTest)-  , ("loopExp_d11g0v0_Cancun", ignoreTest)-  , ("loopExp_d12g0v0_Cancun", ignoreTest)-  , ("loopExp_d13g0v0_Cancun", ignoreTest)-  , ("loopExp_d14g0v0_Cancun", ignoreTest)-  , ("loopExp_d8g0v0_Cancun", ignoreTest)-  , ("loopExp_d9g0v0_Cancun", ignoreTest)-  ] -runVMTest :: App m => Case -> m ()-runVMTest x = do+runVMTest :: App m => EVM.Fetch.Fetcher Concrete m -> Case -> m ()+runVMTest fetcher x = do   -- traceVsGeth fname name x   vm0 <- liftIO $ vmForCase x-  result <- EVM.Stepper.interpret (EVM.Fetch.zero 0 (Just 0)) vm0 EVM.Stepper.runFully+  result <- EVM.Stepper.interpret fetcher vm0 EVM.Stepper.runFully   writeTrace result-  maybeReason <- checkExpectation x result-  liftIO $ forM_ maybeReason assertFailure+  let maybeReason = checkExpectation x result+  liftIO $ forM_ maybeReason (liftIO >=> assertFailure) +checkExpectation :: Case -> VM Concrete -> Maybe (IO String)+checkExpectation x vm = let (okState, okBal, okNonce, okStor, okCode) = checkExpectedContracts vm x.testExpectation in+  if okState then Nothing else Just $ checkStateFail x (okBal, okNonce, okStor, okCode)+  where+    checkExpectedContracts :: VM Concrete -> BlockchainContracts -> (Bool, Bool, Bool, Bool, Bool)+    checkExpectedContracts vm' expected =+      let cs = fmap (asBCContract . clearZeroStorage) $ forceConcreteAddrs vm'.env.contracts+      in ( (expected ~= cs)+        , (clearBalance <$> expected) ~= (clearBalance <$> cs)+        , (clearNonce   <$> expected) ~= (clearNonce   <$> cs)+        , (clearStorage <$> expected) ~= (clearStorage <$> cs)+        , (clearCode    <$> expected) ~= (clearCode    <$> cs)+        ) --- | Run a vm test and output a geth style per opcode trace-traceVMTest :: App m => Case -> m [Tracing.VMTraceStep]-traceVMTest x = do-  vm0 <- liftIO $ vmForCase x-  (_, (_, ts)) <- runStateT (Tracing.interpretWithTrace (EVM.Fetch.zero 0 (Just 0)) EVM.Stepper.runFully) (vm0, [])-  pure ts+    -- quotient account state by nullness+    (~=) :: BlockchainContracts -> BlockchainContracts -> Bool+    (~=) cs1 cs2 =+        let nullAccount = asBCContract $ EVM.initialContract (RuntimeCode (ConcreteRuntimeCode ""))+            padNewAccounts cs ks = Map.union cs $ Map.fromList [(k, nullAccount) | k <- ks]+            padded_cs1 = padNewAccounts cs1 (Map.keys cs2)+            padded_cs2 = padNewAccounts cs2 (Map.keys cs1)+        in and $ zipWith (==) (Map.elems padded_cs1) (Map.elems padded_cs2)+    +    checkStateFail :: Case -> (Bool, Bool, Bool, Bool) -> IO String+    checkStateFail x' (okBal, okNonce, okData, okCode) = do+      let+        printContracts :: BlockchainContracts -> IO ()+        printContracts cs = putStrLn $ Map.foldrWithKey (\k c acc ->+          acc ++ "-->" <> show k ++ " : "+                      ++ (show c.nonce) ++ " "+                      ++ (show c.balance) ++ " "+                      ++ (show c.storage)+            ++ "\n") "" cs --- | given a path to a test file, a test case from within that file, and a trace from geth from running that test, compare the traces and show where we differ--- This would need a few tweaks to geth to make this really usable (i.e. evm statetest show allow running a single test from within the test file).-traceVsGeth :: App m => String -> String -> Case -> m ()-traceVsGeth fname name x = do-  liftIO $ putStrLn "-> Running `evm --json blocktest` tool."-  (exitCode, evmtoolStdout, evmtoolStderr) <- liftIO $ readProcessWithExitCode "evm" [-                               "--json"-                               , "blocktest"-                               , "--run", name-                               , fname-                               ] ""-  when (exitCode /= ExitSuccess) $ liftIO $ do-    putStrLn $ "evmtool exited with code " <> show exitCode-    putStrLn $ "evmtool stderr output:" <> show evmtoolStderr-    putStrLn $ "evmtool stdout output:" <> show evmtoolStdout-  hevm <- traceVMTest x-  decodedContents <- liftIO $ withSystemTempFile "trace.jsonl" $ \traceFile hdl -> do-    hPutStr hdl $ filterInfoLines evmtoolStderr-    hClose hdl-    decodeTraceOutputHelper traceFile-  let EVMToolTraceOutput ts _ = fromJust decodedContents-  liftIO $ putStrLn "Comparing traces."-  _ <- liftIO $ compareTraces hevm ts-  pure ()+        reason = map fst (filter (not . snd)+            [ ("bad-state",       okBal   || okNonce || okData  || okCode)+            , ("bad-balance", not okBal   || okNonce || okData  || okCode)+            , ("bad-nonce",   not okNonce || okBal   || okData  || okCode)+            , ("bad-storage", not okData  || okBal   || okNonce || okCode)+            , ("bad-code",    not okCode  || okBal   || okNonce || okData)+            ])+        check = x'.checkContracts+        expected = x'.testExpectation+        actual = fmap (asBCContract . clearZeroStorage) $ forceConcreteAddrs vm.env.contracts -  where-    filterInfoLines :: String -> String-    filterInfoLines input = unlines $ filter (not . isPrefixOf "INFO") (lines input)+      putStrLn $ "-> Failing because of: " <> (unwords reason)+      putStrLn "-> Pre balance/state: "+      printContracts check+      putStrLn "-> Expected balance/state: "+      printContracts expected+      putStrLn "-> Actual balance/state: "+      printContracts actual+      pure (unwords reason) + splitEithers :: (Filterable f) => f (Either a b) -> (f a, f b) splitEithers =   (catMaybes *** catMaybes)@@ -234,115 +253,23 @@ fromConcrete (ConcreteStore s) = s fromConcrete s = internalError $ "unexpected abstract store: " <> show s -checkStateFail :: Case -> VM Concrete RealWorld -> (Bool, Bool, Bool, Bool) -> IO String-checkStateFail x vm (okBal, okNonce, okData, okCode) = do-  let-    printContracts :: Map Addr Contract -> IO ()-    printContracts cs = putStrLn $ Map.foldrWithKey (\k c acc ->-      acc ++ "-->" <> show k ++ " : "-                   ++ (show $ fromJust c.nonce) ++ " "-                   ++ (show $ fromJust $ maybeLitWordSimp c.balance) ++ " "-                   ++ (show $ fromConcrete c.storage)-                   ++ (show $ fromConcrete c.tStorage)-        ++ "\n") "" cs--    reason = map fst (filter (not . snd)-        [ ("bad-state",       okBal   || okNonce || okData  || okCode)-        , ("bad-balance", not okBal   || okNonce || okData  || okCode)-        , ("bad-nonce",   not okNonce || okBal   || okData  || okCode)-        , ("bad-storage", not okData  || okBal   || okNonce || okCode)-        , ("bad-code",    not okCode  || okBal   || okNonce || okData)-        ])-    check = x.checkContracts-    expected = x.testExpectation-    actual = fmap (clearZeroStorage . clearOrigStorage) $ forceConcreteAddrs vm.env.contracts--  putStrLn $ "-> Failing because of: " <> (unwords reason)-  putStrLn "-> Pre balance/state: "-  printContracts check-  putStrLn "-> Expected balance/state: "-  printContracts expected-  putStrLn "-> Actual balance/state: "-  printContracts actual-  pure (unwords reason)--checkExpectation-  :: App m-  => Case -> VM Concrete RealWorld -> m (Maybe String)-checkExpectation x vm = do-  let expectation = x.testExpectation-      (okState, okBal, okNonce, okStor, okCode) = checkExpectedContracts vm expectation-  if okState then do-    pure Nothing-  else liftIO $ Just <$> checkStateFail x vm (okBal, okNonce, okStor, okCode)---- quotient account state by nullness-(~=) :: Map Addr Contract -> Map Addr Contract -> Bool-(~=) cs1 cs2 =-    let nullAccount = EVM.initialContract (RuntimeCode (ConcreteRuntimeCode ""))-        padNewAccounts cs ks = Map.union cs $ Map.fromList [(k, nullAccount) | k <- ks]-        padded_cs1 = padNewAccounts cs1 (Map.keys cs2)-        padded_cs2 = padNewAccounts cs2 (Map.keys cs1)-    in and $ zipWith (===) (Map.elems padded_cs1) (Map.elems padded_cs2)--(===) :: Contract -> Contract -> Bool-c1 === c2 =-  codeEqual && storageEqual && c1.balance == c2.balance && c1.nonce == c2.nonce-  where-    storageEqual = c1.storage == c2.storage-    codeEqual = case (c1.code, c2.code) of-      (RuntimeCode a', RuntimeCode b') -> a' == b'-      codes -> internalError ("unexpected code: \n" <> show codes)--checkExpectedContracts :: VM Concrete RealWorld -> Map Addr Contract -> (Bool, Bool, Bool, Bool, Bool)-checkExpectedContracts vm expected =-  let cs = fmap (clearZeroStorage . clearOrigStorage) $ forceConcreteAddrs vm.env.contracts-  in ( (expected ~= cs)-     , (clearBalance <$> expected) ~= (clearBalance <$> cs)-     , (clearNonce   <$> expected) ~= (clearNonce   <$> cs)-     , (clearStorage <$> expected) ~= (clearStorage <$> cs)-     , (clearCode    <$> expected) ~= (clearCode    <$> cs)-     )--clearOrigStorage :: Contract -> Contract-clearOrigStorage = set #origStorage (ConcreteStore mempty)- clearZeroStorage :: Contract -> Contract clearZeroStorage c = case c.storage of   ConcreteStore m -> let store = Map.filter (/= 0) m                      in set #storage (ConcreteStore store) c   _ -> internalError "Internal Error: unexpected abstract store" -clearStorage :: Contract -> Contract-clearStorage c = c { storage = clear c.storage, tStorage = clear c.tStorage }-  where-    clear :: Expr Storage -> Expr Storage-    clear (ConcreteStore _) = ConcreteStore mempty-    clear _ = internalError "Internal Error: unexpected abstract store"--clearBalance :: Contract -> Contract-clearBalance c = set #balance (Lit 0) c--clearNonce :: Contract -> Contract-clearNonce c = set #nonce (Just 0) c+clearStorage :: BlockchainContract -> BlockchainContract+clearStorage c = c { storage = mempty} -clearCode :: Contract -> Contract-clearCode c = set #code (RuntimeCode (ConcreteRuntimeCode "")) c+clearBalance :: BlockchainContract -> BlockchainContract+clearBalance c = c {balance = 0} -instance FromJSON Contract where-  parseJSON (JSON.Object v) = do-    code <- (RuntimeCode . ConcreteRuntimeCode <$> (hexText <$> v .: "code"))-    storage <- v .: "storage"-    balance <- v .: "balance"-    nonce   <- v .: "nonce"-    pure $ EVM.initialContract code-             & #balance .~ (Lit balance)-             & #nonce   ?~ nonce-             & #storage .~ (ConcreteStore storage)-             & #origStorage .~ (ConcreteStore storage)+clearNonce :: BlockchainContract -> BlockchainContract+clearNonce c = c {nonce = 0} -  parseJSON invalid =-    JSON.typeMismatch "Contract" invalid+clearCode :: BlockchainContract -> BlockchainContract+clearCode c = c {code = (ByteStringS "")}  instance FromJSON BlockchainCase where   parseJSON (JSON.Object v) = BlockchainCase@@ -372,7 +299,7 @@   parseJSON invalid =     JSON.typeMismatch "Block" invalid -parseContracts :: Which -> JSON.Object -> JSON.Parser (Map Addr Contract)+parseContracts :: Which -> JSON.Object -> JSON.Parser (BlockchainContracts) parseContracts w v = v .: which >>= parseJSON   where which = case w of           Pre  -> "pre"@@ -424,7 +351,7 @@ maxCodeSize = 24576  fromBlockchainCase' :: Block -> Transaction-                       -> Map Addr Contract -> Map Addr Contract+                       -> BlockchainContracts -> BlockchainContracts                        -> Either BlockchainError Case fromBlockchainCase' block tx preState postState =   let isCreate = isNothing tx.toAddr in@@ -464,11 +391,13 @@       postState         where           toAddr = maybe (EVM.createAddress origin (fromJust senderNonce)) LitAddr (tx.toAddr)-          senderNonce = view (accountAt (LitAddr origin) % #nonce) (Map.mapKeys LitAddr preState)+          senderNonce = (.nonce) <$> Map.lookup origin preState           toCode = Map.lookup toAddr (Map.mapKeys LitAddr preState)           theCode = if isCreate                     then InitCode tx.txdata mempty-                    else maybe (RuntimeCode (ConcreteRuntimeCode "")) (.code) toCode+                    else RuntimeCode . ConcreteRuntimeCode $ case toCode of+                      Nothing ->  ""+                      Just (BlockchainContract (ByteStringS bs) _ _ _) -> bs           effectiveGasPrice = effectiveprice tx block.baseFee           cd = if isCreate                then mempty@@ -495,43 +424,41 @@      EIP1559Transaction -> fromJust tx.maxFeePerGas      _ -> fromJust tx.gasPrice -checkTx :: Transaction -> Block -> Map Addr Contract -> Maybe (Map Addr Contract)+checkTx :: Transaction -> Block -> BlockchainContracts -> Maybe (BlockchainContracts) checkTx tx block prestate = do   origin <- sender tx   validateTx tx block prestate-  let isCreate    = isNothing tx.toAddr-      cs          = Map.mapKeys LitAddr prestate-      senderNonce = view (accountAt (LitAddr origin) % #nonce) cs-      toAddr      = maybe (EVM.createAddress origin (fromJust senderNonce)) LitAddr (tx.toAddr)-      prevCode    = view (accountAt toAddr % #code) cs-      prevNonce   = view (accountAt toAddr % #nonce) cs--      nonEmptyAccount = case prevCode of-                        RuntimeCode (ConcreteRuntimeCode b) -> not (BS.null b)-                        _ -> True-      badNonce = prevNonce /= Just 0-      initCodeSizeExceeded = BS.length tx.txdata > (unsafeInto maxCodeSize * 2)-  if isCreate && (badNonce || nonEmptyAccount || initCodeSizeExceeded)-  then mzero+  if (isJust tx.toAddr) then pure prestate   else-    pure prestate+    let senderNonce = (.nonce) <$> Map.lookup origin prestate+        addr  = case EVM.createAddress origin (fromJust senderNonce) of+                  (LitAddr a) -> a+                  _ -> internalError "Cannot happen"+        freshContract = BlockchainContract (ByteStringS "") 0 0 mempty+        (BlockchainContract (ByteStringS b) prevNonce _ _) = (fromMaybe freshContract $ Map.lookup addr prestate)+        nonEmptyAccount = not (BS.null b)+        badNonce = prevNonce /= 0+        initCodeSizeExceeded = BS.length tx.txdata > (unsafeInto maxCodeSize * 2)+    in+    if (badNonce || nonEmptyAccount || initCodeSizeExceeded) then mzero+    else pure prestate -validateTx :: Transaction -> Block -> Map Addr Contract -> Maybe ()+validateTx :: Transaction -> Block -> BlockchainContracts -> Maybe () validateTx tx block cs = do   origin <- sender tx-  Lit originBalance <- (.balance) <$> Map.lookup origin cs+  originBalance <- (.balance) <$> Map.lookup origin cs   originNonce <- (.nonce) <$> Map.lookup origin cs   let gasDeposit = (effectiveprice tx block.baseFee) * (into tx.gasLimit)   if gasDeposit + tx.value <= originBalance-    && (Just (unsafeInto tx.nonce) == originNonce) && block.baseFee <= maxBaseFee tx+    && ((unsafeInto tx.nonce) == originNonce) && block.baseFee <= maxBaseFee tx   then Just ()   else Nothing -vmForCase :: Case -> IO (VM Concrete RealWorld)+vmForCase :: Case -> IO (VM Concrete) vmForCase x = do   vm <- stToIO $ makeVm x.vmOpts     -- TODO: why do we override contracts here instead of using VMOpts otherContracts?-    <&> set (#env % #contracts) (Map.mapKeys LitAddr x.checkContracts)+    <&> set (#env % #contracts) (Map.mapKeys LitAddr $ Map.map makeContract x.checkContracts)     -- TODO: we need to call this again because we override contracts in the     -- previous line     <&> setEIP4788Storage x.vmOpts

@@ -13,7 +13,8 @@ module EVM.Test.FuzzSymExec where  import Control.Monad (when)-import Control.Monad.ST (ST, stToIO)+import Control.Monad.IO.Unlift+import Control.Monad.ST (ST, stToIO, RealWorld) import Control.Monad.State.Strict (StateT(..)) import Control.Monad.Reader (ReaderT) import Data.Aeson ((.:), (.:?))@@ -21,7 +22,7 @@ import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as Char8-import Data.Maybe (fromJust, isJust, isNothing)+import Data.Maybe (fromJust, isJust, mapMaybe) import Data.Map.Strict qualified as Map import Data.Text.IO qualified as T import Data.Vector qualified as Vector@@ -29,6 +30,7 @@ import GHC.Generics (Generic) import GHC.IO.Exception (ExitCode(ExitSuccess)) import Numeric (showHex)+import Optics.Core hiding (pre) import System.Directory (removeDirectoryRecursive) import System.FilePath ((</>)) import System.IO.Temp (getCanonicalTemporaryDirectory, createTempDirectory)@@ -38,12 +40,10 @@ import Test.QuickCheck.Instances.Natural() import Test.QuickCheck.Instances.ByteString() import Test.Tasty (testGroup, after, TestTree, TestName, DependencyType(..))-import Test.Tasty.HUnit (assertEqual, testCase)+import Test.Tasty.HUnit (assertEqual, testCase, assertBool) import Test.Tasty.QuickCheck hiding (Failure, Success) import Witch (into, unsafeInto) -import Optics.Core hiding (pre)- import EVM (makeVm, initialContract, symbolify) import EVM.Assembler (assemble) import EVM.Expr qualified as Expr@@ -60,7 +60,6 @@ import EVM.Transaction qualified import EVM.Types hiding (Env) import EVM.Effects-import Control.Monad.IO.Unlift import EVM.Tracing (interpretWithTrace, VMTraceStep(..), VMTraceStepResult(..))  data EVMToolTrace =@@ -280,10 +279,10 @@  getHEVMRet   :: App m-  => OpContract -> ByteString -> Int -> m (Either (EvmError, [VMTraceStep]) (Expr 'End, [VMTraceStep], VMTraceStepResult))+  => OpContract -> ByteString -> Int -> m (Either (EvmError, [VMTraceStep]) ([Expr 'End], [VMTraceStep], VMTraceStepResult)) getHEVMRet contr txData gaslimitExec = do   let (txn, evmEnv, contrAlloc, fromAddress, toAddress, _) = evmSetup contr txData gaslimitExec-  runCodeWithTrace mempty evmEnv contrAlloc txn (LitAddr fromAddress) (LitAddr toAddress)+  runCodeWithTrace Fetch.noRpc evmEnv contrAlloc txn (LitAddr fromAddress) (LitAddr toAddress)  getEVMToolRet :: FilePath -> OpContract -> ByteString -> Int -> IO (Maybe EVMToolResult) getEVMToolRet evmDir contr txData gaslimitExec = do@@ -401,13 +400,13 @@ runCodeWithTrace   :: App m   => Fetch.RpcInfo -> EVMToolEnv -> EVMToolAlloc -> EVM.Transaction.Transaction-  -> Expr EAddr -> Expr EAddr -> m (Either (EvmError, [VMTraceStep]) ((Expr 'End, [VMTraceStep], VMTraceStepResult)))+  -> Expr EAddr -> Expr EAddr -> m (Either (EvmError, [VMTraceStep]) (([Expr 'End], [VMTraceStep], VMTraceStepResult))) runCodeWithTrace rpcinfo evmEnv alloc txn fromAddr toAddress = withSolvers Z3 0 1 Nothing $ \solvers -> do   let calldata' = ConcreteBuf txn.txdata       code' = alloc.code       iterConf = IterConfig { maxIter = Nothing, askSmtIters = 1, loopHeuristic = Naive }       fetcherSym = Fetch.oracle solvers Nothing rpcinfo-      buildExpr vm = interpret fetcherSym iterConf vm runExpr+      buildExpr vm = interpret fetcherSym iterConf vm runExpr pure   origVM <- liftIO $ stToIO $ vmForRuntimeCode code' calldata' evmEnv alloc txn fromAddr toAddress   expr <- buildExpr $ symbolify origVM @@ -417,7 +416,7 @@     Left x -> pure $ Left (x, trace)     Right _ -> pure $ Right (expr, trace, vmres vm) -vmForRuntimeCode :: ByteString -> Expr Buf -> EVMToolEnv -> EVMToolAlloc -> EVM.Transaction.Transaction -> Expr EAddr -> Expr EAddr -> ST s (VM Concrete s)+vmForRuntimeCode :: ByteString -> Expr Buf -> EVMToolEnv -> EVMToolAlloc -> EVM.Transaction.Transaction -> Expr EAddr -> Expr EAddr -> ST RealWorld (VM Concrete) vmForRuntimeCode runtimecode calldata' evmToolEnv alloc txn fromAddr toAddress =   let contract = initialContract (RuntimeCode (ConcreteRuntimeCode runtimecode))                  & set #balance (Lit alloc.balance)@@ -452,7 +451,7 @@              (Just (initialContract (RuntimeCode (ConcreteRuntimeCode BS.empty))))        <&> set (#state % #calldata) calldata' -vmres :: VM Concrete s -> VMTraceStepResult+vmres :: VM Concrete -> VMTraceStepResult vmres vm =   let     gasUsed' = vm.tx.gaslimit - vm.state.gas@@ -682,7 +681,7 @@ randItem :: [a] -> IO a randItem = generate . Test.QuickCheck.elements -getOpFromVM :: VM t s -> Word8+getOpFromVM :: VM t -> Word8 getOpFromVM vm =   let pcpos  = vm ^. #state % #pc       code' = vm ^. #state % #code@@ -760,19 +759,19 @@   case hevmRun of     (Right (expr, hevmTrace, hevmTraceResult)) -> liftIO $ do       let-        concretize :: Expr a -> Expr Buf -> Expr a-        concretize a c = mapExpr go a+        concretize :: Expr Buf -> Expr a ->  Expr a+        concretize c a = mapExpr go a           where             go :: Expr a -> Expr a             go = \case                        AbstractBuf "calldata" -> c                        y -> y-        concretizedExpr = concretize expr (ConcreteBuf txData)-        simplConcExpr = Expr.simplify concretizedExpr+        concretizedExpr = map (concretize (ConcreteBuf txData)) $ expr+        simplConcExpr = map Expr.simplify concretizedExpr         getReturnVal :: Expr End -> Maybe ByteString         getReturnVal (Success _ _ (ConcreteBuf bs) _) = Just bs         getReturnVal _ = Nothing-        simplConcrExprRetval = getReturnVal simplConcExpr+        simplConcrExprRetval = mapMaybe getReturnVal simplConcExpr       traceOK <- compareTraces hevmTrace (evmtoolTraceOutput.trace)       -- putStrLn $ "HEVM trace   : " <> show hevmTrace       -- putStrLn $ "evmtool trace: " <> show (evmtoolTraceOutput.trace)@@ -780,18 +779,19 @@       let resultOK = evmtoolTraceOutput.output.output == hevmTraceResult.out       if resultOK then liftIO $ do         putStrLn $ "HEVM & evmtool's outputs match: '" <> (bsToHex $ bssToBs evmtoolTraceOutput.output.output) <> "'"-        if isNothing simplConcrExprRetval || (fromJust simplConcrExprRetval) == (bssToBs hevmTraceResult.out)+        assertBool "Cannot have more than one success return value" (length simplConcrExprRetval <= 1)+        if null simplConcrExprRetval || (simplConcrExprRetval !! 0) == (bssToBs hevmTraceResult.out)            then do              putStr "OK, symbolic interpretation -> concrete calldata -> Expr.simplify gives the same answer."-             if isNothing simplConcrExprRetval then putStrLn ", but it was a Nothing, so not strong equivalence"-                                               else putStrLn ""+             if null simplConcrExprRetval then putStrLn ", but it was a Nothing, so not strong equivalence"+                                          else putStrLn ""            else do              putStrLn $ "original expr                    : " <> (show expr)              putStrLn $ "concretized expr                 : " <> (show concretizedExpr)              putStrLn $ "simplified concretized expr      : " <> (show simplConcExpr)              putStrLn $ "evmtoolTraceOutput.output.output : " <> (show (evmtoolTraceOutput.output.output))              putStrLn $ "HEVM trace result output         : " <> (bsToHex (bssToBs hevmTraceResult.out))-             putStrLn $ "ret value computed via symb+conc : " <> (bsToHex (fromJust simplConcrExprRetval))+             putStrLn $ "ret value computed via symb+conc : " <> (bsToHex (simplConcrExprRetval !! 0))              assertEqual "Simplified, concretized expression must match evmtool's output." True False       else do         putStrLn $ "Name of trace file: " <> (getTraceFileName evmDir $ fromJust evmtoolResult)

@@ -17,14 +17,13 @@ import EVM.Solvers import EVM.UnitTest import EVM.SymExec qualified as SymExec-import Control.Monad.ST (RealWorld) import Control.Monad.IO.Unlift import Control.Monad.Catch (MonadMask) import EVM.Effects import Data.Maybe (fromMaybe) import EVM.Types (internalError) import System.Environment (lookupEnv)-import EVM.Fetch (RpcInfo)+import EVM.Fetch (RpcInfo, noRpc) import EVM.Fetch qualified as Fetch  -- Returns tuple of (No cex, No warnings)@@ -47,12 +46,12 @@ runForgeTest   :: (MonadMask m, App m)   => FilePath -> Text -> m (Bool, Bool)-runForgeTest testFile match = runForgeTestCustom testFile match Nothing Nothing True mempty+runForgeTest testFile match = runForgeTestCustom testFile match Nothing Nothing True noRpc -testOpts :: forall m . App m => SolverGroup -> FilePath -> Maybe BuildOutput -> Text -> Maybe Integer -> Bool -> RpcInfo -> m (UnitTestOptions RealWorld)+testOpts :: forall m . App m => SolverGroup -> FilePath -> Maybe BuildOutput -> Text -> Maybe Integer -> Bool -> RpcInfo -> m (UnitTestOptions) testOpts solvers root buildOutput match maxIter allowFFI rpcinfo = do   let srcInfo = maybe emptyDapp (dappInfo root) buildOutput-  sess <- Fetch.mkSession+  sess <- Fetch.mkSessionWithoutCache   params <- paramsFromRpc rpcinfo sess    pure UnitTestOptions

@@ -136,50 +136,6 @@         let hexStr = Types.bsToHex c         (_, stdout, _) <- readProcessWithExitCode "cabal" ["run", "exe:hevm", "--", "symbolic", "--solver", "empty", "--code", hexStr] ""         stdout `shouldContain` "SMT solver says: Result unknown by SMT solver"--      -- file "devcon_example.yul" from "eq-all-yul-optimization-tests" in test.hs-      -- we check that at least one UNSAT cache hit happens, i.e. the unsat cache is not-      -- completely broken-      it "unsat-cache" $ do-        let a = [i| {-          calldatacopy(0,0,1024)-              sstore(0, array_sum(calldataload(0)))-              function array_sum(x) -> sum {-                  let length := calldataload(x)-                  for { let i := 0 } lt(i, length) { i := add(i, 1) } {-                      sum := add(sum, array_load(x, i))-                  }-              }-              function array_load(x, i) -> v {-                  let len := calldataload(x)-                  if iszero(lt(i, len)) { revert(0, 0) }-                  let data := add(x, 0x20)-                  v := calldataload(add(data, mul(i, 0x20)))-              }-          } |]-        let b = [i| {-          calldatacopy(0,0,1024)-               {-                   let _1 := calldataload(0)-                   let sum := 0-                   let length := calldataload(_1)-                   let i := 0-                   for { } true { i := add(i, 1) }-                   {-                       let _2 := iszero(lt(i, length))-                       if _2 { break }-                       _2 := 0-                       sum := add(sum, calldataload(add(add(_1, shl(5, i)), 0x20)))-                   }-                   sstore(0, sum)-               }-           } |]-        Right aPrgm <- yul (T.pack "") $ T.pack a-        Right bPrgm <- yul (T.pack "") $ T.pack b-        let hexStrA = Types.bsToHex aPrgm-            hexStrB = Types.bsToHex bPrgm-        (_, stdout, _) <- readProcessWithExitCode "cabal" ["run", "exe:hevm", "--", "equivalence", "--num-solvers", "1", "--debug", "--code-a", hexStrA, "--code-b", hexStrB] ""-        stdout `shouldContain` "Qed found via cache"       it "crash-of-hevm" $ do         let hexStrA = "608060405234801561001057600080fd5b506004361061002b5760003560e01c8063efa2978514610030575b600080fd5b61004361003e3660046102ad565b610045565b005b60006100508561007a565b9050600061005d866100a8565b905080821461006e5761006e61034c565b50505050505050505050565b600061008761032e6103aa565b8261009457610197610098565b61013e5b6100a291906103e2565b92915050565b60006100b561032e6103aa565b6100be906103aa565b6100c7906103aa565b82806100d1575060005b806100da575060005b61013157605a6100ea60006103aa565b6100f3906103aa565b6100ff6001605a610404565b61010b6001605a610404565b61011891166101976103e2565b6101229190610493565b61012c9190610493565b610149565b604061013f8161013e6103e2565b6101499190610493565b61015391906103e2565b61016061032e60006103e2565b83801561016b575060015b15801590610177575060015b80156101a05750831515801561018b575060015b15158015610197575060015b806101a0575060005b610251576101976101b3605a602d610493565b602d60006101c2600182610493565b6101cd906001610404565b6101d8906001610404565b6101e1906103aa565b6101ea906103aa565b6101f491906103e2565b6101ff90605a610404565b604e61020c8160016103e2565b6102169190610493565b61022490600116605a610404565b1661022e906103aa565b61023891906103e2565b6102429190610493565b61024c9190610493565b610283565b604561025f8161013e6103e2565b6102699190610493565b60456102778161013e6103e2565b6102819190610493565b165b61028d91906103e2565b1692915050565b80358015155b81146100a257600080fd5b80358061029a565b600080600080600080600080610100898b0312156102ca57600080fd5b6102d48a8a610294565b97506102e38a60208b01610294565b96506102f28a60408b016102a5565b95506103018a60608b016102a5565b94506103108a60808b01610294565b935061031f8a60a08b016102a5565b925061032e8a60c08b01610294565b915061033d8a60e08b016102a5565b90509295985092959890939650565b7f4e487b7100000000000000000000000000000000000000000000000000000000600052600160045260246000fd5b7f4e487b7100000000000000000000000000000000000000000000000000000000600052601160045260246000fd5b60007f800000000000000000000000000000000000000000000000000000000000000082036103db576103db61037b565b5060000390565b818103600083128015838313168383129190911617156100a2576100a261037b565b60008261043a577f4e487b7100000000000000000000000000000000000000000000000000000000600052601260045260246000fd5b7f800000000000000000000000000000000000000000000000000000000000000082147fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff8414161561048e5761048e61037b565b500590565b80820160008212801584831290811690159190911617156100a2576100a261037b56fea26469706673582212200a37769e5bf4b8b890caac8ab643126d55feb821a0201d2f674203f23fa666ad64736f6c634300081e0033" @@ -241,9 +197,9 @@         fileExists <- doesFileExist filename         shouldBe fileExists True         removeFile filename-      it "rpc-mock" $ do+      it "rpc-cache" $ do         (_, stdout, stderr) <- runForge "test/contracts/fail/rpc-test.sol"           ["--rpc", "http://mock.mock", "--prefix", "test_attack_symbolic"-          , "--number", "10307563", "--mock-file", "test/contracts/fail/rpc-test-mock.json"]+          , "--number", "10307563", "--cache-dir", "test/contracts/fail/"]         stdout `shouldContain` "[FAIL]"         stderr `shouldNotContain` "CallStack"

@@ -19,7 +19,7 @@ import EVM.SymExec import EVM.Test.Utils import EVM.Types hiding (BlockNumber, Env)-import Control.Monad.ST (stToIO, RealWorld)+import Control.Monad.ST (stToIO) import Control.Monad.Reader (ReaderT) import Control.Monad.IO.Unlift import EVM.Effects@@ -39,7 +39,7 @@     [ test "pre-merge-block" $ do         let block = BlockNumber 15537392         conf <- readConfig-        sess <- mkSession+        sess <- mkSessionWithoutCache         liftIO $ do           (cb, numb, basefee, prevRan) <- fetchBlockWithSession conf sess block testRpc >>= \case                         Nothing -> internalError "Could not fetch block"@@ -55,7 +55,7 @@           assertEqual "prevRan" 11049842297455506 prevRan     , test "post-merge-block" $ do         conf <- readConfig-        sess <- mkSession+        sess <- mkSessionWithoutCache         liftIO $ do           let block = BlockNumber 16184420           (cb, numb, basefee, prevRan) <- fetchBlockWithSession conf sess block testRpc >>= \case@@ -82,15 +82,12 @@     -- https://etherscan.io/token/0xc02aaa39b223fe8d0a0e5c4f27ead9083c756cc2#code     , test "weth-conc" $ do         let-          blockNum = 16198552           wad = 0x999999999999999999           calldata' = ConcreteBuf $ abiMethod "transfer(address,uint256)" (AbiTuple (V.fromList [AbiAddress (Addr 0xdead), AbiUInt 256 wad]))-          rpcDat = Just (BlockNumber blockNum, testRpc)-          rpcInfo :: RpcInfo = mempty { blockNumURL = rpcDat }-        sess <- mkSession-        vm <- weth9VM sess blockNum (calldata', [])+        sess <- mkSessionWithoutCache+        vm <- weth9VM sess testBlockNumber (calldata', [])         postVm <- withSolvers Z3 1 1 Nothing $ \solvers ->-          Stepper.interpret (oracle solvers (Just sess) rpcInfo) vm Stepper.runFully+          Stepper.interpret (oracle solvers (Just sess) testRpcInfo) vm Stepper.runFully         let           wethStore = (fromJust $ Map.lookup (LitAddr 0xC02aaA39b223FE8D0A0e5C4F27eAD9083C756Cc2) postVm.env.contracts).storage           wethStore' = case wethStore of@@ -109,20 +106,18 @@     , test "weth-sym" $ do         calldata' <- symCalldata "transfer(address,uint256)" [AbiAddressType, AbiUIntType 256] ["0xdead"] (AbstractBuf "txdata")         let-          blockNum = 16198552           postc _ (Failure _ _ (Revert _)) = PBool False           postc _ _ = PBool True-        sess <- mkSession-        vm <- weth9VM sess blockNum calldata'+        sess <- mkSession Nothing Nothing+        vm <- weth9VM sess testBlockNumber calldata'         (_, [Cex (_, model)]) <- withSolvers Z3 1 1 Nothing $ \s ->-          let rpcInfo ::RpcInfo =  mempty { blockNumURL = Just (BlockNumber blockNum, testRpc) }-          in verify s (oracle s (Just sess) rpcInfo) (rpcVeriOpts (fromJust rpcInfo.blockNumURL)) (symbolify vm) (Just postc)+          verify s (oracle s (Just sess) testRpcInfo) (defaultVeriOpts {rpcInfo = testRpcInfo}) (symbolify vm) postc Nothing         liftIO $ assertBool "model should exceed caller balance" (getVar model "arg2" >= 695836005599316055372648)     ]   ]  -- call into WETH9 from 0xf04a... (a large holder)-weth9VM :: App m => Session -> W256 -> (Expr Buf, [Prop]) -> m (VM Concrete RealWorld)+weth9VM :: App m => Session -> BlockNumber -> (Expr Buf, [Prop]) -> m (VM Concrete) weth9VM sess blockNum calldata' = do   let     caller' = LitAddr 0xf04a5cc80b1e94c69b48f5ee68a08cd2f09a7c3e@@ -130,20 +125,21 @@     callvalue' = Lit 0   vmFromRpc sess blockNum calldata' callvalue' caller' weth9 -vmFromRpc :: App m => Session -> W256 -> (Expr Buf, [Prop]) -> Expr EWord -> Expr EAddr -> Addr -> m (VM Concrete RealWorld)+vmFromRpc :: App m => Session -> BlockNumber -> (Expr Buf, [Prop]) -> Expr EWord -> Expr EAddr -> Addr -> m (VM Concrete) vmFromRpc sess blockNum calldata callvalue caller address = do   conf <- readConfig-  ctrct <- liftIO $ fetchContractWithSession conf sess (BlockNumber blockNum) testRpc address >>= \case-        Nothing -> internalError $ "contract not found: " <> show address-        Just contract' -> pure contract'+  ctrct <- liftIO $ fetchContractWithSession conf sess blockNum testRpc address >>= \case+        FetchFailure _ -> internalError $ "contract not found: " <> show address+        FetchError e -> internalError $ "rpc error: " <> show e+        FetchSuccess contract' _ -> pure contract'    liftIO $ addFetchCache sess address ctrct-  blk <- liftIO $ fetchBlockWithSession conf sess (BlockNumber blockNum) testRpc >>= \case+  blk <- liftIO $ fetchBlockWithSession conf sess blockNum testRpc >>= \case     Nothing -> internalError "could not fetch block"     Just b -> pure b    liftIO $ stToIO (makeVm $ VMOpts-    { contract       = ctrct+    { contract       = makeContractFromRPC ctrct     , otherContracts = []     , calldata       = calldata     , value          = callvalue@@ -174,6 +170,8 @@ testRpc :: Text testRpc = "https://eth-mainnet.alchemyapi.io/v2/vpeKFsEF6PHifHzdtcwXSDbhV3ym5Ro4" +testBlockNumber :: BlockNumber+testBlockNumber = BlockNumber 16198552+ testRpcInfo :: RpcInfo-testRpcInfo = let rpcDat = Just (BlockNumber 16198552, testRpc)-  in mempty { blockNumURL = rpcDat }+testRpcInfo = RpcInfo $ Just (testBlockNumber, testRpc)

@@ -10,7 +10,7 @@ import GHC.TypeLits import Data.Proxy import Control.Monad-import Control.Monad.ST (RealWorld, stToIO)+import Control.Monad.ST (stToIO) import Control.Monad.State.Strict import Control.Monad.IO.Unlift import Control.Monad.Reader (ReaderT)@@ -150,8 +150,8 @@           }         }         |]-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       assertEqualM "Expression is not clean." (badStoresInExpr paths) False     -- This case is somewhat artificial. We can't simplify this using only     -- static rewrite rules, because acct is totally abstract and acct + 1     -- could overflow back to zero. we may be able to do better if we have some@@ -170,9 +170,9 @@           }         }         |]-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-       -- T.writeFile "symbolic-index.expr" $ formatExpr expr-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       -- T.writeFile "symbolic-index.expr" $ formatExpr paths+       assertEqualM "Expression is not clean." (badStoresInExpr paths) False     , expectFail $ test "simplify-storage-array-of-struct-symbolic-index" $ do        Just c <- solcRuntime "MyContract"         [i|@@ -191,8 +191,8 @@           }         }         |]-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       assertEqualM "Expression is not clean." (badStoresInExpr paths) False     , test "simplify-storage-array-loop-nonstruct" $ do        Just c <- solcRuntime "MyContract"         [i|@@ -206,9 +206,9 @@           }         }         |]-       let veriOpts = defaultVeriOpts { iterConf = defaultIterConf { maxIter = Just 5 }}-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256)" [AbiUIntType 256])) [] veriOpts-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       let veriOpts = (defaultVeriOpts :: VeriOpts) { iterConf = defaultIterConf { maxIter = Just 5 }}+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256)" [AbiUIntType 256])) [] veriOpts+       assertEqualM "Expression is not clean." (badStoresInExpr paths) False     , test "simplify-storage-map-newtest1" $ do        Just c <- solcRuntime "MyContract"         [i|@@ -226,9 +226,9 @@           }         }         |]-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False-       (_, [(Qed)]) <- withDefaultSolver $ \s -> checkAssert s [0x11] c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       assertEqualM "Expression is not clean." (badStoresInExpr paths) False+       (_, []) <- withDefaultSolver $ \s -> checkAssert s [0x11] c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts        liftIO $ putStrLn "OK"     , ignoreTest $ test "simplify-storage-map-todo" $ do        Just c <- solcRuntime "MyContract"@@ -250,8 +250,8 @@        -- TODO: expression below contains (load idx1 (store idx1 (store idx1 (store idx0)))), and the idx0        --       is not stripped. This is due to us not doing all we can in this case, see        --       note above readStorage. Decompose remedies this (when it can be decomposed)-       -- expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-       -- putStrLnM $ T.unpack $ formatExpr expr+       -- paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       -- putStrLnM $ T.unpack $ formatExpr paths        (_, [Cex _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts        liftIO $ putStrLn "OK"     , test "simplify-storage-array-loop-struct" $ do@@ -272,9 +272,9 @@           }         }         |]-       let veriOpts = defaultVeriOpts { iterConf = defaultIterConf { maxIter = Just 5 }}-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] veriOpts-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       let veriOpts = (defaultVeriOpts :: VeriOpts) { iterConf = defaultIterConf { maxIter = Just 5 }}+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] veriOpts+       assertEqualM "Expression is not clean." (badStoresInExpr paths) False     , test "decompose-1" $ do       Just c <- solcRuntime "MyContract"         [i|@@ -288,9 +288,9 @@           }         }         |]-      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mapping_access(address,address)" [AbiAddressType, AbiAddressType])) [] defaultVeriOpts-      let simpExpr = mapExprM Expr.decomposeStorage expr-      assertEqualM "Decompose did not succeed." (isJust simpExpr) True+      paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mapping_access(address,address)" [AbiAddressType, AbiAddressType])) [] defaultVeriOpts+      let simpExpr = map (mapExprM Expr.decomposeStorage) paths+      assertEqualM "Decompose did not succeed." (all isJust simpExpr) True     , test "decompose-2" $ do       Just c <- solcRuntime "MyContract"         [i|@@ -303,10 +303,10 @@           }         }         |]-      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mixed_symoblic_concrete_writes(address,uint256)" [AbiAddressType, AbiUIntType 256])) [] defaultVeriOpts-      let simpExpr = mapExprM Expr.decomposeStorage expr-      -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)-      assertEqualM "Decompose did not succeed." (isJust simpExpr) True+      paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mixed_symoblic_concrete_writes(address,uint256)" [AbiAddressType, AbiUIntType 256])) [] defaultVeriOpts+      let pathsSimp = map (mapExprM (Expr.decomposeStorage . Expr.concKeccakSimpExpr . Expr.simplify)) paths+      -- putStrLnM $ T.unpack $ formatExpr (fromJust pathsSimp)+      assertEqualM "Decompose did not succeed." (all isJust pathsSimp) True     , test "decompose-3" $ do       Just c <- solcRuntime "MyContract"         [i|@@ -320,9 +320,9 @@           }         }         |]-      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_array(uint256,uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-      let simpExpr = mapExprM Expr.decomposeStorage expr-      assertEqualM "Decompose did not succeed." (isJust simpExpr) True+      paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_array(uint256,uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+      let simpExpr = map (mapExprM Expr.decomposeStorage) paths+      assertEqualM "Decompose did not succeed." (all isJust simpExpr) True     , test "decompose-4-mixed" $ do       Just c <- solcRuntime "MyContract"         [i|@@ -338,10 +338,10 @@           }         }         |]-      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_array(uint256,uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-      let simpExpr = mapExprM Expr.decomposeStorage expr+      paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_array(uint256,uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+      let simpExpr = map (mapExprM Expr.decomposeStorage) paths       -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)-      assertEqualM "Decompose did not succeed." (isJust simpExpr) True+      assertEqualM "Decompose did not succeed." (all isJust simpExpr) True     , test "decompose-5-mixed" $ do       Just c <- solcRuntime "MyContract"         [i|@@ -365,10 +365,10 @@           }         }         |]-      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mixed(address,address,uint256)" [AbiAddressType, AbiAddressType, AbiUIntType 256])) [] defaultVeriOpts-      let simpExpr = mapExprM Expr.decomposeStorage expr+      paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mixed(address,address,uint256)" [AbiAddressType, AbiAddressType, AbiUIntType 256])) [] defaultVeriOpts+      let simpExpr = map (mapExprM Expr.decomposeStorage) paths       -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)-      assertEqualM "Decompose did not succeed." (isJust simpExpr) True+      assertEqualM "Decompose did not succeed." (all isJust simpExpr) True     , test "decompose-6" $ do       Just c <- solcRuntime "MyContract"         [i|@@ -381,10 +381,10 @@           }         }         |]-      expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mixed(uint256)" [AbiUIntType 256])) [] defaultVeriOpts-      let simpExpr = mapExprM Expr.decomposeStorage expr+      paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "prove_mixed(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+      let simpExpr = map (mapExprM Expr.decomposeStorage) paths       -- putStrLnM $ T.unpack $ formatExpr (fromJust simpExpr)-      assertEqualM "Decompose did not succeed." (isJust simpExpr) True+      assertEqualM "Decompose did not succeed." (all isJust simpExpr) True     -- This test uses array.length, which is is concrete 0 only in case we start with an empty storage     -- otherwise (i.e. with getExpr) it's symbolic, and the exploration loops forever     , test "decompose-7-emtpy-storage" $ do@@ -408,8 +408,8 @@           }        } |]        let sig = Just $ Sig "nested_append(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256]-       expr <- withDefaultSolver $ \s -> getExprEmptyStore s c sig [] defaultVeriOpts-       assertEqualM "Expression must be clean." (badStoresInExpr expr) False+       paths <- withDefaultSolver $ \s -> getExprEmptyStore s c sig [] defaultVeriOpts+       assertEqualM "Expression must be clean." (badStoresInExpr paths) False     , test "simplify-storage-map-only-static" $ do        Just c <- solcRuntime "MyContract"         [i|@@ -425,8 +425,9 @@         }         |]        let sig = (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256]))-       expr <- withDefaultSolver $ \s -> getExpr s c sig [] defaultVeriOpts-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       paths <- withDefaultSolver $ \s -> getExpr s c sig [] defaultVeriOpts+       let pathsSimp = map (mapExpr (Expr.concKeccakSimpExpr . Expr.simplify)) paths+       assertEqualM "Expression is not clean." (badStoresInExpr pathsSimp) False     , test "simplify-storage-map-only-2" $ do        Just c <- solcRuntime "MyContract"         [i|@@ -441,9 +442,9 @@           }         }         |]-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-       -- putStrLnM $ T.unpack $ formatExpr expr-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       -- putStrLnM $ T.unpack $ formatExpr paths+       assertEqualM "Expression is not clean." (badStoresInExpr paths) False     , test "simplify-storage-map-with-struct" $ do        Just c <- solcRuntime "MyContract"         [i|@@ -462,8 +463,8 @@           }         }         |]-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       assertEqualM "Expression is not clean." (badStoresInExpr paths) False     , test "simplify-storage-map-and-array" $ do        Just c <- solcRuntime "MyContract"         [i|@@ -484,9 +485,9 @@           }         }        |]-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-       -- putStrLnM $ T.unpack $ formatExpr expr-       assertEqualM "Expression is not clean." (badStoresInExpr expr) False+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "transfer(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+       -- putStrLnM $ T.unpack $ formatExpr paths+       assertEqualM "Expression is not clean." (badStoresInExpr paths) False     , test "simplify-storage-wordToAddr" $ do        let a = "000000000000000000000000d95322745865822719164b1fc167930754c248de000000000000000000000000000000000000000000000000000000000000004a"            store = ConcreteStore (Map.fromList[(W256 0xebd33f63ba5dda53a45af725baed5628cdad261db5319da5f5d921521fe1161d,W256 0x5842cf)])@@ -520,7 +521,7 @@         let dummyContract =               (initialContract (RuntimeCode (ConcreteRuntimeCode mempty)))                 { external = True }-        vm :: VM Concrete RealWorld <- liftIO $ stToIO $ vmForEthrunCreation ""+        vm :: VM Concrete <- liftIO $ stToIO $ vmForEthrunCreation ""         -- perform the initial access         let ?conf = testEnv.config         vm1 <- liftIO $ stToIO $ execStateT (EVM.accessStorage (LitAddr 0) (Lit 0) (pure . pure ())) vm@@ -662,6 +663,19 @@         e2 = ConcreteBuf "Definitely not the same!"       equal <- checkEquiv e1 e2       assertBoolM "Should not be equivalent!" $ not equal+    , testNoSimplify "simplify-comparison-GEq" $ do+      let+        expr = PEq (Lit 0x1) (GEq (Var "v") (Lit 0x2))+        simp = Expr.simplifyProp expr+      ret <- checkEquivPropAndLHS expr simp+      assertEqualM "Must be equivalent" True ret+    , test "buffer-length-zero" $ do+        let+          p = PEq (BufLength (AbstractBuf "b")) (Lit 0x0)+          simp = Expr.simplifyProp p+        liftIO $ print simp+        ret <-  checkEquivProp p simp+        assertEqualM "Must be equivalent" True ret     ]   -- These tests fuzz the simplifier by generating a random expression,   -- applying some simplification rules, and then using the smt encoding to@@ -691,7 +705,7 @@     , testProperty "byte-simplification" $ \(expr :: Expr Byte) -> propNoSimp $ do         let simplified = Expr.simplify expr         checkEquivAndLHS expr simplified-    , testProperty "word-simplification" $ \(ZeroDepthWord expr) -> propNoSimp $ do+    , askOption $ \(QuickCheckTests n) -> testProperty "word-simplification" $ withMaxSuccess (min n 20) $ \(ZeroDepthWord expr) -> propNoSimp $ do         let simplified = Expr.simplify expr         checkEquivAndLHS expr simplified     , testProperty "readStorage-equivalance" $ \(store, slot) -> propNoSimp $ do@@ -733,6 +747,16 @@         let simplified = Expr.indexWord idx src             full = IndexWord idx src         checkEquiv full simplified+    , testProperty "pow-base2-simp" $ \(_ :: Int) -> propNoSimp $ do+        expo <- liftIO $ generate . sized $ genWordArith 15+        let full = Exp (Lit 2) expo+            simplified = Expr.simplify full+        checkEquiv full simplified+    , testProperty "pow-low-exponent-simp" $ \(LitWord @100 expo) -> propNoSimp $ do+        base <- liftIO $ generate . sized $ genWordArith 15+        let full = Exp base expo+            simplified = Expr.simplify full+        checkEquiv full simplified     , testProperty "indexWord-mask-equivalence" $ \(src :: Expr EWord, LitWord @35 idx) -> propNoSimp $ do         mask <- liftIO $ generate $ do           pow <- arbitrary :: Gen Int@@ -881,6 +905,68 @@           propagated = Expr.constPropagate t         assertEqualM "Must contain PBool False" True ((PBool False) `elem` propagated)   ]+  , testGroup "inequality-propagation-tests" [+      test "PLT-detects-impossible-constraint" $ do+        let+          -- x < 0 is impossible for unsigned integers+          t = [PLT (Var "x") (Lit 0)]+          propagated = Expr.constPropagate t+        assertEqualM "Must contain PBool False" True ((PBool False) `elem` propagated)+    , test "PLT-overflow-check" $ do+        let+          -- maxLit < y is impossible+          t = [PLT (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff) (Var "y")]+          propagated = Expr.constPropagate t+        assertEqualM "Must contain PBool False" True ((PBool False) `elem` propagated)+    , test "PGT-detects-impossible-constraint" $ do+        let+          -- x > maxLit is impossible+          t = [PGT (Var "x") (Lit 0xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff)]+          propagated = Expr.constPropagate t+        assertEqualM "Must contain PBool False" True ((PBool False) `elem` propagated)+    , test "PGT-overflow-check" $ do+        let+          -- 0 > y is impossible+          t = [PGT (Lit 0) (Var "y")]+          propagated = Expr.constPropagate t+        assertEqualM "Must contain PBool False" True ((PBool False) `elem` propagated)+    , test "inequality-conflict-detection-narrow" $ do+        let+          -- x < 2 && x > 5 is impossible+          t = [PLT (Var "x") (Lit 2), PGT (Var "x") (Lit 5)]+          propagated = Expr.constPropagate t+        assertEqualM "Must contain PBool False" True ((PBool False) `elem` propagated)+    , test "inequality-conflict-detection-wide" $ do+        let+          -- x < 5 && x > 10 is impossible+          t = [PLT (Var "x") (Lit 5), PGT (Var "x") (Lit 10)]+          propagated = Expr.constPropagate t+        assertEqualM "Must contain PBool False" True ((PBool False) `elem` propagated)+    , test "inequality-tight-bounds-satisfied" $ do+        let+          -- x >= 5 && x <= 5 and x == 5 should be consistent+          t = [PGEq (Var "x") (Lit 5), PLEq (Var "x") (Lit 5), PEq (Var "x") (Lit 5)]+          propagated = Expr.constPropagate t+        assertEqualM "Must not contain PBool False" False ((PBool False) `elem` propagated)+    , test "inequality-tight-bounds-violated" $ do+        let+          -- x >= 5 && x <= 5 and x != 5 should be inconsistent+          t = [PGEq (Var "x") (Lit 5), PLEq (Var "x") (Lit 5), PNeg (PEq (Var "x") (Lit 5))]+          propagated = Expr.constPropagate t+        assertEqualM "Must contain PBool False" True ((PBool False) `elem` propagated)+    , test "inequality-with-existing-equality-consistent" $ do+        let+          -- x == 5 && x < 10 is consistent+          t = [PEq (Var "x") (Lit 5), PLT (Var "x") (Lit 10)]+          propagated = Expr.constPropagate t+        assertEqualM "Must not contain PBool False" False ((PBool False) `elem` propagated)+    , test "inequality-with-existing-equality-inconsistent" $ do+        let+          -- x == 5 && x < 5 is inconsistent+          t = [PEq (Var "x") (Lit 5), PLT (Var "x") (Lit 5)]+          propagated = Expr.constPropagate t+        assertEqualM "Must contain PBool False" True ((PBool False) `elem` propagated)+  ]   , testGroup "simpProp-concrete-tests" [       test "simpProp-concrete-trues" $ do         let@@ -1082,13 +1168,11 @@             } |]         let sig = Just $ Sig "fun(int256)" [AbiIntType 256]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 1 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 0 numQeds     , test "negative-numbers-nonzero-comp-2" $ do         Just c <- solcRuntime "C" [i|             contract C {@@ -1102,13 +1186,11 @@             } |]         let sig = Just $ Sig "fun(int256)" [AbiIntType 256]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 1 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 0 numQeds     , test "negative-numbers-min" $ do         Just c <- solcRuntime "C" [i|             contract C {@@ -1122,13 +1204,11 @@             } |]         let sig = Just $ Sig "fun(int256)" [AbiIntType 256]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 1 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 0 numQeds     , test "negative-numbers-int128-1" $ do         Just c <- solcRuntime "C" [i|             contract C {@@ -1143,13 +1223,11 @@             } |]         let sig = Just $ Sig "fun(int128)" [AbiIntType 128]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 1 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 0 numQeds     , test "negative-numbers-zero-comp-simpleassert" $ do         Just c <- solcRuntime "C" [i|             contract C {@@ -1159,13 +1237,11 @@             } |]         let sig = Just $ Sig "fun(int256)" [AbiIntType 256]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 1 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 0 numQeds     , test "signed-int8-range" $ do         Just c <- solcRuntime "C" [i|           contract C {@@ -1176,13 +1252,66 @@           } |]         let sig = Just $ Sig "fun(int8)" [AbiIntType 8]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 0 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 1 numQeds+    , test "base-2-exp-uint8" $ do+        Just c <- solcRuntime "C" [i|+          contract C {+            function fun(uint8 x) public {+              unchecked {+                require(x < 10);+                uint256 y = 2**x;+                assert (y <= 512);+              }+            }+          } |]+        let sig = Just $ Sig "fun(uint8)" [AbiUIntType 8]+        (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        assertBoolM "The expression must not be partial" $ not (any isPartial e)+        let numCexes = sum $ map (fromEnum . isCex) ret+        let numErrs = sum $ map (fromEnum . isError) ret+        assertEqualM "number of counterexamples" 0 numCexes+        assertEqualM "number of errors" 0 numErrs+    , test "base-2-exp-no-rollaround" $ do+        Just c <- solcRuntime "C" [i|+          contract C {+            function fun(uint256 x) public {+              unchecked {+                require(x > 10);+                require(x < 256);+                uint256 y = 2**x;+                assert (y > 512);+              }+            }+          } |]+        let sig = Just $ Sig "fun(uint256)" [AbiUIntType 256]+        (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        assertBoolM "The expression must not be partial" $ not (any isPartial e)+        let numCexes = sum $ map (fromEnum . isCex) ret+        let numErrs = sum $ map (fromEnum . isError) ret+        assertEqualM "number of counterexamples" 0 numCexes+        assertEqualM "number of errors" 0 numErrs+    , test "base-2-exp-rollaround" $ do+        Just c <- solcRuntime "C" [i|+          contract C {+            function fun(uint256 x) public {+              unchecked {+                require(x == 256);+                uint256 y = 2**x;+                assert (y > 512);+              }+            }+          } |]+        let sig = Just $ Sig "fun(uint256)" [AbiUIntType 256]+        (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        assertBoolM "The expression must not be partial" $ not (any isPartial e)+        let numCexes = sum $ map (fromEnum . isCex) ret+        let numErrs = sum $ map (fromEnum . isError) ret+        assertEqualM "number of counterexamples" 1 numCexes+        assertEqualM "number of errors" 0 numErrs     , test "unsigned-int8-range" $ do         Just c <- solcRuntime "C" [i|           contract C {@@ -1193,13 +1322,11 @@           } |]         let sig = Just $ Sig "fun(uint8)" [AbiUIntType 8]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 0 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 1 numQeds     , test "negative-numbers-zero-comp" $ do         Just c <- solcRuntime "C" [i|             contract C {@@ -1213,13 +1340,11 @@             } |]         let sig = Just $ Sig "fun(int256)" [AbiIntType 256]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 1 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 0 numQeds     , test "positive-numbers-cex" $ do         Just c <- solcRuntime "C" [i|             contract C {@@ -1233,13 +1358,11 @@             } |]         let sig = Just $ Sig "fun(uint256)" [AbiUIntType 256]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 1 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 0 numQeds     , test "positive-numbers-qed" $ do         Just c <- solcRuntime "C" [i|             contract C {@@ -1253,13 +1376,11 @@             } |]         let sig = Just $ Sig "fun(uint256)" [AbiUIntType 256]         (e, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must not be partial" $ not (Expr.containsNode isPartial e)+        assertBoolM "The expression must not be partial" $ not (any isPartial e)         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret         assertEqualM "number of counterexamples" 0 numCexes         assertEqualM "number of errors" 0 numErrs-        assertEqualM "number of qed-s" 1 numQeds      , test "keccak256()" $         SolidityCall "x = uint(keccak256(abi.encodePacked(a)));"@@ -1492,7 +1613,7 @@              }             |]         let sig = (Just (Sig "fun(uint8)" [AbiUIntType 8]))-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts         putStrLnM "expected Qed found"      , test "enum-conversion-fail" $ do         Just c <- solcRuntime "MyContract"@@ -1577,7 +1698,7 @@             }           |]         Right e <- reachableUserAsserts c (Just $ Sig "f(address,uint256)" [AbiAddressType, AbiUIntType 256])-        assertBoolM "The expression is not partial" $ Expr.containsNode isPartial e+        assertBoolM "The expression is not partial" $ any isPartial e       ,       test "vm.prank-create" $ do         Just c <- solcRuntime "C"@@ -1651,8 +1772,8 @@             }             |]         let sig = Just (Sig "fun(uint256)" [AbiUIntType 256])-        (e, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression must contain Partial." $ Expr.containsNode isPartial e+        (e, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        assertBoolM "The expression must contain Partial." $ any isPartial e       , test "cheatcode-with-selector" $ do         Just c <- solcRuntime "C"             [i|@@ -1667,7 +1788,7 @@             }             |]         Right e <- reachableUserAsserts c Nothing-        assertBoolM "The expression should not contain Partial." $ Prelude.not $ Expr.containsNode isPartial e+        assertBoolM "The expression should not contain Partial." $ Prelude.not $ any isPartial e       ,       test "call ffi when disabled" $ do         Just c <- solcRuntime "C"@@ -1789,14 +1910,12 @@             }             |]           let sig = Just (Sig "checkval(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])-          (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+          (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts           let numCexes = sum $ map (fromEnum . isCex) ret           let numErrs = sum $ map (fromEnum . isError) ret-          let numQeds = sum $ map (fromEnum . isQed) ret-          assertBoolM "The expression MUST be partial" (Expr.containsNode isPartial expr)+          assertBoolM "The expression MUST be partial" (any isPartial paths)           assertEqualM "number of errors" 0 numErrs           assertEqualM "number of counterexamples" 0 numCexes-          assertEqualM "number of qed-s" 1 numQeds       -- below we don't hit the limit of the depth of the symbolic execution tree       , testCase "limit-num-explore-no-hit-limit" $ do         let conf = testEnv.config {maxDepth = Just 7}@@ -1815,14 +1934,12 @@             }             |]           let sig = Just (Sig "checkval(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])-          (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+          (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts           let numCexes = sum $ map (fromEnum . isCex) ret           let numErrs = sum $ map (fromEnum . isError) ret-          let numQeds = sum $ map (fromEnum . isQed) ret-          assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+          assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)           assertEqualM "number of errors" 0 numErrs           assertEqualM "number of counterexamples" 1 numCexes-          assertEqualM "number of qed-s" 0 numQeds       , test "symbolic-copyslice" $ do         Just c <- solcRuntime "MyContract"             [i|@@ -1878,8 +1995,9 @@           let calldata = (WriteWord (Lit 0x0) (Var "u") (ConcreteBuf ""), [])           initVM <- liftIO $ stToIO $ abstractVM calldata initCode Nothing True           let iterConf = IterConfig {maxIter=Nothing, askSmtIters=1, loopHeuristic=StackBased }-          expr <- Expr.simplify <$> interpret (Fetch.oracle s Nothing mempty) iterConf initVM runExpr-          assertBoolM "unexptected partial execution" (not $ Expr.containsNode isPartial expr)+          paths <- interpret (Fetch.noRpcFetcher s) iterConf initVM runExpr pure+          let exprSimp = map Expr.simplify paths+          assertBoolM "unexptected partial execution" (not $ any isPartial exprSimp)     , test "mixed-concrete-symbolic-args" $ do         Just c <- solcRuntime "C"           [i|@@ -1901,8 +2019,8 @@                 }             }           |]-        Right expr <- reachableUserAsserts c (Just $ Sig "foo(uint256)" [AbiUIntType 256])-        assertBoolM "unexptected partial execution" (not $ Expr.containsNode isPartial expr)+        Right paths <- reachableUserAsserts c (Just $ Sig "foo(uint256)" [AbiUIntType 256])+        assertBoolM "unexptected partial execution" $ Prelude.not (any isPartial paths)     , test "extcodesize-symbolic" $ do         Just c <- solcRuntime "C"           [i|@@ -1920,8 +2038,8 @@         let sig = (Just $ Sig "foo(address,uint256)" [AbiAddressType, AbiUIntType 256])         (e, res) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        liftIO $ printWarnings Nothing [e] res "the contracts under test"-        assertEqualM "Must be QED" res [Qed]+        liftIO $ printWarnings Nothing e res "the contracts under test"+        assertEqualM "Must be QED" res []     , test "extcodesize-symbolic2" $ do         Just c <- solcRuntime "C"           [i|@@ -1938,7 +2056,7 @@         let sig = (Just $ Sig "foo(address,uint256)" [AbiAddressType, AbiUIntType 256])         (e, res@[Cex _]) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        liftIO $ printWarnings Nothing [e] res "the contracts under test"+        liftIO $ printWarnings Nothing e res "the contracts under test"     , test "jump-into-symbolic-region" $ do         let           -- our initCode just jumps directly to the end@@ -1969,10 +2087,9 @@         withDefaultSolver $ \s -> do           vm <- liftIO $ stToIO $ loadSymVM runtimecode (Lit 0) initCode False           let iterConf = IterConfig {maxIter=Nothing, askSmtIters=1, loopHeuristic=StackBased }-          expr <- Expr.simplify <$> interpret (Fetch.oracle s Nothing mempty) iterConf vm runExpr-          case expr of-            Partial _ _ (JumpIntoSymbolicCode _ _ _) -> assertBoolM "" True-            _ -> assertBoolM "did not encounter expected partial node" False+          paths <- interpret (Fetch.noRpcFetcher s) iterConf vm runExpr pure+          let exprSimp = map Expr.simplify paths+          assertBoolM "expected partial execution" (any isPartial exprSimp)     ]   , testGroup "Dapp-Tests"     [ test "Trivial-Pass" $ do@@ -2009,7 +2126,7 @@               , ("test/contracts/fail/symbolicFail.sol",      "prove_symb_fail_allrev_selector.*", (False, False))               , ("test/contracts/fail/symbolicFail.sol",      "prove_symb_fail_somerev_selector.*", (False, True))]         forM_ cases $ \(testFile, match, expected) -> do-          actual <- runForgeTestCustom testFile match Nothing Nothing False mempty+          actual <- runForgeTestCustom testFile match Nothing Nothing False Fetch.noRpc           putStrLnM $ "Test result for " <> testFile <> " match: " <> T.unpack match <> ": " <> show actual           assertEqualM "Must match" expected actual     , test "Trivial-Fail" $ do@@ -2042,14 +2159,14 @@         runForgeTest testFile "prove_trivial" >>= assertEqualM "prove_trivial" (False, False)         runForgeTest testFile "prove_trivial_dstest" >>= assertEqualM "prove_trivial_dstest" (False, False)         runForgeTest testFile "prove_add" >>= assertEqualM "prove_add" (False, True)-        runForgeTestCustom testFile "prove_smtTimeout" (Just 1) Nothing False mempty+        runForgeTestCustom testFile "prove_smtTimeout" (Just 1) Nothing False Fetch.noRpc           >>= assertEqualM "prove_smtTimeout" (True, False)         runForgeTest testFile "prove_multi" >>= assertEqualM "prove_multi" (False, True)         runForgeTest testFile "prove_distributivity" >>= assertEqualM "prove_distributivity" (False, True)     , test "Loop-Tests" $ do         let testFile = "test/contracts/pass/loops.sol"-        runForgeTestCustom testFile "prove_loop" Nothing (Just 10) False mempty  >>= assertEqualM "test result" (True, False)-        runForgeTestCustom testFile "prove_loop" Nothing (Just 100) False mempty >>= assertEqualM "test result" (False, False)+        runForgeTestCustom testFile "prove_loop" Nothing (Just 10) False Fetch.noRpc  >>= assertEqualM "test result" (True, False)+        runForgeTestCustom testFile "prove_loop" Nothing (Just 100) False Fetch.noRpc >>= assertEqualM "test result" (False, False)     , test "Cheat-Codes-Pass" $ do         let testFile = "test/contracts/pass/cheatCodes.sol"         runForgeTest testFile ".*" >>= assertEqualM "test result" (True, False)@@ -2076,10 +2193,10 @@             }             |]         let sig = Just $ Sig "fun()" []-            opts = defaultVeriOpts { iterConf = defaultIterConf {maxIter = Just 3 }}-        (e, [Qed]) <- withDefaultSolver $+            opts = (defaultVeriOpts :: VeriOpts) { iterConf = defaultIterConf {maxIter = Just 3 }}+        (e, []) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c sig [] opts-        assertBoolM "The expression is not partial" $ isPartial e+        assertBoolM "The expression is not partial" $ any isPartial e     , test "concrete-loops-not-reached" $ do         Just c <- solcRuntime "C"             [i|@@ -2093,10 +2210,10 @@             |]          let sig = Just $ Sig "fun()" []-            opts = defaultVeriOpts{ iterConf = defaultIterConf {maxIter = Just 6 }}-        (e, [Qed]) <- withDefaultSolver $+            opts = (defaultVeriOpts :: VeriOpts) { iterConf = defaultIterConf {maxIter = Just 6 }}+        (e, []) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c sig [] opts-        assertBoolM "The expression is partial" $ not $ isPartial e+        assertBoolM "The expression is partial" $ not $ any isPartial e     , test "symbolic-loops-reached" $ do         Just c <- solcRuntime "C"             [i|@@ -2108,10 +2225,10 @@               }             }             |]-        let veriOpts = defaultVeriOpts { iterConf = defaultIterConf { maxIter = Just 5 }}-        (e, [Qed]) <- withDefaultSolver $+        let veriOpts = (defaultVeriOpts :: VeriOpts) { iterConf = defaultIterConf { maxIter = Just 5 }}+        (e, []) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] veriOpts-        assertBoolM "The expression MUST be partial" $ Expr.containsNode isPartial e+        assertBoolM "The expression MUST be partial" $ any (Expr.containsNode isPartial) e     , test "inconsistent-paths" $ do         Just c <- solcRuntime "C"             [i|@@ -2128,10 +2245,10 @@             -- we don't ask the solver about the loop condition until we're             -- already in an inconsistent path (i == 5, j <= 3, i < j), so we             -- will continue looping here until we hit max iterations-            opts = defaultVeriOpts{ iterConf = defaultIterConf { maxIter = Just 10, askSmtIters = 5 }}-        (e, [Qed]) <- withDefaultSolver $+            opts = (defaultVeriOpts :: VeriOpts) { iterConf = defaultIterConf { maxIter = Just 10, askSmtIters = 5 }}+        (e, []) <- withDefaultSolver $           \s -> checkAssert s defaultPanicCodes c sig [] opts-        assertBoolM "The expression is not partial" $ Expr.containsNode isPartial e+        assertBoolM "The expression MUST be partial" $ any (Expr.containsNode isPartial) e     , test "mem-tuple" $ do         Just c <- solcRuntime "C"           [i|@@ -2152,7 +2269,7 @@           |]         let opts = defaultVeriOpts         let sig = Just $ Sig "prove_tuple_pass((uint256,uint256))" [AbiTupleType (V.fromList [AbiUIntType 256, AbiUIntType 256])]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] opts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] opts         putStrLnM "Qed, memory tuple is good"     , test "symbolic-loops-not-reached" $ do         Just c <- solcRuntime "C"@@ -2169,11 +2286,12 @@         let sig = Just $ Sig "fun(uint256)" [AbiUIntType 256]             -- askSmtIters is low enough here to avoid the inconsistent path             -- conditions, so we never hit maxIters-            opts = defaultVeriOpts{ iterConf = defaultIterConf {maxIter = Just 5, askSmtIters = 1 }}-        (e, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] opts-        assertBoolM "The expression MUST NOT be partial" $ not (Expr.containsNode isPartial e)+            opts = (defaultVeriOpts :: VeriOpts) { iterConf = defaultIterConf {maxIter = Just 5, askSmtIters = 1 }}+        (e, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] opts+        assertBoolM "The expression MUST NOT be partial" $ not (any (Expr.containsNode isPartial) e)     ]   , testGroup "Symbolic Addresses"+    -- TODO ignore only because Martin has a fix for this-- it should not be using `verify`     [ test "symbolic-address-create" $ do         let src = [i|                   contract A {@@ -2189,11 +2307,10 @@         Just a <- solcRuntime "A" src         Just c <- solcRuntime "C" src         let sig = Sig "fun(uint256)" [AbiUIntType 256]-        (expr, [Qed]) <- withDefaultSolver $ \s ->-          verifyContract s c (Just sig) [] defaultVeriOpts Nothing Nothing+        paths <- withDefaultSolver $ \s -> exploreContract s c (Just sig) [] defaultVeriOpts Nothing         let isSuc (Success {}) = True             isSuc _ = False-        case filter isSuc (flattenExpr expr) of+        case filter isSuc paths of           [Success _ _ _ store] -> do             let ca = fromJust (Map.lookup (SymAddr "freshSymAddr1") store)             let code = case ca.code of@@ -2202,7 +2319,7 @@             assertEqualM "balance mismatch" (Var "arg1") (Expr.simplify ca.balance)             assertEqualM "code mismatch" (stripBytecodeMetadata a) (stripBytecodeMetadata code)             assertEqualM "nonce mismatch" (Just 1) ca.nonce-          _ -> assertBoolM "too many success nodes!" False+          _ -> assertBoolM "too many/too few success nodes!" False     , test "symbolic-balance-call" $ do         let src = [i|                   contract A {@@ -2388,7 +2505,7 @@           |]         -- NOTE: we have a postcondition here, not just a regular verification         (_, [Cex _]) <- withDefaultSolver $ \s ->-          verifyContract s c Nothing [] defaultVeriOpts Nothing (Just $ checkBadCheatCode "load(address,bytes32)")+          verifyContract s c Nothing [] defaultVeriOpts Nothing (checkBadCheatCode "load(address,bytes32)")         pure ()     , test "vm.store fails for a potentially aliased address" $ do         Just c <- solcRuntime "C"@@ -2405,7 +2522,7 @@           |]         -- NOTE: we have a postcondition here, not just a regular verification         (_, [Cex _]) <- withDefaultSolver $ \s ->-          verifyContract s c Nothing [] defaultVeriOpts Nothing (Just $ checkBadCheatCode "store(address,bytes32,bytes32)")+          verifyContract s c Nothing [] defaultVeriOpts Nothing (checkBadCheatCode "store(address,bytes32,bytes32)")         pure ()     -- TODO: make this work properly     , test "transfering-eth-does-not-dealias" $ do@@ -2438,7 +2555,7 @@           |]         Right e <- reachableUserAsserts c Nothing         -- TODO: this should work one day-        assertBoolM "should be partial" (Expr.containsNode isPartial e)+        assertBoolM "should be partial" (any isPartial e)     , test "symbolic-addresses-cannot-be-zero-or-precompiles" $ do         let addrs = [T.pack . show . Addr $ a | a <- [0x0..0x09]]             mkC a = fromJust <$> solcRuntime "A"@@ -2509,7 +2626,7 @@               }              }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256)" [AbiIntType 256])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256)" [AbiIntType 256])) [] defaultVeriOpts         putStrLnM "Require works as expected"      , test "symbolic-block-number" $ do        Just c <- solcRuntime "C" [i|@@ -2524,7 +2641,7 @@              }            } |]        (e, [Cex _]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts-       assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial e)+       assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial e)      , test "symbolic-to-concrete-multi" $ do         Just c <- solcRuntime "MyContract"             [i|@@ -2541,8 +2658,8 @@              }             |]         let sig = Just (Sig "fun(uint160)" [AbiUIntType 160])-        (e, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-        assertBoolM "The expression is not partial" $ Prelude.not (Expr.containsNode isPartial e)+        (e, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        assertBoolM "The expression is not partial" $ Prelude.not (any isPartial e)      ,      -- here test      test "ITE-with-bitwise-AND" $ do@@ -2580,7 +2697,7 @@            }          }          |]-       (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+       (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts        putStrLnM "this should always be true, due to bitwise OR with positive value"      ,      test "abstract-returndata-size" $ do@@ -2594,8 +2711,8 @@            }          }          |]-       expr <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "f(uint256)" [])) [] defaultVeriOpts-       assertBoolM "The expression is partial" $ not $ Expr.containsNode isPartial expr+       paths <- withDefaultSolver $ \s -> getExpr s c (Just (Sig "f(uint256)" [])) [] defaultVeriOpts+       assertBoolM "The expression is partial" $ Prelude.not (any isPartial paths)     ,     -- CopySlice check     -- uses identity precompiled contract (0x4) to copy memory@@ -2621,9 +2738,9 @@         }         |]       let sig = Just (Sig "checkval(uint8)" [AbiUIntType 8])-      (res, [Qed]) <- withDefaultSolver $ \s ->+      (res, []) <- withDefaultSolver $ \s ->         checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+      putStrLnM $ "successfully explored " <> show (length res) <> " paths"     , test "staticcall-check-orig" $ do       Just c <- solcRuntime "C"         [i|@@ -2654,13 +2771,11 @@         |]       let sig = Just (Sig "checkval(uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])       (res, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+      putStrLnM $ "successfully explored: " <> show (length res) <> " paths"       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      let numQeds = sum $ map (fromEnum . isQed) ret       assertEqualM "number of counterexamples" 0 numCexes       assertEqualM "number of errors" 0 numErrs-      assertEqualM "number of qed-s" 1 numQeds     , test "staticcall-check-orig2" $ do       Just c <- solcRuntime "C"         [i|@@ -2681,14 +2796,12 @@         |]       let sig = Just (Sig "checkval(uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])       (res, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"-      assertBoolM "The expression is NOT partial" $ not $ Expr.containsNode isPartial res+      putStrLnM $ "successfully explored: " <> show (length res) <> " paths"+      assertBoolM "The expression is NOT partial" $ Prelude.not (any isPartial res)       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      let numQeds = sum $ map (fromEnum . isQed) ret       assertEqualM "number of counterexamples" 1 numCexes       assertEqualM "number of errors" 0 numErrs-      assertEqualM "number of qed-s" 0 numQeds     , test "copyslice-symbolic-ok" $ do       Just c <- solcRuntime "C"         [i|@@ -2707,10 +2820,10 @@          }         |]       let sig2 = Just (Sig "retFor(address)" [AbiAddressType])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches expr) <> " paths"+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts+      putStrLnM $ "successfully explored: " <> show (length paths) <> " paths"       assertBoolM "The expression is NOT error" $ not $ any isError ret-      assertBoolM "The expression is NOT partial" $ not $ Expr.containsNode isPartial expr+      assertBoolM "The expression is NOT partial" $ not (any isPartial paths)     , test "no-overapprox-when-present" $ do       Just c <- solcRuntime "C" [i|         contract ERC20 {@@ -2727,11 +2840,11 @@           }         } |]       let sig2 = Just (Sig "no_overapp()" [])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts-      -- putStrLnM $ "expr: " <> show expr-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches expr) <> " paths"+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts+      -- putStrLnM $ "paths: " <> show paths+      putStrLnM $ "successfully explored: " <> show (length paths) <> " paths"       assertBoolM "The expression is NOT error" $ not $ any isError ret-      assertBoolM "The expression is NOT partial" $ not $ Expr.containsNode isPartial expr+      assertBoolM "The expression is NOT partial" $ not (any isPartial paths)       let numCexes = sum $ map (fromEnum . isCex) ret       assertEqualM "number of counterexamples" 0 numCexes     -- NOTE: below used to be symbolic copyslice copy error before new copyslice@@ -2758,10 +2871,10 @@          }         |]       let sig2 = Just (Sig "retFor(address)" [AbiAddressType])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches expr) <> " paths"+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts+      putStrLnM $ "successfully explored: " <> show (length paths) <> " paths"       assertBoolM "The expression is NOT error" $ not $ any isError ret-      assertBoolM "The expression is NOT partial" $ not $ Expr.containsNode isPartial expr+      assertBoolM "The expression is NOT partial" $ not (any isPartial paths)       let numCexes = sum $ map (fromEnum . isCex) ret       -- There are 2 CEX-es       -- This is because with one CEX, the return DATA@@ -2786,11 +2899,11 @@          }         |]       let sig2 = Just (Sig "retFor(address)" [AbiAddressType])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches expr) <> " paths"+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts+      putStrLnM $ "successfully explored: " <> show (length paths) <> " paths"       assertBoolM "The expression is NOT error" $ not $ any isError ret       let numCexes = sum $ map (fromEnum . isCex) ret-      assertBoolM "The expression is NOT partial" $ not $ Expr.containsNode isPartial expr+      assertBoolM "The expression is NOT partial" $ not (any isPartial paths)       -- There are 2 CEX-es       -- This is because with one CEX, the return DATA       -- is empty, and in the other, the return data is non-empty (but symbolic)@@ -2814,11 +2927,11 @@          }         |]       let sig2 = Just (Sig "retFor()" [])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches expr) <> " paths"+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts+      putStrLnM $ "successfully explored: " <> show (length paths) <> " paths"       assertBoolM "The expression is NOT error" $ not $ any isError ret       let numCexes = sum $ map (fromEnum . isCex) ret-      assertBoolM "The expression is NOT partial" $ not $ Expr.containsNode isPartial expr+      assertBoolM "The expression is NOT partial" $ not (any isPartial paths)       -- There are 2 CEX-es       -- This is because with one CEX, the return DATA       -- is empty, and in the other, the return data is non-empty (but symbolic)@@ -2842,10 +2955,10 @@          }         |]       let sig2 = Just (Sig "retFor()" [])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches expr) <> " paths"+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig2 [] defaultVeriOpts+      putStrLnM $ "successfully explored: " <> show (length paths) <> " paths"       assertBoolM "The expression is NOT error" $ not $ any isError ret-      assertBoolM "The expression is NOT partial" $ not $ Expr.containsNode isPartial expr+      assertBoolM "The expression is NOT partial" $ not (any isPartial paths)       let numCexes = sum $ map (fromEnum . isCex) ret       -- There are 2 CEX-es       -- This is because with one CEX, the return DATA@@ -2882,16 +2995,14 @@         |]       let sig = Just (Sig "checkval(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])       (res, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"-      assertBoolM "The expression is NOT partial" $ not $ Expr.containsNode isPartial res+      putStrLnM $ "successfully explored: " <> show (length res) <> " paths"+      assertBoolM "The expression is NOT partial" $ not (any isPartial res)       assertBoolM "The expression is NOT unknown" $ not $ any isUnknown ret       assertBoolM "The expression is NOT error" $ not $ any isError ret       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      let numQeds = sum $ map (fromEnum . isQed) ret       assertEqualM "number of counterexamples" 0 numCexes       assertEqualM "number of errors" 0 numErrs-      assertEqualM "number of qed-s" 1 numQeds     , test "staticcall-check-symbolic1" $ do       Just c <- solcRuntime "C"         [i|@@ -2905,16 +3016,14 @@         |]       let sig = Just (Sig "checkval(address,uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])       (res, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+      putStrLnM $ "successfully explored: " <> show (length res) <> " paths"       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      let numQeds = sum $ map (fromEnum . isQed) ret       -- There are 2 CEX-es, in contrast to the above (staticcall-check-orig2).       -- This is because with one CEX, the return DATA       -- is empty, and in the other, the return data is non-empty (but symbolic)       assertEqualM "number of counterexamples" 2 numCexes       assertEqualM "number of errors" 0 numErrs-      assertEqualM "number of qed-s" 0 numQeds     -- This checks that calling a symbolic address with staticcall will ALWAYS return 0/1     -- which is the semantic of the EVM. We insert a  constraint over the return value     -- even when overapproximation is used, as below.@@ -2951,13 +3060,11 @@         |]       let sig = Just (Sig "checkval(address,uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])       (res, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+      putStrLnM $ "successfully explored: " <> show (length res) <> " paths"       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      let numQeds = sum $ map (fromEnum . isQed) ret       assertEqualM "number of counterexamples" 0 numCexes -- no counterexamples, because it is always  0/1       assertEqualM "number of errors" 0 numErrs-      assertEqualM "number of qed-s" 1 numQeds     , test "staticcall-check-symbolic2" $ do       Just c <- solcRuntime "C"         [i|@@ -2978,13 +3085,11 @@         |]       let sig = Just (Sig "checkval(address,uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])       (res, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+      putStrLnM $ "successfully explored: " <> show (length res) <> " paths"       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      let numQeds = sum $ map (fromEnum . isQed) ret       assertEqualM "number of counterexamples" 2 numCexes       assertEqualM "number of errors" 1 numErrs-      assertEqualM "number of qed-s" 0 numQeds     , testCase "call-symbolic-noreent" $ do       let conf = testEnv.config {promiseNoReent = True}       let myTestEnv :: Env = (testEnv :: Env) {config = conf :: Config}@@ -3000,17 +3105,15 @@           }           |]         let sig = Just (Sig "checkval(address,uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])-        (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret-        assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+        assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)       -- There are 2 CEX-es       -- This is because with one CEX, the return DATA       -- is empty, and in the other, the return data is non-empty and success is false         assertEqualM "number of errors" 0 numErrs         assertEqualM "number of counterexamples" 2 numCexes-        assertEqualM "number of qed-s" 0 numQeds     , test "call-symbolic-reent" $ do       Just c <- solcRuntime "C"         [i|@@ -3023,14 +3126,12 @@         }         |]       let sig = Just (Sig "checkval(address,uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-      assertBoolM "The expression MUST be partial due to CALL to unknown code and no promise" $ (Expr.containsNode isPartial expr)+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+      assertBoolM "The expression MUST be partial due to CALL to unknown code and no promise" (any isPartial paths)       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      let numQeds = sum $ map (fromEnum . isQed) ret       assertEqualM "number of errors" 0 numErrs       assertEqualM "number of counterexamples" 0 numCexes-      assertEqualM "number of qed-s" 1 numQeds     , testCase "call-symbolic-noreent-maxbufsize16" $ do       let conf = testEnv.config {promiseNoReent = True, maxBufSize = 4}       let myTestEnv :: Env = (testEnv :: Env) {config = conf :: Config}@@ -3046,14 +3147,12 @@           }           |]         let sig = Just (Sig "checkval(address,uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])-        (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret-        assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+        assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)         assertEqualM "number of errors" 0 numErrs         assertEqualM "number of counterexamples" 0 numCexes-        assertEqualM "number of qed-s" 1 numQeds     , testCase "call-symbolic-noreent-maxbufsize16-fail" $ do       let conf = testEnv.config {promiseNoReent = True, maxBufSize = 20}       let myTestEnv :: Env = (testEnv :: Env) {config = conf :: Config}@@ -3069,14 +3168,12 @@           }           |]         let sig = Just (Sig "checkval(address,uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])-        (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+        (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts         let numCexes = sum $ map (fromEnum . isCex) ret         let numErrs = sum $ map (fromEnum . isError) ret-        let numQeds = sum $ map (fromEnum . isQed) ret-        assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+        assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)         assertEqualM "number of errors" 0 numErrs         assertEqualM "number of counterexamples" 1 numCexes-        assertEqualM "number of qed-s" 0 numQeds     , test "call-balance-symb" $ do       Just c <- solcRuntime "C"         [i|@@ -3088,10 +3185,10 @@         }         |]       let sig = Just (Sig "checkval(address)" [AbiAddressType])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)       assertEqualM "number of errors" 0 numErrs       assertEqualM "number of counterexamples" 1 numCexes     , test "call-balance-symb2" $ do@@ -3105,10 +3202,10 @@         }         |]       let sig = Just (Sig "checkval()" [])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)       assertEqualM "number of errors" 0 numErrs       assertEqualM "number of counterexamples" 1 numCexes     , test "call-balance-concrete-pass" $ do@@ -3130,12 +3227,10 @@         }         |]       let sig = Just (Sig "checkval()" [])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts       let numErrs = sum $ map (fromEnum . isError) ret-      let numQeds = sum $ map (fromEnum . isQed) ret-      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)       assertEqualM "number of errors" 0 numErrs-      assertEqualM "number of qed-s" 1 numQeds     , test "call-balance-concrete-fail" $ do       Just c <- solcRuntime "C"         [i|@@ -3155,10 +3250,10 @@         }         |]       let sig = Just (Sig "checkval()" [])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts       let numErrs = sum $ map (fromEnum . isError) ret       let numCexes = sum $ map (fromEnum . isCex) ret-      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)       assertEqualM "number of errors" 0 numErrs       assertEqualM "number of counterexamples" 1 numCexes     , test "call-extcodehash-symb1" $ do@@ -3172,10 +3267,10 @@         }         |]       let sig = Just (Sig "checkval(address)" [AbiAddressType])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)       assertEqualM "number of errors" 0 numErrs       assertEqualM "number of counterexamples" 1 numCexes     , test "call-extcodehash-symb2" $ do@@ -3189,10 +3284,10 @@         }         |]       let sig = Just (Sig "checkval()" [])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)       assertEqualM "number of errors" 0 numErrs       assertEqualM "number of counterexamples" 1 numCexes     , test "call-extcodehash-concrete-fail" $ do@@ -3209,10 +3304,10 @@         }         |]       let sig = Just (Sig "checkval()" [])-      (expr, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+      (paths, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts       let numErrs = sum $ map (fromEnum . isError) ret       let numCexes = sum $ map (fromEnum . isCex) ret-      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (Expr.containsNode isPartial expr)+      assertBoolM "The expression MUST NOT be partial" $ Prelude.not (any isPartial paths)       assertEqualM "number of errors" 0 numErrs       assertEqualM "number of counterexamples" 1 numCexes     , test "jump-symbolic" $ do@@ -3236,13 +3331,11 @@         |]       let sig = Just (Sig "checkval(address,uint256,uint256)" [AbiAddressType, AbiUIntType 256, AbiUIntType 256])       (res, ret) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts-      putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+      putStrLnM $ "successfully explored: " <> show (length res) <> " paths"       let numCexes = sum $ map (fromEnum . isCex) ret       let numErrs = sum $ map (fromEnum . isError) ret-      let numQeds = sum $ map (fromEnum . isQed) ret       assertEqualM "number of counterexamples" numCexes 2       assertEqualM "number of symbolic copy errors" numErrs 0-      assertEqualM "number of qed-s" numQeds 0      ,      test "opcode-mul-assoc" $ do         Just c <- solcRuntime "MyContract"@@ -3263,7 +3356,7 @@               }              }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256,int256)" [AbiIntType 256, AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256,int256)" [AbiIntType 256, AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "MUL is associative"      ,      -- TODO look at tests here for SAR: https://github.com/dapphub/dapptools/blob/01ef8ea418c3fe49089a44d56013d8fcc34a1ec2/src/dapp-tests/pass/constantinople.sol#L250@@ -3281,7 +3374,7 @@               }              }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-sar-pos" $ do@@ -3298,7 +3391,7 @@               }              }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-sar-fixedval-pos" $ do@@ -3315,7 +3408,7 @@               }              }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-sar-fixedval-neg" $ do@@ -3332,7 +3425,7 @@               }              }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(int256,int256)" [AbiIntType 256, AbiIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-div-zero-1" $ do@@ -3349,7 +3442,7 @@               }             }             |]-        (_, [Qed])  <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+        (_, [])  <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "sdiv works as expected"       ,      test "opcode-sdiv-zero-1" $ do@@ -3366,7 +3459,7 @@               }             }             |]-        (_, [Qed])  <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+        (_, [])  <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "sdiv works as expected"       ,      test "opcode-sdiv-zero-2" $ do@@ -3383,7 +3476,7 @@               }             }             |]-        (_, [Qed])  <- withCVC5Solver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+        (_, [])  <- withCVC5Solver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "sdiv works as expected"       ,      test "signed-overflow-checks" $ do@@ -3417,7 +3510,7 @@               }             }             |]-        (_, [Qed])  <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+        (_, [])  <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "signextend works as expected"       ,      test "opcode-signextend-pos-nochop" $ do@@ -3435,7 +3528,7 @@               }             }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts         putStrLnM "signextend works as expected"       ,       test "opcode-signextend-pos-chopped" $ do@@ -3453,7 +3546,7 @@               }             }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts         putStrLnM "signextend works as expected"       ,       -- when b is too large, value is unchanged@@ -3471,7 +3564,7 @@               }             }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) [] defaultVeriOpts         putStrLnM "signextend works as expected"      ,      test "opcode-shl" $ do@@ -3489,7 +3582,7 @@               }              }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "SAR works as expected"      ,      test "opcode-xor-cancel" $ do@@ -3506,7 +3599,7 @@               }              }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "XOR works as expected"       ,       test "opcode-xor-reimplement" $ do@@ -3522,7 +3615,7 @@               }              }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts         putStrLnM "XOR works as expected"       ,       test "opcode-add-commutative" $ do@@ -3548,7 +3641,7 @@             putStrLnM $ "y:" <> show y             putStrLnM $ "x:" <> show x             assertEqualM "Addition is not commutative... that's wrong" False True-          (_, [Qed]) -> do+          (_, []) -> do             putStrLnM "adding is commutative"           _ -> internalError "Unexpected"       ,@@ -3566,7 +3659,7 @@               }             }             |]-        (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint16)" [AbiUIntType 16])) [] defaultVeriOpts+        (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "fun(uint16)" [AbiUIntType 16])) [] defaultVeriOpts         putStrLnM "DIV by zero is zero"       ,       -- Somewhat tautological since we are asserting the precondition@@ -3594,9 +3687,9 @@                    Success _ _ b _ -> (ReadWord (Lit 0) b) .== (Add x y)                    _ -> PBool True             sig = Just (Sig "add(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])-        (res, [Qed]) <- withDefaultSolver $ \s ->-          verifyContract s safeAdd sig [] defaultVeriOpts (Just pre) (Just post)-        putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+        (res, []) <- withDefaultSolver $ \s ->+          verifyContract s safeAdd sig [] defaultVeriOpts (Just pre) post+        putStrLnM $ "successfully explored: " <> show (length res) <> " paths"      ,        test "x == y => x + y == 2 * y" $ do@@ -3621,9 +3714,9 @@               in case leaf of                    Success _ _ b _ -> (ReadWord (Lit 0) b) .== (Mul (Lit 2) y)                    _ -> PBool True-        (res, [Qed]) <- withDefaultSolver $ \s ->-          verifyContract s safeAdd (Just (Sig "add(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts (Just pre) (Just post)-        putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+        (res, []) <- withDefaultSolver $ \s ->+          verifyContract s safeAdd (Just (Sig "add(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts (Just pre) post+        putStrLnM $ "successfully explored: " <> show (length res) <> " paths"       ,       test "summary storage writes" $ do         Just c <- solcRuntime "A"@@ -3652,9 +3745,9 @@                   in Expr.add prex (Expr.mul (Lit 2) y) .== (Expr.readStorage' (Lit 0) poststore)                 _ -> PBool True             sig = Just (Sig "f(uint256)" [AbiUIntType 256])-        (res, [Qed]) <- withDefaultSolver $ \s ->-          verifyContract s c sig [] defaultVeriOpts (Just pre) (Just post)-        putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+        (res, []) <- withDefaultSolver $ \s ->+          verifyContract s c sig [] defaultVeriOpts (Just pre) post+        putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         -- tests how whiffValue handles Neg via application of the triple IsZero simplification rule         -- regression test for: https://github.com/dapphub/dapptools/pull/698@@ -3678,8 +3771,8 @@                     }                     |]             Right c <- liftIO $ yulRuntime "Neg" src-            (res, [Qed]) <- withSolvers Z3 4 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "hello(address)" [AbiAddressType])) [] defaultVeriOpts-            putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+            (res, []) <- withSolvers Z3 4 1 Nothing $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "hello(address)" [AbiAddressType])) [] defaultVeriOpts+            putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "catch-storage-collisions-noproblem" $ do           Just c <- solcRuntime "A"@@ -3714,8 +3807,8 @@                        in Expr.add prex prey .== Expr.add postx posty                      _ -> PBool True               sig = Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])-          (_, [Qed]) <- withDefaultSolver $ \s ->-            verifyContract s c sig [] defaultVeriOpts (Just pre) (Just post)+          (_, []) <- withDefaultSolver $ \s ->+            verifyContract s c sig [] defaultVeriOpts (Just pre) post           putStrLnM "Correct, this can never fail"         ,         -- Inspired by these `msg.sender == to` token bugs@@ -3752,7 +3845,7 @@                      _ -> PBool True               sig = Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])           (_, [Cex (_, ctr)]) <- withDefaultSolver $ \s ->-            verifyContract s c sig [] defaultVeriOpts (Just pre) (Just post)+            verifyContract s c sig [] defaultVeriOpts (Just pre) post           let x = getVar ctr "arg1"           let y = getVar ctr "arg2"           putStrLnM $ "y:" <> show y@@ -3855,8 +3948,8 @@               }             }             |]-          (res, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         -- We zero out everything but the LSB byte. However, byte(31,x) takes the LSB byte         -- so there is a counterexamle, where LSB of x is not zero@@ -3909,8 +4002,8 @@               }             }             |]-          (res, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         -- Bitwise OR operation test         test "opcode-bitwise-or-full-1s" $ do@@ -3925,7 +4018,7 @@               }             }             |]-          (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM "When OR-ing with full 1's we should get back full 1's"         ,         -- Bitwise OR operation test@@ -3942,7 +4035,7 @@               }             }             |]-          (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM "When OR-ing with a byte of 1's, we should get 1's back there"         ,         test "Deposit contract loop (z3)" $ do@@ -3964,8 +4057,8 @@               }              }             |]-          (res, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "deposit(uint256)" [AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "deposit(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "Deposit-contract-loop-error-version" $ do           Just c <- solcRuntime "Deposit"@@ -3999,8 +4092,8 @@               }             }             |]-          (res, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "check-asm-byte-in-bounds" $ do           Just c <- solcRuntime "C"@@ -4018,7 +4111,7 @@               }             }             |]-          (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts+          (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts           putStrLnM "in bounds byte reads return the expected value"         ,         test "check-div-mod-sdiv-smod-by-zero-constant-prop" $ do@@ -4048,7 +4141,7 @@               }             }             |]-          (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "foo(uint256)" [AbiUIntType 256])) [] defaultVeriOpts           putStrLnM "div/mod/sdiv/smod by zero works as expected during constant propagation"         ,         test "check-asm-byte-oob" $ do@@ -4063,7 +4156,7 @@               }             }             |]-          (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts+          (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts           putStrLnM "oob byte reads always return 0"         ,         test "injectivity of keccak (diff sizes)" $ do@@ -4090,8 +4183,8 @@               }             }             |]-          (res, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "injectivity of keccak contrapositive (32 bytes)" $ do           Just c <- solcRuntime "A"@@ -4103,8 +4196,8 @@               }             }             |]-          (res, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256,uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "injectivity of keccak (64 bytes)" $ do           Just c <- solcRuntime "A"@@ -4138,8 +4231,8 @@               }             }             |]-          (res, [Qed]) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c Nothing [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "calldata beyond calldatasize is 0 (concrete dalldata prefix)" $ do           Just c <- solcRuntime "A"@@ -4155,8 +4248,8 @@               }             }             |]-          (res, [Qed]) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "calldata symbolic access" $ do           Just c <- solcRuntime "A"@@ -4176,8 +4269,8 @@               }             }             |]-          (res, [Qed]) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withBitwuzlaSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "multiple-contracts" $ do           let code =@@ -4205,7 +4298,7 @@                     <&> set (#state % #callvalue) (Lit 0)                     <&> over (#env % #contracts)                        (Map.insert aAddr (initialContract (RuntimeCode (ConcreteRuntimeCode a))))-            verify s (Fetch.oracle s Nothing mempty) defaultVeriOpts vm (Just $ checkAssertions defaultPanicCodes)+            verify s (Fetch.noRpcFetcher s) defaultVeriOpts vm (checkAssertions defaultPanicCodes) Nothing            let storeCex = cex.store               testCex = case (Map.lookup cAddr storeCex, Map.lookup aAddr storeCex) of@@ -4247,8 +4340,8 @@                 }               }             |]-          (res, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "kecc(uint256)" [AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "kecc(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "keccak-concrete-and-sym-agree-nonzero" $ do           Just c <- solcRuntime "C"@@ -4262,8 +4355,8 @@                 }               }             |]-          (res, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "kecc(uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "kecc(uint256)" [AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "keccak concrete and sym injectivity" $ do           Just c <- solcRuntime "A"@@ -4274,14 +4367,14 @@                 }               }             |]-          (res, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts-          putStrLnM $ "successfully explored: " <> show (Expr.numBranches res) <> " paths"+          (res, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "f(uint256)" [AbiUIntType 256])) [] defaultVeriOpts+          putStrLnM $ "successfully explored: " <> show (length res) <> " paths"         ,         test "safemath-distributivity-yul" $ do           let yulsafeDistributivity = hex "6355a79a6260003560e01c14156016576015601f565b5b60006000fd60a1565b603d602d604435600435607c565b6039602435600435607c565b605d565b6052604b604435602435605d565b600435607c565b141515605a57fe5b5b565b6000828201821115151560705760006000fd5b82820190505b92915050565b6000818384048302146000841417151560955760006000fd5b82820290505b92915050565b"           calldata <- mkCalldata (Just (Sig "distributivity(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) []           vm <- liftIO $ stToIO $ abstractVM calldata yulsafeDistributivity Nothing False-          (_, [Qed]) <-  withDefaultSolver $ \s -> verify s (Fetch.oracle s Nothing mempty) defaultVeriOpts vm (Just $ checkAssertions defaultPanicCodes)+          (_, []) <-  withDefaultSolver $ \s -> verify s (Fetch.noRpcFetcher s) defaultVeriOpts vm (checkAssertions defaultPanicCodes) Nothing           putStrLnM "Proven"         ,         test "safemath-distributivity-sol" $ do@@ -4306,7 +4399,7 @@               }             |] -          (_, [Qed]) <- withSolvers Bitwuzla 1 1 (Just 99999999) $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "distributivity(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts+          (_, []) <- withSolvers Bitwuzla 1 1 (Just 99999999) $ \s -> checkAssert s defaultPanicCodes c (Just (Sig "distributivity(uint256,uint256,uint256)" [AbiUIntType 256, AbiUIntType 256, AbiUIntType 256])) [] defaultVeriOpts           putStrLnM "Proven"         ,         test "storage-cex-1" $ do@@ -4372,7 +4465,7 @@             |]           let sig = Just (Sig "fun(uint256)" [AbiUIntType 256])           (_, [Cex (_, cex)]) <- withDefaultSolver $-            \s -> verifyContract s c sig [] defaultVeriOpts Nothing (Just $ checkAssertions [0x01])+            \s -> verifyContract s c sig [] defaultVeriOpts Nothing (checkAssertions [0x01])           let addr = SymAddr "entrypoint"               testCex = Map.size cex.store == 1 &&                         case Map.lookup addr cex.store of@@ -4404,7 +4497,7 @@             }             |]           let sig = (Just (Sig "stuff(address)" [AbiAddressType]))-          (_, [Qed]) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts+          (_, []) <- withDefaultSolver $ \s -> checkAssert s defaultPanicCodes c sig [] defaultVeriOpts           putStrLnM $ "Basic tstore check passed"   ]   , testGroup "simple-checks"@@ -4789,7 +4882,7 @@           |]         withSolvers Bitwuzla 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s a b defaultVeriOpts calldata False+          eq <- equivalenceCheck s Nothing a b defaultVeriOpts calldata False           assertBoolM "Must have a difference" (any (isCex . fst) eq.res)           let cexs = mapMaybe (getCex . fst) eq.res           assertEqualM "Must have exactly one cex" (length cexs) 1@@ -4818,7 +4911,7 @@           |]         withSolvers Bitwuzla 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s a b defaultVeriOpts calldata False+          eq <- equivalenceCheck s Nothing a b defaultVeriOpts calldata False           assertBoolM "Must have a difference" (any (isCex . fst) eq.res)           let cexs = mapMaybe (getCex . fst) eq.res           assertEqualM "Must have exactly one cex" (length cexs) 1@@ -4847,7 +4940,7 @@           |]         withSolvers Bitwuzla 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s a b defaultVeriOpts calldata False+          eq <- equivalenceCheck s Nothing a b defaultVeriOpts calldata False           assertBoolM "Must have a difference" (any (isCex . fst) eq.res)           let cexs = mapMaybe (getCex . fst) eq.res           assertEqualM "Must have exactly one cex" (length cexs) 1@@ -4857,7 +4950,7 @@             b = fromJust (hexByteString "5f356101f40115610100526020610100f3")         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s a b defaultVeriOpts calldata False+          eq <- equivalenceCheck s Nothing a b defaultVeriOpts calldata False           assertBoolM "Must have a difference" (any (isCex . fst) eq.res)           let cexs :: [SMTCex] = mapMaybe (getCex . fst) eq.res           cex <- case cexs of@@ -4889,7 +4982,7 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts calldata False+          eq <- equivalenceCheck s Nothing aPrgm bPrgm defaultVeriOpts calldata False           assertBoolM "Must have a difference" (any (isCex . fst) eq.res)       , test "constructor-same-deployed-diff" $ do         Just initA <- solidity "C"@@ -4918,7 +5011,7 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s initA initB defaultVeriOpts calldata True+          eq <- equivalenceCheck s Nothing initA initB defaultVeriOpts calldata True           assertBoolM "Must have difference, we return different values" (all (isCex . fst) eq.res)       , test "constructor-same-deployed-diff2" $ do         Just initA <- solidity "C"@@ -4950,7 +5043,7 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s initA initB defaultVeriOpts calldata True+          eq <- equivalenceCheck s Nothing initA initB defaultVeriOpts calldata True           assertBoolM "Must have difference, we return different values" (all (isCex . fst) eq.res)       , test "constructor-same-deployed-diff3" $ do         Just initA <- solidity "C"@@ -4976,7 +5069,7 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s initA initB defaultVeriOpts calldata True+          eq <- equivalenceCheck s Nothing initA initB defaultVeriOpts calldata True           assertBoolM "Must have difference, we return different values" (all (isCex . fst) eq.res)       -- We set x to be 0 on deployment. Default value is also 0. So they are equivalent       -- We cannot deal with symbolic code. However, the below will generate symbolic code,@@ -5009,7 +5102,7 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s initA initB defaultVeriOpts calldata True+          eq <- equivalenceCheck s Nothing initA initB defaultVeriOpts calldata True           assertBoolM "Must have difference" (all (isCex . fst) eq.res)       -- We set x to be 0 on deployment. Default value is also 0. So they are equivalent       , test "constructor-implicit" $ do@@ -5036,8 +5129,9 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s initA initB defaultVeriOpts calldata True-          assertEqualM "Must have no difference" [Qed] (map fst eq.res)+          eq <- equivalenceCheck s Nothing initA initB defaultVeriOpts calldata True+          putStrLnM $ "Equivalence result: " <> show eq+          assertEqualM "Must have no difference" [] (map fst eq.res)       -- We set x to be 3 vs 0 (default) on deployment.       , test "constructor-differing" $ do         Just initA <- solidity "C"@@ -5063,7 +5157,7 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s initA initB defaultVeriOpts calldata True+          eq <- equivalenceCheck s Nothing initA initB defaultVeriOpts calldata True           let cexes = filter (isCex . fst) eq.res           assertBoolM "Must have a difference" (not $ null cexes)       , test "eq-sol-exp-qed" $ do@@ -5089,8 +5183,8 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts calldata False-          assertEqualM "Must have no difference" [Qed] (map fst eq.res)+          eq <- equivalenceCheck s Nothing aPrgm bPrgm defaultVeriOpts calldata False+          assertEqualM "Must have no difference" [] (map fst eq.res)       ,       test "eq-balance-differs" $ do         Just aPrgm <- solcRuntime "C"@@ -5121,7 +5215,7 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts calldata False+          eq <- equivalenceCheck s Nothing aPrgm bPrgm defaultVeriOpts calldata False           assertBoolM "Must differ" (all (isCex . fst) eq.res)       ,       -- TODO: this fails because we don't check equivalence of deployed contracts@@ -5183,8 +5277,8 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts calldata False-          assertBoolM "Must differ" (all (isCex . fst) eq.res)+          eq <- equivalenceCheck s Nothing aPrgm bPrgm defaultVeriOpts calldata False+          assertBoolM "Must differ" (any (isCex . fst) eq.res)       ,       test "eq-unknown-addr" $ do         Just aPrgm <- solcRuntime "C"@@ -5207,7 +5301,7 @@           |]         withSolvers Z3 3 1 Nothing $ \s -> do           cd <- mkCalldata (Just (Sig "a(address,address)" [AbiAddressType, AbiAddressType])) []-          eq <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts cd False+          eq <- equivalenceCheck s Nothing aPrgm bPrgm defaultVeriOpts cd False           assertEqualM "Must be different" (any (isCex . fst) eq.res) True       ,       test "eq-sol-exp-cex" $ do@@ -5233,7 +5327,7 @@           |]         withSolvers Bitwuzla 3 1 Nothing $ \s -> do           calldata <- mkCalldata Nothing []-          eq <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts calldata False+          eq <- equivalenceCheck s Nothing aPrgm bPrgm defaultVeriOpts calldata False           assertEqualM "Must be different" (any (isCex . fst) eq.res) True       ,       test "eq-storage-write-to-static-array-uint128" $ do@@ -5260,8 +5354,8 @@           |]         withSolvers Bitwuzla 1 1 Nothing $ \s -> do           calldata <- mkCalldata (Just (Sig "set(uint256,uint128)" [AbiUIntType 256, AbiUIntType 128])) []-          eq <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts calldata False-          assertEqualM "Must have no difference" [Qed] (map fst eq.res)+          eq <- equivalenceCheck s Nothing aPrgm bPrgm defaultVeriOpts calldata False+          assertEqualM "Must have no difference" [] (map fst eq.res)       ,       test "eq-storage-write-to-static-array-uint8" $ do         Just aPrgm <- solcRuntime "C"@@ -5287,8 +5381,8 @@           |]         withSolvers Bitwuzla 1 1 Nothing $ \s -> do           calldata <- mkCalldata (Just (Sig "set(uint256,uint8)" [AbiUIntType 256, AbiUIntType 8])) []-          eq <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts calldata False-          assertEqualM "Must have no difference" [Qed] (map fst eq.res)+          eq <- equivalenceCheck s Nothing aPrgm bPrgm defaultVeriOpts calldata False+          assertEqualM "Must have no difference" [] (map fst eq.res)       ,       test "eq-storage-write-to-static-array-uint32" $ do         Just aPrgm <- solcRuntime "C"@@ -5314,10 +5408,10 @@           |]         withSolvers Bitwuzla 1 1 Nothing $ \s -> do           calldata <- mkCalldata (Just (Sig "set(uint256,uint32)" [AbiUIntType 256, AbiUIntType 32])) []-          eq <- equivalenceCheck s aPrgm bPrgm defaultVeriOpts calldata False-          assertEqualM "Must have no difference" [Qed] (map fst eq.res)+          eq <- equivalenceCheck s Nothing aPrgm bPrgm defaultVeriOpts calldata False+          assertEqualM "Must have no difference" [] (map fst eq.res)       , test "eq-all-yul-optimization-tests" $ do-        let opts = defaultVeriOpts{ iterConf = defaultIterConf {maxIter = Just 5, askSmtIters = 20, loopHeuristic = Naive }}+        let opts = (defaultVeriOpts :: VeriOpts) { iterConf = defaultIterConf {maxIter = Just 5, askSmtIters = 20, loopHeuristic = Naive }}             ignoredTests =                     -- unbounded loop --                     [ "commonSubexpressionEliminator/branches_for.yul"@@ -5528,7 +5622,7 @@           procs <- liftIO $ getNumProcessors           withSolvers CVC5 (unsafeInto procs) 1 (Just 100) $ \s -> do             calldata <- mkCalldata Nothing []-            eq <- equivalenceCheck s aPrgm bPrgm opts calldata False+            eq <- equivalenceCheck s Nothing aPrgm bPrgm opts calldata False             let res = map fst eq.res             end <- liftIO $ getCurrentTime             case any isCex res of@@ -5578,15 +5672,18 @@  checkEquivBase :: (Eq a, App m) => (a -> a -> Prop) -> a -> a -> Bool -> m (Maybe Bool) checkEquivBase mkprop l r expect = do-  withSolvers Z3 1 1 (Just 1) $ \solvers -> do-     res <- checkSatWithProps solvers [mkprop l r]-     let ret = case res of-           Qed -> Just True-           Cex {} -> Just False-           Error _ -> Just (not expect)-           Unknown _ -> Nothing-     when (ret == Just (not expect)) $ liftIO $ print res-     pure ret+  config <- readConfig+  let noSimplifyEnv = Env {config = config {simp = False}}+  liftIO $ runEnv noSimplifyEnv $ do+    withSolvers Z3 1 1 (Just 1) $ \solvers -> do+      res <- checkSatWithProps solvers [mkprop l r]+      let ret = case res of+            Qed -> Just True+            Cex {} -> Just False+            Error _ -> Just (not expect)+            Unknown _ -> Nothing+      when (ret == Just (not expect)) $ liftIO $ print res+      pure ret  -- | Takes a runtime code and calls it with the provided calldata @@ -5604,7 +5701,7 @@        s -> internalError $ show s  -- | Takes a creation code and returns a vm with the result of executing the creation code-loadVM :: App m => ByteString -> m (Maybe (VM Concrete RealWorld))+loadVM :: App m => ByteString -> m (Maybe (VM Concrete)) loadVM x = do   vm <- liftIO $ stToIO $ vmForEthrunCreation x   vm1 <- Stepper.interpret (Fetch.zero 0 Nothing) vm Stepper.runFully@@ -5670,7 +5767,7 @@     }   |] (abiMethod s (AbiTuple $ V.fromList args)) -getStaticAbiArgs :: Int -> VM Symbolic s -> [Expr EWord]+getStaticAbiArgs :: Int -> VM Symbolic -> [Expr EWord] getStaticAbiArgs n vm =   let cd = vm.state.calldata   in decodeStaticArgs 4 n cd@@ -6031,13 +6128,10 @@ genEnd sz = oneof   [ liftM3 Failure subProp (pure mempty) (fmap Revert subBuf)   , liftM4 Success subProp (pure mempty) subBuf arbitrary-  , liftM3 ITE subWord subEnd subEnd   -- TODO Partial   ]   where     subBuf = defaultBuf (sz `div` 2)-    subWord = defaultWord (sz `div` 2)-    subEnd = genEnd (sz `div` 2)     subProp = genProps False (sz `div` 2)  genWord :: Int -> Int -> Gen (Expr EWord)@@ -6209,8 +6303,8 @@  -- Finds SLoad -> SStore. This should not occur in most scenarios -- as we can simplify them away-badStoresInExpr :: Expr a -> Bool-badStoresInExpr = getAny . foldExpr match mempty+badStoresInExpr :: [Expr a] -> Bool+badStoresInExpr exprs = any (getAny . foldExpr match mempty) exprs   where       match (SLoad _ (SStore _ _ _)) = Any True       match _ = Any False@@ -6260,7 +6354,7 @@ genStorage :: Int -> Gen (Expr Storage) genStorage 0 = oneof   [ liftM2 AbstractStore arbitrary (pure Nothing)-  , fmap ConcreteStore arbitrary+  , fmap ConcreteStore $ resize 5 arbitrary   ] genStorage sz = liftM3 SStore key val subStore   where@@ -6322,7 +6416,7 @@ applyPattern :: String -> TestTree  -> TestTree applyPattern p = localOption (TestPattern (parseExpr p)) -checkBadCheatCode :: Text -> Postcondition s+checkBadCheatCode :: Text -> Postcondition checkBadCheatCode sig _ = \case   (Failure _ c (Revert _)) -> case mapMaybe findBadCheatCode (concatMap flatten c.traces) of     (s:_) -> (ConcreteBuf $ into s.unFunctionSelector) ./= (ConcreteBuf $ selector sig)@@ -6334,20 +6428,19 @@       ErrorTrace (BadCheatCode _ s) -> Just s       _ -> Nothing -allBranchesFail :: App m => ByteString -> Maybe Sig -> m (Either [SMTCex] (Expr End))-allBranchesFail = checkPost (Just p)+allBranchesFail :: App m => ByteString -> Maybe Sig -> m (Either [SMTCex] [Expr End])+allBranchesFail = checkPost p   where     p _ = \case       Success _ _ _ _ -> PBool False       _ -> PBool True -reachableUserAsserts :: App m => ByteString -> Maybe Sig -> m (Either [SMTCex] (Expr End))-reachableUserAsserts = checkPost (Just $ checkAssertions [0x01])+reachableUserAsserts :: App m => ByteString -> Maybe Sig -> m (Either [SMTCex] [Expr End])+reachableUserAsserts = checkPost (checkAssertions [0x01]) -checkPost :: App m => Maybe (Postcondition RealWorld) -> ByteString -> Maybe Sig -> m (Either [SMTCex] (Expr End))+checkPost :: App m => Postcondition -> ByteString -> Maybe Sig -> m (Either [SMTCex] [Expr End]) checkPost post c sig = do-  (e, res) <- withDefaultSolver $ \s ->-    verifyContract s c sig [] defaultVeriOpts Nothing post+  (e, res) <- withDefaultSolver $ \s -> verifyContract s c sig [] defaultVeriOpts Nothing post   let cexs = snd <$> mapMaybe getCex res   case cexs of     [] -> pure $ Right e