aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorYann Herklotz <git@yannherklotz.com>2019-05-24 15:09:06 +0100
committerYann Herklotz <git@yannherklotz.com>2019-05-24 15:09:06 +0100
commit7e67a69693c4c0964f488d87dd94f64a2efe5409 (patch)
tree1808675bd621dc1fd95cb50f13b2b2767a5a2732
parent5df5d613e3aaf5f14368903b5fec5596d848ef44 (diff)
downloadverismith-7e67a69693c4c0964f488d87dd94f64a2efe5409.tar.gz
verismith-7e67a69693c4c0964f488d87dd94f64a2efe5409.zip
Reduction throws away path if it finds a passing one
-rw-r--r--src/VeriFuzz/Fuzz.hs4
-rw-r--r--src/VeriFuzz/Reduce.hs35
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.