Add defaultMain

1 files changed, 243 insertions, 1 deletions

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