From 945c7435a41b93ff243b69f18a9c0216a7b70e24 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Fri, 18 Oct 2019 14:59:56 +0100
Subject: Add -k functionality

---
 src/Verismith.hs        |  4 ++--
 src/Verismith/Fuzz.hs   | 30 ++++++++++++++++++++++++++----
 src/Verismith/Report.hs |  6 +++---
 3 files changed, 31 insertions(+), 9 deletions(-)

diff --git a/src/Verismith.hs b/src/Verismith.hs
index 85deca3..a3d3d03 100644
--- a/src/Verismith.hs
+++ b/src/Verismith.hs
@@ -363,12 +363,12 @@ randomise config@(Config a _ c d e) = do
     ce = config ^. configProbability . probExpr
 
 handleOpts :: Opts -> IO ()
-handleOpts (Fuzz o configF _ _ n) = do
+handleOpts (Fuzz o configF _ k n) = do
     config <- getConfig configF
     _      <- runFuzz
         config
         defaultYosys
-        (fuzzMultiple n (Just $ fromText o) (proceduralSrc "top" config))
+        (fuzzMultiple n k (Just $ fromText o) (proceduralSrc "top" config))
     return ()
 handleOpts (Generate f c) = do
     config <- getConfig c
diff --git a/src/Verismith/Fuzz.hs b/src/Verismith/Fuzz.hs
index 81c00a0..f26630a 100644
--- a/src/Verismith/Fuzz.hs
+++ b/src/Verismith/Fuzz.hs
@@ -402,21 +402,43 @@ relativeFuzzReport fr@(FuzzReport dir _ _ _ _ _ _ _) = liftSh $ do
     newPath <- relPath dir
     return $ (fuzzDir .~ newPath) fr
 
+filterSynth :: SynthResult -> Bool
+filterSynth (SynthResult _ _ (Pass _) _) = True
+filterSynth _                            = False
+
+filterSim :: SimResult -> Bool
+filterSim (SimResult _ _ (Pass _) _) = True
+filterSim _                          = False
+
+filterSynthStat :: SynthStatus -> Bool
+filterSynthStat (SynthStatus _ (Pass _) _) = True
+filterSynthStat _                          = False
+
+passedFuzz :: FuzzReport -> Bool
+passedFuzz (FuzzReport _ synth sim synthstat _ _ _ _) =
+    (passedSynth + passedSim + passedSynthStat) == 0
+  where
+    passedSynth = length $ filter (not . filterSynth) synth
+    passedSim = length $ filter (not . filterSim) sim
+    passedSynthStat = length $ filter (not . filterSynthStat) synthstat
+
 fuzzInDir
-    :: MonadFuzz m => FilePath -> Gen SourceInfo -> Config -> Fuzz m FuzzReport
-fuzzInDir fp src conf = do
+    :: MonadFuzz m => Bool -> FilePath -> Gen SourceInfo -> Config -> Fuzz m FuzzReport
+fuzzInDir k fp src conf = do
     make fp
     res <- pop fp $ fuzz src conf
+    liftSh . when (passedFuzz res && not k) $ rm_rf fp
     relativeFuzzReport res
 
 fuzzMultiple
     :: MonadFuzz m
     => Int
+    -> Bool
     -> Maybe FilePath
     -> Gen SourceInfo
     -> Config
     -> Fuzz m [FuzzReport]
-fuzzMultiple n fp src conf = do
+fuzzMultiple n k fp src conf = do
     x <- case fp of
         Nothing -> do
             ct <- liftIO getZonedTime
@@ -436,7 +458,7 @@ fuzzMultiple n fp src conf = do
             results
         return results
   where
-    fuzzDir' n' = fuzzInDir (fromText $ "fuzz_" <> showT n') src conf
+    fuzzDir' n' = fuzzInDir k (fromText $ "fuzz_" <> showT n') src conf
     seed = conf ^. configProperty . propSeed
 
 sampleSeed :: MonadSh m => Maybe Seed -> Gen a -> m (Seed, a)
diff --git a/src/Verismith/Report.hs b/src/Verismith/Report.hs
index 6c25f5c..f0608f2 100644
--- a/src/Verismith/Report.hs
+++ b/src/Verismith/Report.hs
@@ -192,9 +192,9 @@ instance Show SynthStatus where
 -- | The complete state that will be used during fuzzing, which contains the
 -- results from all the operations.
 data FuzzReport = FuzzReport { _fuzzDir      :: !FilePath
-                             , _synthResults :: ![SynthResult]
-                             , _simResults   :: ![SimResult]
-                             , _synthStatus  :: ![SynthStatus]
+                             , _synthResults :: ![SynthResult] -- ^ Results of the equivalence check.
+                             , _simResults   :: ![SimResult]   -- ^ Results of the simulation.
+                             , _synthStatus  :: ![SynthStatus] -- ^ Results of the synthesis step.
                              , _fileLines    :: {-# UNPACK #-} !Int
                              , _synthTime    :: !NominalDiffTime
                              , _equivTime    :: !NominalDiffTime
-- 
cgit