From ed8e68ef135c6081bbfa7b212772a5b78394447e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Thu, 11 Jun 2026 12:10:20 -0300 Subject: [PATCH 1/5] Collapse suspended VM state in stored test VMs and event payloads Lens-based execution leaves VM record fields (contract storage maps, keccak preimages, constraints, logs) as thunk chains referencing every intermediate VM of a replayed sequence. Storing such a VM -- in EchidnaTest.vm on falsification/optimization progress and on every successful shrink step -- retains the whole execution history until the field is demanded, which reporting only does once at campaign end. The interactive UI's periodic test snapshots observe these chains continuously, where they accounted for hundreds of MB of standing heap (retainer profiling: addAliasConstraints/accessUnboundedMemory sets; forcing cut the standing Map.Bin census band from 298 MB to 63 MB on a 20-failing-test benchmark). Add forceVMData to collapse the accumulating fields when a VM is about to be stored, and force NewCoverage.transactions so queued/retained events no longer pin each sequence's VMResults and returndata through the `fst <$> results` thunk. Co-Authored-By: Claude --- lib/Echidna/Campaign.hs | 9 ++++++++- lib/Echidna/Exec.hs | 26 ++++++++++++++++++++++++++ lib/Echidna/Shrink.hs | 4 ++++ 3 files changed, 38 insertions(+), 1 deletion(-) diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index b0a9401be..91b4042d5 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -484,7 +484,10 @@ callseq vm txSeq = do pushWorkerEvent NewCoverage { points , numCodehashes , corpusSize = newSize - , transactions = fst <$> results + -- force the list so the event doesn't hold a + -- thunk pinning every VMResult (and its + -- returndata) of the executed sequence + , transactions = force $ fst <$> results } modify' $ \workerState -> @@ -638,6 +641,9 @@ updateOpenTest vm reproducer test = do case testValue of BoolValue False -> do workerId <- Just <$> gets (.workerId) + -- collapse the suspended execution state before storing the VM, + -- otherwise the stored thunks retain every intermediate VM + let !_ = forceVMData vm let test' = test { Test.state = Large 0 , reproducer , vm = Just vm @@ -648,6 +654,7 @@ updateOpenTest vm reproducer test = do pure $ Just test' IntValue value' | value' > value -> do + let !_ = forceVMData vm let test' = test { reproducer , value = IntValue value' , vm = Just vm diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index 7d02e052b..27572a22e 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -14,6 +14,7 @@ import Data.ByteString qualified as BS import Data.IORef (readIORef, newIORef, writeIORef, modifyIORef') import Data.Map qualified as Map import Data.Maybe (fromMaybe, fromJust) +import Data.Set qualified as Set import Data.Text qualified as T import Data.Vector qualified as V import Data.Vector.Unboxed.Mutable qualified as VMut @@ -323,3 +324,28 @@ initialVM ffi = do & #block % #number .~ Lit initialBlockNumber & #env % #contracts .~ mempty -- fixes weird nonce issues & #config % #allowFFI .~ ffi + +-- | Force the parts of a VM that accumulate suspended computation during +-- execution. Lens-based state updates leave record fields as thunk chains +-- referencing every intermediate VM of the run; storing such a VM (e.g. in +-- 'EchidnaTest.vm' on falsification or per shrink step) would otherwise +-- retain the whole execution history until the field is demanded -- which +-- reporting only does once at campaign end, and the interactive UI's +-- periodic test snapshots turn into gigabytes of standing heap. +forceVMData :: VM Concrete -> () +forceVMData vm = + contractsWhnf `seq` + storesWhnf `seq` + Set.size vm.keccakPreImgs `seq` + length vm.constraints `seq` + length vm.logs `seq` + vm.burned `seq` + () + where + contractsWhnf = Map.size vm.env.contracts + storesWhnf = + Map.foldl' (\acc c -> acc + storeSize c.storage + storeSize c.origStorage) + (0 :: Int) vm.env.contracts + storeSize :: Expr Storage -> Int + storeSize (ConcreteStore m) = Map.size m + storeSize _ = 0 diff --git a/lib/Echidna/Shrink.hs b/lib/Echidna/Shrink.hs index e345a8702..30b4da1ae 100644 --- a/lib/Echidna/Shrink.hs +++ b/lib/Echidna/Shrink.hs @@ -44,6 +44,10 @@ shrinkTest vm test = do pure $ case maybeShrunk of -- the test still fails, let's create another test with the reduced sequence Just (txs, val, vm') -> do + -- collapse the suspended execution state before storing the + -- VM, otherwise the stored thunks retain every intermediate + -- VM of the replayed sequence until the next shrink step + let !_ = forceVMData vm' Just test { state = Large (i + 1) , reproducer = txs , vm = Just vm' From 60971e3e59c887dafe2bce76f04a0cec0698a293 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Thu, 11 Jun 2026 12:10:22 -0300 Subject: [PATCH 2/5] Bound interactive UI memory retention The Brick UI retained large amounts of heap on long campaigns; with 20 always-failing tests the same workload that holds a flat 12.9 MB in --format text reached 915 MB live (4.2 GB peak residency) and kept growing for the whole interactive session. Several compounding causes, each measured with heap censuses and cost-centre/retainer profiles: - The 200 ms ticker queued CampaignUpdated events carrying full [EchidnaTest]/[WorkerState] snapshots; with a slow consumer the bounded-at-1000 channel could pin up to a thousand snapshot generations. Publish the snapshot through an always-latest IORef and send a payload-free CampaignTick instead (stale ticks drop harmlessly). - The tests pane was rebuilt on every tick, allocating ppTx/trace pretty-printing structures per test per 200 ms which accumulate; with --shrink-limit 0 this leaked 1.6 MB/s indefinitely (527 MB after 6 min vs 35 MB after this change). Cache the pane keyed on a cheap (state, value) digest and rate-limit rebuilds to once per second. - Widget and state structures captured test records (and their VM snapshots) through unevaluated show/format thunks; force the rendered strings and store a VM-free copy of the tests in UIState. - The log pane history was an unbounded Seq, also rendered with an O(n) fold per frame; cap it at 5000 entries. - Sever the previous campaignWidget before building the new one and replace the state strictly (WHNF) so superseded generations don't chain through widget closures or lazy modify. A residual remains on the always-failing stress workload: data created during the falsification/shrink burst (~700 MB) stays reachable through closures inside brick's customMainWithVty event loop (retainer sets "(N)customMainWithVty,m..."), surviving all application-side stripping; pinning it down needs ghc-debug-grade tooling. Typical campaigns with few failing tests are unaffected by that residual. Co-Authored-By: Claude --- lib/Echidna/UI.hs | 103 ++++++++++++++++++++++++++++++-------- lib/Echidna/UI/Widgets.hs | 33 +++++++++--- 2 files changed, 109 insertions(+), 27 deletions(-) diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs index 16987c60e..8eb023fe5 100644 --- a/lib/Echidna/UI.hs +++ b/lib/Echidna/UI.hs @@ -17,6 +17,7 @@ import Data.List.Split (splitPlaces) import Data.Map (Map) import Data.Maybe (isJust, mapMaybe) import Data.Sequence ((|>)) +import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Time import Graphics.Vty qualified as Vty @@ -51,11 +52,28 @@ import Echidna.Utility (timePrefix, getTimestamp) import Echidna.Worker (getNWorkers, workerIDToType) data UIEvent = - CampaignUpdated LocalTime [EchidnaTest] [WorkerState] - | FetchCacheUpdated (Map Addr (Maybe Contract)) - (Map Addr (Map W256 (Maybe W256))) + CampaignTick | EventReceived (LocalTime, CampaignEvent) +-- | Latest campaign snapshot, read by the UI when handling 'CampaignTick'. +-- It is deliberately kept in an IORef instead of being carried inside the +-- event queue: queued payloads would pin one '[EchidnaTest]' generation +-- (each with full VM snapshots) per tick whenever the render loop falls +-- behind the producer, retaining gigabytes during shrinking. With an IORef +-- at most one generation is ever reachable. +type UISnapshot = + ( LocalTime + , [EchidnaTest] + , [WorkerState] + , Map Addr (Maybe Contract) + , Map Addr (Map W256 (Maybe W256)) + ) + +-- | Bound for the log pane history; it is also rendered with an O(n) fold, +-- so an unbounded sequence would grow both heap and frame time forever. +maxUILogEvents :: Int +maxUILogEvents = 5000 + -- | Gas tracking state for calculating gas consumption rate data GasTracker = GasTracker { lastUpdateTime :: LocalTime @@ -112,17 +130,20 @@ ui vm dict initialCorpus cliSelectedContract = do uiEventsForwarderStopVar <- spawnListener forwardEvent workers <- spawnWorkers + snapshotRef <- liftIO $ newIORef (Nothing :: Maybe UISnapshot) ticker <- liftIO . forkIO . forever $ do threadDelay 200_000 -- 200 ms now <- getTimestamp tests <- traverse readIORef env.testRefs states <- workerStates workers - writeBChan uiChannel (CampaignUpdated now tests states) - -- TODO: remove and use events for this (c, s) <- EVM.Fetch.getCacheState env.fetchSession - writeBChan uiChannel (FetchCacheUpdated c s) + -- publish the snapshot out-of-band and only signal via the queue; + -- dropping the tick when the queue is full is fine, the next handled + -- tick reads the freshest snapshot anyway + writeIORef snapshotRef $ Just (now, tests, states, c, s) + void $ writeBChanNonBlocking uiChannel CampaignTick -- UI initialization let buildVty = do @@ -132,7 +153,7 @@ ui vm dict initialCorpus cliSelectedContract = do Vty.setMode output Vty.Mouse True pure v initialVty <- liftIO buildVty - app <- customMain initialVty buildVty (Just uiChannel) <$> monitor + app <- customMain initialVty buildVty (Just uiChannel) <$> monitor snapshotRef liftIO $ do tests <- traverse readIORef env.testRefs @@ -158,6 +179,9 @@ ui vm dict initialCorpus cliSelectedContract = do , numCodehashes = 0 , lastNewCov = now , tests + , testsPane = emptyWidget + , testsPaneDigest = [] + , testsPaneBuilt = now , campaignWidget = emptyWidget -- temporary, will be overwritten below } initialCampaignWidget <- runReaderT (campaignStatus uiState) env @@ -294,8 +318,8 @@ vtyConfig = do ] } -- | Check if we should stop drawing (or updating) the dashboard, then do the right thing. -monitor :: MonadReader Env m => m (App UIState UIEvent Name) -monitor = do +monitor :: MonadReader Env m => IORef (Maybe UISnapshot) -> m (App UIState UIEvent Name) +monitor snapshotRef = do let drawUI :: UIState -> [Widget Name] drawUI uiState = @@ -323,18 +347,57 @@ monitor = do LogPane -> viewportScroll LogViewPort onEvent env = \case - AppEvent (CampaignUpdated now tests c') -> do - state <- get - let updatedState = state { campaigns = c', status = Running, now, tests } - newWidget <- liftIO $ runReaderT (campaignStatus updatedState) env - -- intentionally using lazy modify here, so unnecessary widget states don't get computed - modify $ const updatedState { campaignWidget = newWidget } - AppEvent (FetchCacheUpdated contracts slots) -> - modify' $ \state -> - state { fetchedContracts = contracts - , fetchedSlots = slots } + AppEvent CampaignTick -> + liftIO (readIORef snapshotRef) >>= \case + Nothing -> pure () + Just (now, tests, c', contracts, slots) -> do + state <- get + -- rebuild the tests pane only when a test actually changed: + -- rebuilding allocates pretty-printing structures (ppTx, traces) + -- per test that have been observed to accumulate unboundedly + -- when reconstructed on every 200 ms tick + let digest = (\t -> (show t.state, t.value)) <$> tests + -- also rate-limit rebuilds: during shrinking the digest changes + -- on every step, and superseded pane structures are retained, + -- so rebuild at most once a second + (testsPane, testsPaneBuilt) <- + if digest == state.testsPaneDigest + || diffLocalTime now state.testsPaneBuilt < 1 + then pure (state.testsPane, state.testsPaneBuilt) + else do + w <- liftIO $ runReaderT (testsWidget tests) env + pure (w, now) + -- sever the previous widget before building the new one: widget + -- render closures capture this state record, and if it still + -- referenced the previous campaignWidget every tick would chain + -- to the one before it, pinning each generation's tests (and + -- their VM snapshots) for the whole session + -- store a VM-free copy: brick's event loop has been observed to + -- chain superseded state generations internally, and each VM + -- snapshot reachable from them would be pinned (the tests pane + -- above is built from the VM-bearing snapshot and renders to + -- forced strings, so nothing else needs the VMs here) + let strippedTests = (\t -> t { vm = Nothing } :: EchidnaTest) <$> tests + let updatedState = state { campaigns = c', status = Running, now + , tests = strippedTests + , fetchedContracts = contracts + , fetchedSlots = slots + , testsPane + , testsPaneDigest = digest + , testsPaneBuilt + , campaignWidget = emptyWidget } + newWidget <- liftIO $ runReaderT (campaignStatus updatedState) env + -- strict in the record (WHNF) so ticks don't chain unevaluated + -- state generations when rendering can't keep up; the widget + -- body itself stays lazy, so unnecessary widget states still + -- don't get computed + modify' $ const updatedState { campaignWidget = newWidget } AppEvent (EventReceived event@(time,campaignEvent)) -> do - modify' $ \state -> state { events = state.events |> event } + -- bounded log history: drop the oldest entry once at capacity + modify' $ \state -> + state { events = (if Seq.length state.events >= maxUILogEvents + then Seq.drop 1 state.events + else state.events) |> event } case campaignEvent of WorkerEvent _ _ (NewCoverage { points, numCodehashes, corpusSize }) -> diff --git a/lib/Echidna/UI/Widgets.hs b/lib/Echidna/UI/Widgets.hs index ad9cc5214..bf66c4aa4 100644 --- a/lib/Echidna/UI/Widgets.hs +++ b/lib/Echidna/UI/Widgets.hs @@ -7,6 +7,7 @@ import Brick.AttrMap qualified as A import Brick.Widgets.Border import Brick.Widgets.Center import Brick.Widgets.Dialog qualified as B +import Control.DeepSeq (force) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (MonadReader, asks, ask) import Data.List (nub, intersperse, sortBy) @@ -65,6 +66,17 @@ data UIState = UIState , campaignWidget :: Widget Name -- ^ Pre-computed widget to avoid IO in drawing + , testsPane :: Widget Name + -- ^ Cached tests pane; rebuilt only when 'testsPaneDigest' changes. + -- Rebuilding it on every tick allocates ppTx/trace pretty-printing + -- structures per test per 200 ms that accumulate into an unbounded heap + -- on long interactive runs. + , testsPaneDigest :: [(String, TestValue)] + -- ^ Cheap fingerprint (state + value per test) of the cached tests pane + , testsPaneBuilt :: LocalTime + -- ^ When the cached tests pane was built; rebuilds are rate-limited + -- because superseded widget structures are observed to be retained + , tests :: [EchidnaTest] } @@ -108,7 +120,7 @@ data Name -- | Render 'Campaign' progress as a 'Widget'. campaignStatus :: (MonadReader Env m, MonadIO m) => UIState -> m (Widget Name) campaignStatus uiState = do - tests <- testsWidget uiState.tests + let tests = uiState.testsPane if uiState.workersAlive == 0 then mainbox tests (finalStatus "Campaign complete, C-c or esc to exit") @@ -349,7 +361,9 @@ tracesWidget vm = do -- TODO: showTraceTree does coloring with ANSI escape codes, we need to strip -- those because they break the Brick TUI. Fix in hevm so we can display -- colors here as well. - let traces = stripAnsiEscapeCodes $ showTraceTree dappInfo vm + -- strict: the rendered text must not stay a thunk over the VM, since the + -- produced widget can be retained well past this VM's lifetime + let !traces = force $ stripAnsiEscapeCodes $ showTraceTree dappInfo vm pure $ if T.null traces then str "" else str "Traces" <+> str ":" <=> txtBreak traces @@ -369,8 +383,11 @@ failWidget b test = do let vm = fromJust test.vm s <- seqWidget vm test.reproducer traces <- tracesWidget vm + -- strict: don't let the widget capture the test record (and its VM) + -- through unevaluated show/format thunks + let !resultStr = force (" with " ++ show test.result) pure - ( failureBadge <+> str (" with " ++ show test.result) + ( failureBadge <+> str resultStr , shrinkWidget b test <=> titleWidget <=> s <=> str " " <=> traces ) @@ -411,15 +428,17 @@ shrinkWidget b test = case b of Nothing -> emptyWidget Just (n,m) -> - str "Current action: " <+> - withAttr (attrName "working") - (str ("shrinking " ++ progress n m ++ showWorker)) + -- strict: don't capture the test record through the format thunk + let !line = force ("shrinking " ++ progress n m ++ showWorker) + in str "Current action: " <+> withAttr (attrName "working") (str line) where showWorker = maybe "" (\i -> " (worker " <> show i <> ")") test.workerId seqWidget :: (MonadReader Env m, MonadIO m) => VM Concrete -> [Tx] -> m (Widget Name) seqWidget vm xs = do - ppTxs <- mapM (ppTx vm $ length (nub $ (.src) <$> xs) /= 1) xs + -- strict: pretty-printed transactions must not stay thunks over the VM, + -- since the produced widget can be retained well past this VM's lifetime + ppTxs <- force <$> mapM (ppTx vm $ length (nub $ (.src) <$> xs) /= 1) xs let ordinals = str . printf "%d. " <$> [1 :: Int ..] pure $ foldl (<=>) emptyWidget $ From 45569a15bcc4397463a9e360bd94f4b9ee5d9f37 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Thu, 11 Jun 2026 12:10:22 -0300 Subject: [PATCH 3/5] Sever UI-state generation retention via vty lastPicRef The interactive (Brick/vty) UI retained one UIState generation per rendered frame, unbounded: vty parks the last Picture in an IORef (lastPicRef) for resize redraws, and Brick builds that Picture lazily -- its image/viewport nodes are renderFinal/viewportScroll thunks closing over the UIState they were rendered from, which through the prior render closes over the previous UIState. The single unforced Picture is thus a thunk chain reaching back through every frame, pinning each generation's campaigns/WorkerState/GenDict and (on falsifying contracts) its test VM snapshots. ghc-debug on a live process showed a single retainer path with 788 chained renderFinal/viewportScroll thunk pairs off lastPicRef. Measured: +12 kB/s unbounded on a trivial non-falsifying contract (interactive), and 681 MB pinned on a 20-failing-assert stress contract. Fixes: - UI.hs: deep-force each Picture before handing it to vty, so lastPicRef holds concrete images instead of a UIState-closing thunk chain (primary). - UI.hs: force the VM-stripped test copies; `t { vm = Nothing }` was a thunk retaining the VM-bearing original. - Campaign.hs: bind NewCoverage.transactions strictly; `force (...)` on a non-strict field was itself a thunk pinning the sequence's VMResults. - Exec.hs: forceVMData now also forces vm.tx.subState, whose lazily-consed Expr EAddr elements otherwise chain a stored VM to every intermediate VM of its transaction. Validated: trivial-contract interactive growth +12,071 -> +517 B/s (UIState generation growth +4.1 MB -> +0); stress-contract live heap 681 -> 39 MB flat; ghc-debug generation chain 788 -> 0. --- lib/Echidna/Campaign.hs | 10 ++++++---- lib/Echidna/Exec.hs | 16 ++++++++++++++++ lib/Echidna/UI.hs | 13 ++++++++++++- 3 files changed, 34 insertions(+), 5 deletions(-) diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index 91b4042d5..9f79fedae 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -481,13 +481,15 @@ callseq vm txSeq = do in (corp', corpusSize corp') (points, numCodehashes) <- liftIO $ coverageStats env.coverageRefInit env.coverageRefRuntime + -- force the list eagerly: `transactions` is a non-strict field, so a + -- lazy `force (...)` is itself stored as a thunk that pins every + -- VMResult (and its returndata) of the executed sequence until some + -- consumer demands it -- and none does under the default config + let !transactions = force $ fst <$> results pushWorkerEvent NewCoverage { points , numCodehashes , corpusSize = newSize - -- force the list so the event doesn't hold a - -- thunk pinning every VMResult (and its - -- returndata) of the executed sequence - , transactions = force $ fst <$> results + , transactions } modify' $ \workerState -> diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index 27572a22e..22f3a7e47 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -336,12 +336,28 @@ forceVMData :: VM Concrete -> () forceVMData vm = contractsWhnf `seq` storesWhnf `seq` + subStateWhnf `seq` Set.size vm.keccakPreImgs `seq` length vm.constraints `seq` length vm.logs `seq` vm.burned `seq` () where + -- the substate's list elements are pushed lazily (hevm's pushTo conses + -- an unevaluated Expr EAddr closing over the mid-execution VM), so a + -- stored VM otherwise chains to every intermediate VM of its + -- transaction; Set elements are already forced by Ord on insert, but + -- the suspended inserts still need their spines demanded via size + subStateWhnf = + let ss = vm.tx.subState + whnfElems = foldl (\u x -> x `seq` u) () + in whnfElems ss.selfdestructs `seq` + whnfElems ss.touchedAccounts `seq` + whnfElems (map fst ss.refunds) `seq` + Set.size ss.accessedAddresses `seq` + Set.size ss.accessedStorageKeys `seq` + Set.size ss.createdContracts `seq` + () contractsWhnf = Map.size vm.env.contracts storesWhnf = Map.foldl' (\acc c -> acc + storeSize c.storage + storeSize c.origStorage) diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs index 8eb023fe5..7730ba853 100644 --- a/lib/Echidna/UI.hs +++ b/lib/Echidna/UI.hs @@ -7,6 +7,7 @@ import Brick.BChan import Brick.Widgets.Dialog qualified as B import Control.Concurrent (killThread, threadDelay) import Control.Concurrent.MVar (readMVar) +import Control.DeepSeq (deepseq) import Control.Exception (AsyncException) import Control.Monad import Control.Monad.Catch @@ -151,7 +152,12 @@ ui vm dict initialCorpus cliSelectedContract = do let output = Vty.outputIface v when (Vty.supportsMode output Vty.Mouse) $ Vty.setMode output Vty.Mouse True - pure v + -- deep-force every picture before it reaches vty: brick's + -- renderFinal composes pictures lazily and threads suspended + -- viewport state across renders, so the picture parked in + -- vty's lastPicRef otherwise grows a thunk chain that pins + -- one UI state generation (and its test snapshots) per render + pure v { Vty.update = \pic -> pic `deepseq` Vty.update v pic } initialVty <- liftIO buildVty app <- customMain initialVty buildVty (Just uiChannel) <$> monitor snapshotRef @@ -377,7 +383,12 @@ monitor snapshotRef = do -- snapshot reachable from them would be pinned (the tests pane -- above is built from the VM-bearing snapshot and renders to -- forced strings, so nothing else needs the VMs here) + -- the stripped copies must be forced: each `t { vm = Nothing }` + -- is itself a thunk retaining the VM-bearing original until + -- evaluated, and nothing in the render path demands the list + -- elements let strippedTests = (\t -> t { vm = Nothing } :: EchidnaTest) <$> tests + !_ = foldl (\u t -> t `seq` u) () strippedTests let updatedState = state { campaigns = c', status = Running, now , tests = strippedTests , fetchedContracts = contracts From ba30efd1a3ac68f2d2ab2763e2ed23489a52c6a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Thu, 11 Jun 2026 12:10:22 -0300 Subject: [PATCH 4/5] Fix hlint: replace lambdas with flip seq --- lib/Echidna/Exec.hs | 2 +- lib/Echidna/UI.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lib/Echidna/Exec.hs b/lib/Echidna/Exec.hs index 22f3a7e47..6326f7ab9 100644 --- a/lib/Echidna/Exec.hs +++ b/lib/Echidna/Exec.hs @@ -350,7 +350,7 @@ forceVMData vm = -- the suspended inserts still need their spines demanded via size subStateWhnf = let ss = vm.tx.subState - whnfElems = foldl (\u x -> x `seq` u) () + whnfElems = foldl (flip seq) () in whnfElems ss.selfdestructs `seq` whnfElems ss.touchedAccounts `seq` whnfElems (map fst ss.refunds) `seq` diff --git a/lib/Echidna/UI.hs b/lib/Echidna/UI.hs index 7730ba853..9489b103e 100644 --- a/lib/Echidna/UI.hs +++ b/lib/Echidna/UI.hs @@ -388,7 +388,7 @@ monitor snapshotRef = do -- evaluated, and nothing in the render path demands the list -- elements let strippedTests = (\t -> t { vm = Nothing } :: EchidnaTest) <$> tests - !_ = foldl (\u t -> t `seq` u) () strippedTests + !_ = foldl (flip seq) () strippedTests let updatedState = state { campaigns = c', status = Running, now , tests = strippedTests , fetchedContracts = contracts From 12cf29da4675580d628c6c4208ec8449d1591f0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emilio=20L=C3=B3pez?= Date: Thu, 11 Jun 2026 12:10:23 -0300 Subject: [PATCH 5/5] Force test result strictly where the test is stored updateOpenTest binds result = getResultFromVM vm' lazily; EchidnaTest.result is a lazy field, so every falsified or optimized test stored in testRefs -- and every VM-free copy pushed as a TestFalsified/TestOptimized event -- retained the unevaluated thunk and with it the full post-checkETest VM, one extra VM snapshot per test. Force the result in the two branches that store it. The binding itself must stay lazy: on the fall-through path checkETest can return a VM with no result, and forcing there crashes the worker (getResultFromVM calls error). Same hygiene bang in shrinkTest. --- lib/Echidna/Campaign.hs | 6 ++++++ lib/Echidna/Shrink.hs | 3 ++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lib/Echidna/Campaign.hs b/lib/Echidna/Campaign.hs index 9f79fedae..f0a30fb90 100644 --- a/lib/Echidna/Campaign.hs +++ b/lib/Echidna/Campaign.hs @@ -639,6 +639,10 @@ updateOpenTest vm reproducer test = do case test.state of Open -> do (testValue, vm') <- checkETest test vm + -- forced in the branches that store it so the stored test (and its + -- VM-free event copies) does not retain vm' through an unevaluated + -- selector; must stay unevaluated on the fall-through path where + -- vm' may carry no result let result = getResultFromVM vm' case testValue of BoolValue False -> do @@ -646,6 +650,7 @@ updateOpenTest vm reproducer test = do -- collapse the suspended execution state before storing the VM, -- otherwise the stored thunks retain every intermediate VM let !_ = forceVMData vm + let !_ = result let test' = test { Test.state = Large 0 , reproducer , vm = Just vm @@ -657,6 +662,7 @@ updateOpenTest vm reproducer test = do IntValue value' | value' > value -> do let !_ = forceVMData vm + let !_ = result let test' = test { reproducer , value = IntValue value' , vm = Just vm diff --git a/lib/Echidna/Shrink.hs b/lib/Echidna/Shrink.hs index 30b4da1ae..f569ca163 100644 --- a/lib/Echidna/Shrink.hs +++ b/lib/Echidna/Shrink.hs @@ -48,10 +48,11 @@ shrinkTest vm test = do -- VM, otherwise the stored thunks retain every intermediate -- VM of the replayed sequence until the next shrink step let !_ = forceVMData vm' + !shrunkResult = getResultFromVM vm' Just test { state = Large (i + 1) , reproducer = txs , vm = Just vm' - , result = getResultFromVM vm' + , result = shrunkResult , value = val } Nothing -> -- The test passed, so no success with shrinking this time, just bump number of tries to shrink