diff options
author | Yann Herklotz <git@yannherklotz.com> | 2019-05-24 15:09:06 +0100 |
---|---|---|
committer | Yann Herklotz <git@yannherklotz.com> | 2019-05-24 15:09:06 +0100 |
commit | 7e67a69693c4c0964f488d87dd94f64a2efe5409 (patch) | |
tree | 1808675bd621dc1fd95cb50f13b2b2767a5a2732 /src/VeriFuzz | |
parent | 5df5d613e3aaf5f14368903b5fec5596d848ef44 (diff) | |
download | verismith-7e67a69693c4c0964f488d87dd94f64a2efe5409.tar.gz verismith-7e67a69693c4c0964f488d87dd94f64a2efe5409.zip |
Reduction throws away path if it finds a passing one
Diffstat (limited to 'src/VeriFuzz')
-rw-r--r-- | src/VeriFuzz/Fuzz.hs | 4 | ||||
-rw-r--r-- | src/VeriFuzz/Reduce.hs | 35 |
2 files changed, 18 insertions, 21 deletions
diff --git a/src/VeriFuzz/Fuzz.hs b/src/VeriFuzz/Fuzz.hs index b3d76ad..e68fc95 100644 --- a/src/VeriFuzz/Fuzz.hs +++ b/src/VeriFuzz/Fuzz.hs @@ -224,9 +224,9 @@ reduction src = do titleRun :: (MonadIO m, MonadSh m) => Text -> Fuzz m a -> Fuzz m (NominalDiffTime, a) titleRun t f = do - logT $ "--- Starting " <> t <> " ---" + logT $ "### Starting " <> t <> " ###" (diff, res) <- timeit f - logT $ "--- Finished " <> t <> " (" <> showT diff <> ") ---" + logT $ "### Finished " <> t <> " (" <> showT diff <> ") ###" return (diff, res) whenMaybe :: Applicative m => Bool -> m a -> m (Maybe a) diff --git a/src/VeriFuzz/Reduce.hs b/src/VeriFuzz/Reduce.hs index 33cb648..4875e7d 100644 --- a/src/VeriFuzz/Reduce.hs +++ b/src/VeriFuzz/Reduce.hs @@ -502,28 +502,25 @@ reduce_ title repl bot eval src = do (src ^.. infoSrc . _Wrapped . traverse . modItems . traverse) ) <> ")" - replAnswer <- sequenceA $ evalIfNotEmpty <$> replacement - case (replacement, replAnswer) of - (Single s, Single True ) -> runIf s - (Dual _ r, Dual False True) -> runIf r - (Dual l _, Dual True False) -> runIf l - (Dual l r, Dual True True ) -> check l r - _ -> return src + case repl src of + Single s -> do + red <- eval s + if red then runIf s else return s + Dual l r -> do + red <- eval l + if red && cond l + then reduce_ title repl bot eval l + else do + red' <- eval r + if red' && cond r + then reduce_ title repl bot eval r + else if l < r then return l else return r + None -> return src where - replacement = repl src - runIf s = if s /= src && not (bot s) + runIf s = if cond s then reduce_ title repl bot eval s else return s - evalIfNotEmpty = eval - check l r - | bot l = return l - | bot r = return r - | otherwise = do - lreduced <- runIf l - rreduced <- runIf r - if _infoSrc lreduced < _infoSrc rreduced - then return lreduced - else return rreduced + cond s = s /= src && not (bot s) -- | Reduce an input to a minimal representation. It follows the reduction -- strategy mentioned above. |