From 48c2f0470fb51158d0474e1c5931f9e44d4945c2 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sun, 12 May 2019 14:17:36 +0100 Subject: Add defaultMain --- app/Main.hs | 246 +----------------------------------------------------------- 1 file changed, 2 insertions(+), 244 deletions(-) (limited to 'app') 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 -- cgit