From 91181429f7b9450068cb00903057d0c0d4e20a89 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sun, 3 Feb 2019 02:26:54 +0000 Subject: Add options --- app/Main.hs | 98 ++++++++++++++++--------------------------------------- app/Simulation.hs | 86 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 114 insertions(+), 70 deletions(-) create mode 100644 app/Simulation.hs (limited to 'app') diff --git a/app/Main.hs b/app/Main.hs index 0557996..988e3ed 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,20 +1,15 @@ module Main where import Control.Concurrent -import Control.Lens -import qualified Crypto.Random.DRBG as C -import Data.ByteString (ByteString) -import qualified Data.Graph.Inductive as G -import qualified Data.Graph.Inductive.Dot as G -import Data.Text (Text) -import qualified Data.Text as T -import Numeric (showHex) -import Prelude hiding (FilePath) -import Shelly -import Test.QuickCheck (Gen) -import qualified Test.QuickCheck as QC +import Data.Text (Text) +import qualified Data.Text as T +import Options.Applicative +import Prelude hiding (FilePath) +import Simulation import VeriFuzz -import qualified VeriFuzz.RandomAlt as V + +data Opts = Opts + { output :: Text } myForkIO :: IO () -> IO (MVar ()) myForkIO io = do @@ -22,67 +17,30 @@ myForkIO io = do _ <- forkFinally io (\_ -> putMVar mvar ()) return mvar -genRand :: C.CtrDRBG -> Int -> [ByteString] -> [ByteString] -genRand gen n bytes | n == 0 = ranBytes : bytes - | otherwise = genRand newGen (n - 1) $ ranBytes : bytes - where Right (ranBytes, newGen) = C.genBytes 32 gen - -genRandom :: Int -> IO [ByteString] -genRandom n = do - gen <- C.newGenIO :: IO C.CtrDRBG - return $ genRand gen n [] - -draw :: IO () -draw = do - gr <- QC.generate $ rDups <$> QC.resize 10 (randomDAG :: QC.Gen (G.Gr Gate ())) - let dot = G.showDot . G.fglToDotString $ G.nemap show (const "") gr - writeFile "file.dot" dot - shelly $ run_ "dot" ["-Tpng", "-o", "file.png", "file.dot"] - -runSimulation :: IO () -runSimulation = do - gr <- QC.generate $ rDups <$> QC.resize 100 (randomDAG :: QC.Gen (G.Gr Gate ())) - -- let dot = G.showDot . G.fglToDotString $ G.nemap show (const "") gr - -- writeFile "file.dot" dot - -- shelly $ run_ "dot" ["-Tpng", "-o", "file.png", "file.dot"] - let circ = - head $ (nestUpTo 30 . generateAST $ Circuit gr) ^.. getVerilogSrc . traverse . getDescription - rand <- genRandom 20 - val <- shelly $ runSim defaultIcarus (initMod circ) rand - putStrLn $ showHex (abs val) "" - -onFailure :: Text -> RunFailed -> Sh () -onFailure t _ = do - ex <- lastExitCode - case ex of - 124 -> do - echoP "Test TIMEOUT" - cd ".." - cp_r (fromText t) $ fromText (t <> "_timeout") - _ -> do - echoP "Test FAIL" - cd ".." - cp_r (fromText t) $ fromText (t <> "_failed") - -runEquivalence :: Gen ModDecl -> Text -> Int -> IO () -runEquivalence gm t i = do - m <- QC.generate gm - shellyFailDir $ do - mkdir_p (fromText "output" fromText n) - curr <- toTextIgnore <$> pwd - setenv "VERIFUZZ_ROOT" curr - cd (fromText "output" fromText n) - catch_sh (runEquiv defaultYosys defaultYosys - (Just defaultXst) m >> echoP "Test OK" >> cd "..") $ - onFailure n - rm_rf $ fromText n - when (i < 5) (runEquivalence gm t $ i+1) - where - n = t <> "_" <> T.pack (show i) +textOption :: Mod OptionFields String -> Parser Text +textOption = fmap T.pack . strOption + +argparse :: Parser Opts +argparse = Opts + <$> textOption + ( long "output" + <> short 'o' + <> metavar "DIR" + <> help "Output directory that the fuzz run takes place in." + <> showDefault + <> value "output" + ) + +opts :: ParserInfo Opts +opts = info (argparse <**> helper) + ( fullDesc + <> progDesc "Fuzz different simulators and synthesisers." + <> header "VeriFuzz - A hardware simulator and synthesiser Verilog fuzzer." ) main :: IO () --main = sample (arbitrary :: Gen (Circuit Input)) main = do + optsparsed <- execParser opts num <- getNumCapabilities vars <- sequence $ (\x -> myForkIO $ runEquivalence (randomMod 5 15) ("test_" <> T.pack (show x)) 0) <$> [1..num] diff --git a/app/Simulation.hs b/app/Simulation.hs new file mode 100644 index 0000000..67344c1 --- /dev/null +++ b/app/Simulation.hs @@ -0,0 +1,86 @@ +{-| +Module : Simulation +Description : Simulation module for Main. +Copyright : (c) 2019, Yann Herklotz Grave +License : GPL-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Simulation module for Main. +-} + +module Simulation where + +import Control.Lens +import qualified Crypto.Random.DRBG as C +import Data.ByteString (ByteString) +import qualified Data.Graph.Inductive as G +import qualified Data.Graph.Inductive.Dot as G +import Data.Text (Text) +import qualified Data.Text as T +import Numeric (showHex) +import Prelude hiding (FilePath) +import Shelly +import Test.QuickCheck (Gen) +import qualified Test.QuickCheck as QC +import VeriFuzz +import qualified VeriFuzz.RandomAlt as V + +genRand :: C.CtrDRBG -> Int -> [ByteString] -> [ByteString] +genRand gen n bytes | n == 0 = ranBytes : bytes + | otherwise = genRand newGen (n - 1) $ ranBytes : bytes + where Right (ranBytes, newGen) = C.genBytes 32 gen + +genRandom :: Int -> IO [ByteString] +genRandom n = do + gen <- C.newGenIO :: IO C.CtrDRBG + return $ genRand gen n [] + +draw :: IO () +draw = do + gr <- QC.generate $ rDups <$> QC.resize 10 (randomDAG :: QC.Gen (G.Gr Gate ())) + let dot = G.showDot . G.fglToDotString $ G.nemap show (const "") gr + writeFile "file.dot" dot + shelly $ run_ "dot" ["-Tpng", "-o", "file.png", "file.dot"] + +runSimulation :: IO () +runSimulation = do + gr <- QC.generate $ rDups <$> QC.resize 100 (randomDAG :: QC.Gen (G.Gr Gate ())) + -- let dot = G.showDot . G.fglToDotString $ G.nemap show (const "") gr + -- writeFile "file.dot" dot + -- shelly $ run_ "dot" ["-Tpng", "-o", "file.png", "file.dot"] + let circ = + head $ (nestUpTo 30 . generateAST $ Circuit gr) ^.. getVerilogSrc . traverse . getDescription + rand <- genRandom 20 + val <- shelly $ runSim defaultIcarus (initMod circ) rand + putStrLn $ showHex (abs val) "" + +onFailure :: Text -> RunFailed -> Sh () +onFailure t _ = do + ex <- lastExitCode + case ex of + 124 -> do + echoP "Test TIMEOUT" + cd ".." + cp_r (fromText t) $ fromText (t <> "_timeout") + _ -> do + echoP "Test FAIL" + cd ".." + cp_r (fromText t) $ fromText (t <> "_failed") + +runEquivalence :: Gen ModDecl -> Text -> Int -> IO () +runEquivalence gm t i = do + m <- QC.generate gm + shellyFailDir $ do + mkdir_p (fromText "output" fromText n) + curr <- toTextIgnore <$> pwd + setenv "VERIFUZZ_ROOT" curr + cd (fromText "output" fromText n) + catch_sh (runEquiv defaultYosys defaultYosys + (Just defaultXst) m >> echoP "Test OK" >> cd "..") $ + onFailure n + rm_rf $ fromText n + when (i < 5) (runEquivalence gm t $ i+1) + where + n = t <> "_" <> T.pack (show i) -- cgit