From 8cab5bfe71157c907ca51ac56fef45ccd6c3229b Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Mon, 13 May 2019 14:58:48 +0100 Subject: Add reduction for the commandline --- src/VeriFuzz.hs | 27 ++++++------ src/VeriFuzz/Reduce.hs | 113 ++++++++++++++++++++++++++++++++++++------------- 2 files changed, 97 insertions(+), 43 deletions(-) diff --git a/src/VeriFuzz.hs b/src/VeriFuzz.hs index 6bf1f1c..0d749db 100644 --- a/src/VeriFuzz.hs +++ b/src/VeriFuzz.hs @@ -78,8 +78,9 @@ data Opts = Fuzz { fuzzOutput :: {-# UNPACK #-} !Text } | Parse { fileName :: {-# UNPACK #-} !FilePath } - | Reduce { fileName :: {-# UNPACK #-} !FilePath - , top :: {-# UNPACK #-} !Text + | Reduce { fileName :: {-# UNPACK #-} !FilePath + , top :: {-# UNPACK #-} !Text + , reduceScript :: {-# UNPACK #-} !FilePath } | ConfigOpt { writeConfig :: !(Maybe FilePath) , configFile :: !(Maybe FilePath) @@ -176,8 +177,14 @@ reduceOpts = <> metavar "TOP" <> help "Name of top level module." <> showDefault - <> value "main" + <> value "top" ) + <*> (strOption + $ long "script" + <> short 's' + <> metavar "SCRIPT" + <> help "Script that determines if the current file is interesting, which is determined by the script returning 0." + ) configOpts :: Parser Opts configOpts = @@ -321,20 +328,12 @@ handleOpts (Generate f c) = do (flip T.writeFile $ genSource source) $ T.unpack . toTextIgnore <$> f handleOpts (Parse f) = do - verilogSrc <- readFile file - case parseVerilog file verilogSrc of + verilogSrc <- T.readFile file + case parseVerilog (T.pack file) verilogSrc of Left l -> print l Right v -> print $ GenVerilog v where file = T.unpack . toTextIgnore $ f -handleOpts (Reduce f t) = do - verilogSrc <- readFile file - case parseVerilog file verilogSrc of - Left l -> print l - Right v -> do - writeFile "main.v" . T.unpack $ genSource (SourceInfo t v) - vreduced <- runReduce (SourceInfo t v) - writeFile "reduced.v" . T.unpack $ genSource vreduced - where file = T.unpack $ toTextIgnore f +handleOpts (Reduce f t s) = reduceWithScript t s f handleOpts (ConfigOpt c conf r) = do config <- if r then getConfig conf >>= randomise else getConfig conf maybe (T.putStrLn . encodeConfig $ config) diff --git a/src/VeriFuzz/Reduce.hs b/src/VeriFuzz/Reduce.hs index 995931d..79a46ba 100644 --- a/src/VeriFuzz/Reduce.hs +++ b/src/VeriFuzz/Reduce.hs @@ -15,9 +15,10 @@ Test case reducer implementation. module VeriFuzz.Reduce ( -- $strategy - Replacement(..) + reduceWithScript , reduce , reduce_ + , Replacement(..) , halveModules , halveModItems , halveStatements @@ -27,13 +28,26 @@ module VeriFuzz.Reduce ) where -import Control.Lens +import Control.Lens hiding ((<.>)) +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO, liftIO) import Data.List (nub) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (mapMaybe) import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Shelly ((<.>)) +import qualified Shelly +import Shelly.Lifted (MonadSh, liftSh) +import VeriFuzz.Internal +import VeriFuzz.Sim +import VeriFuzz.Sim.Internal import VeriFuzz.Verilog.AST import VeriFuzz.Verilog.CodeGen import VeriFuzz.Verilog.Mutate +import VeriFuzz.Verilog.Parser -- $strategy -- The reduction strategy has multiple different steps. 'reduce' will run these @@ -95,6 +109,13 @@ halve [] = None halve [_] = Single [] halve l = Dual a b where (a, b) = splitAt (length l `div` 2) l +halveNonEmpty :: Replace (NonEmpty a) +halveNonEmpty l = case NonEmpty.splitAt (length l `div` 2) l of + ([], []) -> None + ([], a:b) -> Single $ a :| b + (a:b, []) -> Single $ a :| b + (a:b, c:d) -> Dual (a :| b) $ c :| d + -- | When given a Lens and a function that works on a lower replacement, it will -- go down, apply the replacement, and return a replacement of the original -- module. @@ -121,7 +142,7 @@ filterAssigns out (ModCA (ContAssign i _)) = filterAssigns _ _ = True clean :: (Mutate a) => [Identifier] -> a -> a -clean ids a = mutExpr (transform $ filterExpr ids) a +clean ids = mutExpr (transform $ filterExpr ids) cleanUndefined :: [Identifier] -> [ModItem] -> [ModItem] cleanUndefined ids mis = clean usedWires mis @@ -147,7 +168,7 @@ cleanMod m newm = modify . change <$> newm ^. modItems halveIndExpr :: Replace Expr -halveIndExpr (Concat l ) = Concat <$> halve l +halveIndExpr (Concat l ) = Concat <$> halveNonEmpty l halveIndExpr (BinOp e1 _ e2) = Dual e1 e2 halveIndExpr (Cond _ e1 e2) = Dual e1 e2 halveIndExpr (UnOp _ e ) = Single e @@ -291,12 +312,22 @@ halveExpr = combine contexpr $ traverse halveModExpr contexpr = mainModule . modItems -- | Reduction using custom reduction strategies. -reduce_ - :: Replace SourceInfo - -> (SourceInfo -> IO Bool) - -> SourceInfo - -> IO SourceInfo -reduce_ repl eval src = do +reduce_ :: MonadSh m + => Text + -> Replace SourceInfo + -> (SourceInfo -> m Bool) + -> SourceInfo + -> m SourceInfo +reduce_ title repl eval src = do + liftSh . Shelly.echo $ "Reducing " + <> title + <> " (Modules: " + <> showT (length . getVerilog $ _infoSrc src) + <> ", Module Items in " + <> _infoTop src + <> ": " + <> showT (length (src ^. mainModule . modItems)) + <> ")" replAnswer <- sequenceA $ evalIfNotEmpty <$> replacement case (replacement, replAnswer) of (Single s, Single True ) -> runIf s @@ -311,26 +342,50 @@ reduce_ repl eval src = do _ -> return src where replacement = repl src - runIf s = if s /= src then reduce_ repl eval s else return s - evalIfNotEmpty m = do - print - $ GenVerilog - <$> m - ^.. mainModule - . modItems - . traverse - . modContAssign - eval m + runIf s = if s /= src then reduce_ title repl eval s else return s + evalIfNotEmpty = eval -- | Reduce an input to a minimal representation. It follows the reduction -- strategy mentioned above. -reduce - :: (SourceInfo -> IO Bool) -- ^ Failed or not. - -> SourceInfo -- ^ Input verilog source to be reduced. - -> IO SourceInfo -- ^ Reduced output. +reduce :: MonadSh m + => (SourceInfo -> m Bool) -- ^ Failed or not. + -> SourceInfo -- ^ Input verilog source to be reduced. + -> m SourceInfo -- ^ Reduced output. reduce eval src = - red halveModules src - >>= red halveModItems - >>= red halveStatements - >>= red halveExpr - where red a = reduce_ a eval + red "Modules" halveModules src + >>= red "Module Items" halveModItems + >>= red "Statements" halveStatements + >>= red "Expressions" halveExpr + where red s a = reduce_ s a eval + +runScript :: MonadSh m + => Shelly.FilePath + -> Shelly.FilePath + -> SourceInfo + -> m Bool +runScript fp file src = do + e <- liftSh $ do + Shelly.writefile file $ genSource src + noPrint . Shelly.errExit False $ Shelly.run_ fp [] + Shelly.lastExitCode + return $ e == 0 + +-- | Reduce using a script that is passed to it +reduceWithScript :: (MonadSh m, MonadIO m) + => Text + -> Shelly.FilePath + -> Shelly.FilePath + -> m () +reduceWithScript top script file = do + liftSh . Shelly.cp file $ file <.> "original" + srcInfo <- liftIO . parseSourceInfoFile top $ Shelly.toTextIgnore file + void $ reduce (runScript script file) srcInfo + +-- | Reduce a 'SourceInfo' using two Synthesisers that are passed to it. +reduceSynth :: (Synthesiser a, Synthesiser b, MonadSh m) + => Yosys + -> a + -> Maybe b + -> SourceInfo + -> m SourceInfo +reduceSynth = undefined -- cgit