Skip to content

Commit f39dc29

Browse files
committed
Speed up shrinking
1 parent e72975c commit f39dc29

File tree

1 file changed

+25
-2
lines changed

1 file changed

+25
-2
lines changed

lib/Echidna/ABI.hs

Lines changed: 25 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
module Echidna.ABI where
22

33
import Control.Monad (liftM2, liftM3, foldM, replicateM)
4-
import Control.Monad.Random.Strict (MonadRandom, join, getRandom, getRandoms, getRandomR)
4+
import Control.Monad.Random.Strict (MonadRandom, join, getRandom, getRandoms, getRandomR, uniform, fromList)
55
import Control.Monad.Random.Strict qualified as Random
66
import Data.Binary.Put (runPut, putWord32be)
77
import Data.BinaryWord (unsignedWord)
@@ -274,7 +274,30 @@ shrinkAbiValue = \case
274274

275275
-- | Given a 'SolCall', generate a random \"smaller\" (simpler) call.
276276
shrinkAbiCall :: MonadRandom m => SolCall -> m SolCall
277-
shrinkAbiCall = traverse $ traverse shrinkAbiValue
277+
shrinkAbiCall (name, vals) = do
278+
let numShrinkable = length $ filter canShrinkAbiValue vals
279+
280+
halfwayVal <- getRandomR (0, numShrinkable)
281+
-- This list was made arbitrarily. Feel free to change
282+
let numToShrinkOptions = [1, 2, halfwayVal, numShrinkable]
283+
284+
numToShrink <- min numShrinkable <$> uniform numToShrinkOptions
285+
shrunkVals <- shrinkVals (fromIntegral numShrinkable) (fromIntegral numToShrink) vals
286+
pure (name, shrunkVals)
287+
where
288+
shrinkVals _ 0 l = pure l
289+
shrinkVals _ _ [] = pure []
290+
shrinkVals numShrinkable numToShrink (h:t)
291+
| not (canShrinkAbiValue h) = (h:) <$> shrinkVals numShrinkable numToShrink t
292+
| otherwise = do
293+
-- We want to pick which ones to shrink uniformly from the vals list.
294+
-- Odds of shrinking one element is numToShrink/numShrinkable.
295+
shouldShrink <- fromList [(True, numToShrink), (False, numShrinkable-numToShrink)]
296+
h' <- if shouldShrink then shrinkAbiValue h else pure h
297+
let
298+
numShrinkable' = numShrinkable-1
299+
numToShrink' = if shouldShrink then numToShrink-1 else numToShrink
300+
(h':) <$> shrinkVals numShrinkable' numToShrink' t
278301

279302
-- | Given an 'AbiValue', generate a random \"similar\" value of the same 'AbiType'.
280303
mutateAbiValue :: MonadRandom m => AbiValue -> m AbiValue

0 commit comments

Comments
 (0)