From 7e67a69693c4c0964f488d87dd94f64a2efe5409 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Fri, 24 May 2019 15:09:06 +0100
Subject: Reduction throws away path if it finds a passing one

---
 src/VeriFuzz/Fuzz.hs   |  4 ++--
 src/VeriFuzz/Reduce.hs | 35 ++++++++++++++++-------------------
 2 files changed, 18 insertions(+), 21 deletions(-)

(limited to 'src')

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.
-- 
cgit