diff options
| -rw-r--r-- | app/Main.hs | 246 | ||||
| -rw-r--r-- | src/VeriFuzz.hs | 244 |
2 files changed, 245 insertions, 245 deletions
diff --git a/app/Main.hs b/app/Main.hs index 861fcd0..7160b5d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,248 +1,6 @@ module Main where -import Control.Concurrent -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Options.Applicative -import qualified Shelly as S -import qualified VeriFuzz as V - -data Tool = Yosys - | XST - | Icarus - -instance Show Tool where - show Yosys = "yosys" - show XST = "xst" - show Icarus = "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 #-} !S.FilePath - } - | Reduce { fileName :: {-# UNPACK #-} !S.FilePath - , top :: {-# UNPACK #-} !Text - } - | Config { writeDefaultConfig :: !(Maybe FilePath) } - -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 Tool -parseSynth val | val == "yosys" = Just Yosys - | val == "xst" = Just XST - | otherwise = Nothing - -parseSim :: String -> Maybe Tool -parseSim val | val == "icarus" = Just Icarus - | 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 . S.fromText . T.pack <$> strArgument - (metavar "FILE" <> help "Verilog input file.") - -reduceOpts :: Parser Opts -reduceOpts = - Reduce - . S.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 = - Config - <$> ( 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 V.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 V.Config -getConfig = maybe (return V.defaultConfig) V.parseConfigFile - -handleOpts :: Opts -> IO () -handleOpts (Fuzz _ configF _ _ n) = do - config <- getConfig configF - _ <- V.runFuzz config - V.defaultYosys - (V.fuzzMultiple n Nothing (V.proceduralSrc "top" config)) - return () -handleOpts (Generate f c) = do - config <- getConfig c - source <- V.proceduralIO "top" config - maybe (T.putStrLn $ V.genSource source) - (flip T.writeFile $ V.genSource source) - f -handleOpts (Parse f) = do - verilogSrc <- readFile file - case V.parseVerilog file verilogSrc of - Left l -> print l - Right v -> print $ V.GenVerilog v - where file = T.unpack . S.toTextIgnore $ f -handleOpts (Reduce f t) = do - verilogSrc <- readFile file - case V.parseVerilog file verilogSrc of - Left l -> print l - Right v -> do - writeFile "main.v" . T.unpack $ V.genSource (V.SourceInfo t v) - vreduced <- V.runReduce (V.SourceInfo t v) - writeFile "reduced.v" . T.unpack $ V.genSource vreduced - where file = T.unpack $ S.toTextIgnore f -handleOpts (Config c) = maybe - (T.putStrLn . V.encodeConfig $ V.defaultConfig) - (`V.encodeConfigFile` V.defaultConfig) - c +import VeriFuzz main :: IO () -main = do - optsparsed <- execParser opts - handleOpts optsparsed +main = defaultMain 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 |