From 48c2f0470fb51158d0474e1c5931f9e44d4945c2 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sun, 12 May 2019 14:17:36 +0100 Subject: Add defaultMain --- src/VeriFuzz.hs | 244 +++++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 243 insertions(+), 1 deletion(-) (limited to 'src') diff --git a/src/VeriFuzz.hs b/src/VeriFuzz.hs index f66e18c..8094af2 100644 --- a/src/VeriFuzz.hs +++ b/src/VeriFuzz.hs @@ -14,6 +14,7 @@ module VeriFuzz ( runEquivalence , runSimulation , runReduce + , defaultMain , draw , SourceInfo(..) , module VeriFuzz.Verilog @@ -25,6 +26,7 @@ module VeriFuzz ) where +import Control.Concurrent import Control.Lens import qualified Crypto.Random.DRBG as C import Data.ByteString (ByteString) @@ -40,8 +42,9 @@ import qualified Data.Text.IO as T import Hedgehog (Gen) import qualified Hedgehog.Gen as Hog import Hedgehog.Internal.Seed (Seed) +import Options.Applicative import Prelude hiding (FilePath) -import Shelly +import Shelly hiding (command) import Shelly.Lifted (liftSh) import VeriFuzz.Circuit import VeriFuzz.Config @@ -53,6 +56,31 @@ import VeriFuzz.Sim import VeriFuzz.Sim.Internal import VeriFuzz.Verilog +data OptTool = TYosys + | TXST + | TIcarus + +instance Show OptTool where + show TYosys = "yosys" + show TXST = "xst" + show TIcarus = "icarus" + +data Opts = Fuzz { fuzzOutput :: {-# UNPACK #-} !Text + , configFile :: !(Maybe FilePath) + , forced :: !Bool + , keepAll :: !Bool + , num :: {-# UNPACK #-} !Int + } + | Generate { mFileName :: !(Maybe FilePath) + , configFile :: !(Maybe FilePath) + } + | Parse { fileName :: {-# UNPACK #-} !FilePath + } + | Reduce { fileName :: {-# UNPACK #-} !FilePath + , top :: {-# UNPACK #-} !Text + } + | ConfigOpt { writeDefaultConfig :: !(Maybe FilePath) } + -- | Generate a specific number of random bytestrings of size 256. randomByteString :: C.CtrDRBG -> Int -> [ByteString] -> [ByteString] randomByteString gen n bytes @@ -167,3 +195,217 @@ runEquivalence seed gm t d k i = do runReduce :: SourceInfo -> IO SourceInfo runReduce s = reduce (\s' -> not <$> checkEquivalence s' "reduce") s + +myForkIO :: IO () -> IO (MVar ()) +myForkIO io = do + mvar <- newEmptyMVar + _ <- forkFinally io (\_ -> putMVar mvar ()) + return mvar + +textOption :: Mod OptionFields String -> Parser Text +textOption = fmap T.pack . strOption + +optReader :: (String -> Maybe a) -> ReadM a +optReader f = eitherReader $ \arg -> case f arg of + Just a -> Right a + Nothing -> Left $ "Cannot parse option: " <> arg + +parseSynth :: String -> Maybe OptTool +parseSynth val | val == "yosys" = Just TYosys + | val == "xst" = Just TXST + | otherwise = Nothing + +parseSim :: String -> Maybe OptTool +parseSim val | val == "icarus" = Just TIcarus + | otherwise = Nothing + +fuzzOpts :: Parser Opts +fuzzOpts = + Fuzz + <$> textOption + ( long "output" + <> short 'o' + <> metavar "DIR" + <> help "Output directory that the fuzz run takes place in." + <> showDefault + <> value "output" + ) + <*> ( optional + . strOption + $ long "config" + <> short 'c' + <> metavar "FILE" + <> help "Config file for the current fuzz run." + ) + <*> (switch $ long "force" <> short 'f' <> help + "Overwrite the specified directory." + ) + <*> (switch $ long "keep" <> short 'k' <> help + "Keep all the directories." + ) + <*> ( option auto + $ long "num" + <> short 'n' + <> help "The number of fuzz runs that should be performed." + <> showDefault + <> value 1 + <> metavar "INT" + ) + +genOpts :: Parser Opts +genOpts = + Generate + <$> ( optional + . strOption + $ long "output" + <> short 'o' + <> metavar "FILE" + <> help "Output to a verilog file instead." + ) + <*> ( optional + . strOption + $ long "config" + <> short 'c' + <> metavar "FILE" + <> help "Config file for the generation run." + ) + +parseOpts :: Parser Opts +parseOpts = Parse . fromText . T.pack <$> strArgument + (metavar "FILE" <> help "Verilog input file.") + +reduceOpts :: Parser Opts +reduceOpts = + Reduce + . fromText + . T.pack + <$> strArgument (metavar "FILE" <> help "Verilog input file.") + <*> textOption + ( short 't' + <> long "top" + <> metavar "TOP" + <> help "Name of top level module." + <> showDefault + <> value "main" + ) + +configOpts :: Parser Opts +configOpts = + ConfigOpt + <$> ( optional + . strOption + $ long "output" + <> short 'o' + <> metavar "FILE" + <> help "Output to a TOML Config file." + ) + +argparse :: Parser Opts +argparse = + hsubparser + ( command + "fuzz" + (info + fuzzOpts + (progDesc + "Run fuzzing on the specified simulators and synthesisers." + ) + ) + <> metavar "fuzz" + ) + <|> hsubparser + ( command + "generate" + (info + genOpts + (progDesc "Generate a random Verilog program.") + ) + <> metavar "generate" + ) + <|> hsubparser + ( command + "parse" + (info + parseOpts + (progDesc + "Parse a verilog file and output a pretty printed version." + ) + ) + <> metavar "parse" + ) + <|> hsubparser + ( command + "reduce" + (info + reduceOpts + (progDesc + "Reduce a Verilog file by rerunning the fuzzer on the file." + ) + ) + <> metavar "reduce" + ) + <|> hsubparser + ( command + "config" + (info + configOpts + (progDesc + "Print the current configuration of the fuzzer." + ) + ) + <> metavar "config" + ) + +version :: Parser (a -> a) +version = infoOption versionInfo $ mconcat + [long "version", short 'v', help "Show version information.", hidden] + +opts :: ParserInfo Opts +opts = info + (argparse <**> helper <**> version) + ( fullDesc + <> progDesc "Fuzz different simulators and synthesisers." + <> header + "VeriFuzz - A hardware simulator and synthesiser Verilog fuzzer." + ) + +getConfig :: Maybe FilePath -> IO Config +getConfig s = maybe (return defaultConfig) parseConfigFile $ T.unpack . toTextIgnore <$> s + +handleOpts :: Opts -> IO () +handleOpts (Fuzz _ configF _ _ n) = do + config <- getConfig configF + _ <- runFuzz config + defaultYosys + (fuzzMultiple n Nothing (proceduralSrc "top" config)) + return () +handleOpts (Generate f c) = do + config <- getConfig c + source <- proceduralIO "top" config + maybe (T.putStrLn $ genSource source) + (flip T.writeFile $ genSource source) + $ T.unpack . toTextIgnore <$> f +handleOpts (Parse f) = do + verilogSrc <- readFile file + case parseVerilog 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 (ConfigOpt c) = maybe + (T.putStrLn . encodeConfig $ defaultConfig) + (`encodeConfigFile` defaultConfig) + $ T.unpack . toTextIgnore <$> c + +defaultMain :: IO () +defaultMain = do + optsparsed <- execParser opts + handleOpts optsparsed -- cgit