diff options
| author | Yann Herklotz <git@yannherklotz.com> | 2019-05-25 21:20:51 +0100 |
|---|---|---|
| committer | Yann Herklotz <git@yannherklotz.com> | 2019-05-25 21:23:48 +0100 |
| commit | 4fba97ba3a19c725714b5d55721368657e41daa3 (patch) | |
| tree | 134d98c4094e33d8abc1fd31ad4c880bb65f7bc7 | |
| parent | 0a45b7d0cfa76e8a543bc2ddffe7d4e56aaae93a (diff) | |
| download | verismith-4fba97ba3a19c725714b5d55721368657e41daa3.tar.gz verismith-4fba97ba3a19c725714b5d55721368657e41daa3.zip | |
Add synthesis fails to fuzzer
| -rw-r--r-- | src/VeriFuzz/Fuzz.hs | 16 | ||||
| -rw-r--r-- | src/VeriFuzz/Reduce.hs | 1 |
2 files changed, 17 insertions, 0 deletions
diff --git a/src/VeriFuzz/Fuzz.hs b/src/VeriFuzz/Fuzz.hs index f85ab1f..3f6a14b 100644 --- a/src/VeriFuzz/Fuzz.hs +++ b/src/VeriFuzz/Fuzz.hs @@ -132,6 +132,13 @@ passedSynthesis = fmap toSynth . filter passed . _fuzzSynthStatus <$> get passed _ = False toSynth (SynthStatus s _ _) = s +failedSynthesis :: MonadSh m => Fuzz m [SynthTool] +failedSynthesis = fmap toSynth . filter failed . _fuzzSynthStatus <$> get + where + failed (SynthStatus _ (Fail SynthFail) _) = True + failed _ = False + toSynth (SynthStatus s _ _) = s + make :: MonadSh m => FilePath -> m () make f = liftSh $ do mkdir_p f @@ -210,7 +217,9 @@ failEquivWithIdentity = filter withIdentity . _fuzzSynthResults <$> get reduction :: (MonadSh m) => SourceInfo -> Fuzz m () reduction src = do fails <- failEquivWithIdentity + synthFails <- failedSynthesis _ <- liftSh $ mapM red fails + _ <- liftSh $ mapM redSynth synthFails return () where red (SynthResult a b _ _) = do @@ -220,6 +229,13 @@ reduction src = do writefile (fromText ".." </> dir <.> "v") $ genSource s return s where dir = fromText $ "reduce_" <> toText a <> "_" <> toText b + redSynth (SynthStatus a _ _) = do + make dir + pop dir $ do + s <- reduceSynthesis a src + writefile (fromText ".." </> dir <.> "v") $ genSource s + return s + where dir = fromText $ "reduce_" <> toText a titleRun :: (MonadIO m, MonadSh m) => Text -> Fuzz m a -> Fuzz m (NominalDiffTime, a) diff --git a/src/VeriFuzz/Reduce.hs b/src/VeriFuzz/Reduce.hs index 0ecde3f..b025a42 100644 --- a/src/VeriFuzz/Reduce.hs +++ b/src/VeriFuzz/Reduce.hs @@ -17,6 +17,7 @@ module VeriFuzz.Reduce ( -- $strategy reduceWithScript , reduceSynth + , reduceSynthesis , reduce , reduce_ , Replacement(..) |