From c144ad106079190941206cac0750c4eed7c02f91 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sun, 27 Oct 2019 20:05:18 +0000 Subject: Add mtl dependency to enable easier use of transformers --- src/Verismith/Fuzz.hs | 244 ++++++++++++++++++++++++++-------------------- src/Verismith/Generate.hs | 70 ++++++------- verismith.cabal | 60 ++++++------ 3 files changed, 202 insertions(+), 172 deletions(-) diff --git a/src/Verismith/Fuzz.hs b/src/Verismith/Fuzz.hs index a4b74b1..4f09b36 100644 --- a/src/Verismith/Fuzz.hs +++ b/src/Verismith/Fuzz.hs @@ -15,7 +15,8 @@ Environment to run the simulator and synthesisers in a matrix. {-# LANGUAGE TemplateHaskell #-} module Verismith.Fuzz - ( Fuzz + ( Fuzz (..) + , FuzzOpts (..) , fuzz , fuzzInDir , fuzzMultiple @@ -27,33 +28,31 @@ module Verismith.Fuzz ) where -import Control.DeepSeq (force) -import Control.Exception.Lifted (finally) -import Control.Lens hiding ((<.>)) -import Control.Monad (forM, replicateM) +import Control.DeepSeq (force) +import Control.Exception.Lifted (finally) +import Control.Lens hiding ((<.>)) +import Control.Monad (forM, replicateM) import Control.Monad.IO.Class -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Control (MonadBaseControl) -import Control.Monad.Trans.Maybe (runMaybeT) -import Control.Monad.Trans.Reader hiding (local) -import Control.Monad.Trans.State.Strict -import qualified Crypto.Random.DRBG as C -import Data.ByteString (ByteString) -import Data.List (nubBy, sort) -import Data.Maybe (isNothing) -import Data.Text (Text) -import qualified Data.Text as T +import Control.Monad.Reader +import Control.Monad.State.Strict +import Control.Monad.Trans.Control (MonadBaseControl) +import qualified Crypto.Random.DRBG as C +import Data.ByteString (ByteString) +import Data.List (nubBy, sort) +import Data.Maybe (fromMaybe, isNothing) +import Data.Text (Text) +import qualified Data.Text as T import Data.Time -import Data.Tuple (swap) -import Hedgehog (Gen) -import qualified Hedgehog.Internal.Gen as Hog -import Hedgehog.Internal.Seed (Seed) -import qualified Hedgehog.Internal.Seed as Hog -import qualified Hedgehog.Internal.Tree as Hog -import Prelude hiding (FilePath) -import Shelly hiding (get) -import Shelly.Lifted (MonadSh, liftSh) -import System.FilePath.Posix (takeBaseName) +import Data.Tuple (swap) +import Hedgehog (Gen) +import qualified Hedgehog.Internal.Gen as Hog +import Hedgehog.Internal.Seed (Seed) +import qualified Hedgehog.Internal.Seed as Hog +import qualified Hedgehog.Internal.Tree as Hog +import Prelude hiding (FilePath) +import Shelly hiding (get) +import Shelly.Lifted (MonadSh, liftSh) +import System.FilePath.Posix (takeBaseName) import Verismith.Config import Verismith.Internal import Verismith.Reduce @@ -65,12 +64,37 @@ import Verismith.Tool.Yosys import Verismith.Verilog.AST import Verismith.Verilog.CodeGen -data FuzzEnv = FuzzEnv { getSynthesisers :: ![SynthTool] - , getSimulators :: ![SimTool] - , yosysInstance :: {-# UNPACK #-} !Yosys +data FuzzOpts = FuzzOpts { _fuzzOptsOutput :: !(Maybe FilePath) + , _fuzzOptsForced :: !Bool + , _fuzzOptsKeepAll :: !Bool + , _fuzzOptsIterations :: {-# UNPACK #-} !Int + , _fuzzOptsNoSim :: !Bool + , _fuzzOptsNoEquiv :: !Bool + , _fuzzOptsConfig :: {-# UNPACK #-} !Config + } + deriving (Show, Eq) + +$(makeLenses ''FuzzOpts) + +defaultFuzzOpts :: FuzzOpts +defaultFuzzOpts = FuzzOpts { _fuzzOptsOutput = Nothing + , _fuzzOptsForced = False + , _fuzzOptsKeepAll = False + , _fuzzOptsIterations = 1 + , _fuzzOptsNoSim = False + , _fuzzOptsNoEquiv = False + , _fuzzOptsConfig = defaultConfig + } + +data FuzzEnv = FuzzEnv { _getSynthesisers :: ![SynthTool] + , _getSimulators :: ![SimTool] + , _yosysInstance :: {-# UNPACK #-} !Yosys + , _fuzzEnvOpts :: {-# UNPACK #-} !FuzzOpts } deriving (Eq, Show) +$(makeLenses ''FuzzEnv) + data FuzzState = FuzzState { _fuzzSynthResults :: ![SynthResult] , _fuzzSimResults :: ![SimResult] , _fuzzSynthStatus :: ![SynthStatus] @@ -87,23 +111,74 @@ type Fuzz m = StateT FuzzState (ReaderT FuzzEnv m) type MonadFuzz m = (MonadBaseControl IO m, MonadIO m, MonadSh m) -runFuzz :: MonadIO m => Config -> Yosys -> (Config -> Fuzz Sh a) -> m a -runFuzz conf yos m = shelly $ runFuzz' conf yos m - -runFuzz' :: Monad m => Config -> Yosys -> (Config -> Fuzz m b) -> m b -runFuzz' conf yos m = runReaderT - (evalStateT (m conf) (FuzzState [] [] [])) - (FuzzEnv - ( force - $ defaultIdentitySynth - : (descriptionToSynth <$> conf ^. configSynthesisers) - ) - (force $ descriptionToSim <$> conf ^. configSimulators) - yos +runFuzz :: MonadIO m => FuzzOpts -> Yosys -> Fuzz Sh a -> m a +runFuzz fo yos m = shelly $ runFuzz' fo yos m + +runFuzz' :: Monad m => FuzzOpts -> Yosys -> Fuzz m b -> m b +runFuzz' fo yos m = runReaderT + (evalStateT m (FuzzState [] [] [])) + (FuzzEnv { _getSynthesisers = ( force + $ defaultIdentitySynth + : (descriptionToSynth <$> conf ^. configSynthesisers) + ) + , _getSimulators = (force $ descriptionToSim <$> conf ^. configSimulators) + , _yosysInstance = yos + , _fuzzEnvOpts = fo + } ) + where + conf = _fuzzOptsConfig fo + +askConfig :: Monad m => Fuzz m Config +askConfig = asks (_fuzzOptsConfig . _fuzzEnvOpts) + +askOpts :: Monad m => Fuzz m FuzzOpts +askOpts = asks _fuzzEnvOpts + +genMethod conf seed gen = + case T.toLower $ conf ^. configProperty . propSampleMethod of + "hat" -> do + logT "Using the hat function" + sv hatFreqs + "mean" -> do + logT "Using the mean function" + sv meanFreqs + "median" -> do + logT "Using the median function" + sv medianFreqs + _ -> do + logT "Using first seed" + sampleSeed seed gen + where + sv a = sampleVerilog a (conf ^. configProperty . propSampleSize) seed gen + +relativeFuzzReport :: (MonadSh m) => FuzzReport -> m FuzzReport +relativeFuzzReport fr@(FuzzReport dir _ _ _ _ _ _ _) = liftSh $ do + newPath <- relPath dir + return $ (fuzzDir .~ newPath) fr + +filterSynth :: SynthResult -> Bool +filterSynth (SynthResult _ _ (Pass _) _) = True +filterSynth _ = False + +filterSim :: SimResult -> Bool +filterSim (SimResult _ _ (Pass _) _) = True +filterSim _ = False + +filterSynthStat :: SynthStatus -> Bool +filterSynthStat (SynthStatus _ (Pass _) _) = True +filterSynthStat _ = False + +passedFuzz :: FuzzReport -> Bool +passedFuzz (FuzzReport _ synth sim synthstat _ _ _ _) = + (passedSynth + passedSim + passedSynthStat) == 0 + where + passedSynth = length $ filter (not . filterSynth) synth + passedSim = length $ filter (not . filterSim) sim + passedSynthStat = length $ filter (not . filterSynthStat) synthstat synthesisers :: Monad m => Fuzz m [SynthTool] -synthesisers = lift $ asks getSynthesisers +synthesisers = lift $ asks _getSynthesisers --simulators :: (Monad m) => Fuzz () m [SimTool] --simulators = lift $ asks getSimulators @@ -346,9 +421,11 @@ medianFreqs l = zip hat (return <$> l) hat = set_ <$> [1 .. length l] set_ n = if n == h then 1 else 0 -fuzz :: MonadFuzz m => Gen SourceInfo -> Config -> Fuzz m FuzzReport -fuzz gen conf = do - (seed', src) <- generateSample genMethod +fuzz :: MonadFuzz m => Gen SourceInfo -> Fuzz m FuzzReport +fuzz gen = do + conf <- askConfig + let seed = conf ^. configProperty . propSeed + (seed', src) <- generateSample $ genMethod conf seed gen let size = length . lines . T.unpack $ genSource src liftSh . writefile "config.toml" @@ -378,70 +455,28 @@ fuzz gen conf = do tequiv (getTime redResult) return report - where - seed = conf ^. configProperty . propSeed - genMethod = case T.toLower $ conf ^. configProperty . propSampleMethod of - "hat" -> do - logT "Using the hat function" - sv hatFreqs - "mean" -> do - logT "Using the mean function" - sv meanFreqs - "median" -> do - logT "Using the median function" - sv medianFreqs - _ -> do - logT "Using first seed" - sampleSeed seed gen - sv a = sampleVerilog a (conf ^. configProperty . propSampleSize) seed gen - -relativeFuzzReport :: (MonadSh m) => FuzzReport -> m FuzzReport -relativeFuzzReport fr@(FuzzReport dir _ _ _ _ _ _ _) = liftSh $ do - newPath <- relPath dir - return $ (fuzzDir .~ newPath) fr - -filterSynth :: SynthResult -> Bool -filterSynth (SynthResult _ _ (Pass _) _) = True -filterSynth _ = False - -filterSim :: SimResult -> Bool -filterSim (SimResult _ _ (Pass _) _) = True -filterSim _ = False - -filterSynthStat :: SynthStatus -> Bool -filterSynthStat (SynthStatus _ (Pass _) _) = True -filterSynthStat _ = False - -passedFuzz :: FuzzReport -> Bool -passedFuzz (FuzzReport _ synth sim synthstat _ _ _ _) = - (passedSynth + passedSim + passedSynthStat) == 0 - where - passedSynth = length $ filter (not . filterSynth) synth - passedSim = length $ filter (not . filterSim) sim - passedSynthStat = length $ filter (not . filterSynthStat) synthstat -fuzzInDir - :: MonadFuzz m => Bool -> FilePath -> Gen SourceInfo -> Config -> Fuzz m FuzzReport -fuzzInDir k fp src conf = do +fuzzInDir :: MonadFuzz m => Gen SourceInfo -> Fuzz m FuzzReport +fuzzInDir src = do + fuzzOpts <- askOpts + let fp = fromMaybe "fuzz" $ _fuzzOptsOutput fuzzOpts make fp - res <- pop fp $ fuzz src conf + res <- pop fp $ fuzz src liftSh $ do writefile (fp <.> "html") $ printResultReport (bname fp) res - when (passedFuzz res && not k) $ rm_rf fp + when (passedFuzz res && not (_fuzzOptsKeepAll fuzzOpts)) $ rm_rf fp relativeFuzzReport res where bname = T.pack . takeBaseName . T.unpack . toTextIgnore fuzzMultiple :: MonadFuzz m - => Int - -> Bool - -> Maybe FilePath - -> Gen SourceInfo - -> Config + => Gen SourceInfo -> Fuzz m [FuzzReport] -fuzzMultiple n k fp src conf = do - x <- case fp of +fuzzMultiple src = do + fuzzOpts <- askOpts + let seed = (_fuzzOptsConfig fuzzOpts) ^. configProperty . propSeed + x <- case _fuzzOptsOutput fuzzOpts of Nothing -> do ct <- liftIO getZonedTime return @@ -453,21 +488,22 @@ fuzzMultiple n k fp src conf = do make x pop x $ do results <- if isNothing seed - then forM [1 .. n] fuzzDir' + then forM [1 .. (_fuzzOptsIterations fuzzOpts)] fuzzDir' else (: []) <$> fuzzDir' (1 :: Int) liftSh . writefile (fromText "index" <.> "html") $ printSummary "Fuzz Summary" results return results where - fuzzDir' n' = fuzzInDir k (fromText $ "fuzz_" <> showT n') src conf - seed = conf ^. configProperty . propSeed + fuzzDir' :: (Show a, MonadFuzz m) => a -> Fuzz m FuzzReport + fuzzDir' n' = local (fuzzEnvOpts . fuzzOptsOutput .~ + (Just . fromText $ "fuzz_" <> showT n')) + $ fuzzInDir src sampleSeed :: MonadSh m => Maybe Seed -> Gen a -> m (Seed, a) sampleSeed s gen = liftSh - $ let - loop n = if n <= 0 + $ let loop n = if n <= 0 then error "Hedgehog.Gen.sample: too many discards, could not generate a sample" diff --git a/src/Verismith/Generate.hs b/src/Verismith/Generate.hs index 9bf7c58..ff20f05 100644 --- a/src/Verismith/Generate.hs +++ b/src/Verismith/Generate.hs @@ -10,7 +10,8 @@ Portability : POSIX Various useful generators. -} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -Wno-unused-imports #-} module Verismith.Generate @@ -60,19 +61,18 @@ module Verismith.Generate ) where -import Control.Lens hiding (Context) -import Control.Monad (replicateM) -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Reader hiding (local) -import Control.Monad.Trans.State.Strict -import Data.Foldable (fold) -import Data.Functor.Foldable (cata) -import Data.List (foldl', partition) -import qualified Data.Text as T -import Hedgehog (Gen, GenT, MonadGen) -import qualified Hedgehog as Hog -import qualified Hedgehog.Gen as Hog -import qualified Hedgehog.Range as Hog +import Control.Lens hiding (Context) +import Control.Monad (replicateM) +import Control.Monad.Reader +import Control.Monad.State.Strict +import Data.Foldable (fold) +import Data.Functor.Foldable (cata) +import Data.List (foldl', partition) +import qualified Data.Text as T +import Hedgehog (Gen, GenT, MonadGen) +import qualified Hedgehog as Hog +import qualified Hedgehog.Gen as Hog +import qualified Hedgehog.Range as Hog import Verismith.Config import Verismith.Internal import Verismith.Verilog.AST @@ -149,12 +149,6 @@ probability c = c ^. configProbability askProbability :: StateGen Probability askProbability = asks probability -rask :: StateGen Config -rask = ask - -lget :: StateGen Context -lget = lift . lift $ get - -- | Generates a random large number, which can also be negative. largeNum :: (MonadGen m) => m Int largeNum = Hog.int $ Hog.linear (-100) 100 @@ -314,7 +308,7 @@ someI m f = do -- is then increased so that the label is unique. makeIdentifier :: T.Text -> StateGen Identifier makeIdentifier prefix = do - context <- lget + context <- get let ident = Identifier $ prefix <> showT (context ^. nameCounter) nameCounter += 1 return ident @@ -332,7 +326,7 @@ getPort' pt i c = case filter portId c of -- the generation is currently in the other branch of an if-statement. nextPort :: PortType -> StateGen Port nextPort pt = do - context <- lget + context <- get ident <- makeIdentifier . T.toLower $ showT pt getPort' pt ident (_variables context) @@ -347,7 +341,7 @@ newPort ident pt = do -- | Generates an expression from variables that are currently in scope. scopedExpr :: StateGen Expr scopedExpr = do - context <- lget + context <- get prob <- askProbability Hog.sized . exprWithContext (_probExpr prob) (_parameters context) @@ -383,12 +377,12 @@ seqBlock = do conditional :: StateGen Statement conditional = do expr <- scopedExpr - nc <- _nameCounter <$> lget + nc <- _nameCounter <$> get tstat <- seqBlock - nc' <- _nameCounter <$> lget + nc' <- _nameCounter <$> get nameCounter .= nc fstat <- seqBlock - nc'' <- _nameCounter <$> lget + nc'' <- _nameCounter <$> get nameCounter .= max nc' nc'' return $ CondStmnt expr (Just tstat) (Just fstat) @@ -408,7 +402,7 @@ forLoop = do statement :: StateGen Statement statement = do prob <- askProbability - cont <- lget + cont <- get let defProb i = prob ^. probStmnt . i Hog.frequency [ (defProb probStmntBlock , BlockAssign <$> assignment) @@ -442,13 +436,13 @@ resizePort ps i ra = foldl' func [] -- representation for the clock. instantiate :: ModDecl -> StateGen ModItem instantiate (ModDecl i outP inP _ _) = do - context <- lget + context <- get outs <- replicateM (length outP) (nextPort Wire) ins <- take (length inpFixed) <$> Hog.shuffle (context ^. variables) insLit <- replicateM (length inpFixed - length ins) (Number <$> genBitVec) mapM_ (uncurry process) . zip (ins ^.. traverse . portName) $ inpFixed ^.. traverse . portSize ident <- makeIdentifier "modinst" - vs <- view variables <$> lget + vs <- view variables <$> get Hog.choice [ return . ModInst i ident $ ModConn <$> (toE (outs <> clkPort <> ins) <> insLit) , ModInst i ident <$> Hog.shuffle @@ -462,7 +456,7 @@ instantiate (ModDecl i outP inP _ _) = do | n == "clk" = False | otherwise = True process p r = do - params <- view parameters <$> lget + params <- view parameters <$> get variables %= resizePort params p r -- | Generates a module instance by also generating a new module if there are @@ -486,8 +480,8 @@ instantiate (ModDecl i outP inP _ _) = do -- a module from a context or generating a new one. modInst :: StateGen ModItem modInst = do - prob <- rask - context <- lget + prob <- ask + context <- get let maxMods = prob ^. configProperty . propMaxModules if length (context ^. modules) < maxMods then do @@ -499,7 +493,7 @@ modInst = do parameters .= [] modDepth -= 1 chosenMod <- moduleDef Nothing - ncont <- lget + ncont <- get let genMods = ncont ^. modules modDepth += 1 parameters .= params @@ -511,9 +505,9 @@ modInst = do -- | Generate a random module item. modItem :: StateGen ModItem modItem = do - conf <- rask + conf <- ask let prob = conf ^. configProbability - context <- lget + context <- get let defProb i = prob ^. probModItem . i det <- Hog.frequency [ (conf ^. configProperty . propDeterminism, return True) , (conf ^. configProperty . propNonDeterminism, return False) ] @@ -535,7 +529,7 @@ moduleName Nothing = makeIdentifier "module" constExpr :: StateGen ConstExpr constExpr = do prob <- askProbability - context <- lget + context <- get Hog.sized $ constExprWithContext (context ^. parameters) (prob ^. probExpr) @@ -576,8 +570,8 @@ moduleDef top = do portList <- Hog.list (Hog.linear 4 10) $ nextPort Wire mi <- Hog.list (Hog.linear 4 100) modItem ps <- Hog.list (Hog.linear 0 10) parameter - context <- lget - config <- rask + context <- get + config <- ask let (newPorts, local) = partition (`identElem` portList) $ _variables context let size = diff --git a/verismith.cabal b/verismith.cabal index b734b29..389ca16 100644 --- a/verismith.cabal +++ b/verismith.cabal @@ -50,6 +50,7 @@ library , Verismith.Fuzz , Verismith.Generate , Verismith.Internal + , Verismith.OptParser , Verismith.Reduce , Verismith.Report , Verismith.Result @@ -74,42 +75,41 @@ library , Verismith.Verilog.Preprocess , Verismith.Verilog.Quote , Verismith.Verilog.Token - build-depends: base >=4.7 && <5 - -- Cannot upgrade to 1.0 because of missing MonadGen instance for - -- StateT. - , hedgehog >=1.0 && <1.2 + build-depends: DRBG >=0.5 && <0.6 + , array >=0.5 && <0.6 + , base >=4.7 && <5 + , binary >= 0.8.5.1 && <0.9 + , blaze-html >=0.9.0.1 && <0.10 + , bytestring >=0.10 && <0.11 + , cryptonite >=0.25 && <0.26 + , deepseq >= 1.4.3.0 && <1.5 + , exceptions >=0.10.0 && <0.11 , fgl >=5.6 && <5.8 , fgl-visualize >=0.1 && <0.2 + , filepath >=1.4.2 && <1.5 + , gitrev >= 1.3.1 && <1.4 + , hedgehog >=1.0 && <1.2 , lens >=4.16.1 && <4.18 + , lifted-base >=0.2.3 && <0.3 + , memory >=0.14 && <0.15 + , monad-control >=1.0.2 && <1.1 + , mtl >=2.2.2 && <2.3 + , optparse-applicative >=0.14 && <0.15 + , parsec >=3.1 && <3.2 + , prettyprinter >=1.2.0.1 && <1.3 , random >=1.1 && <1.2 + , recursion-schemes >=5.0.2 && <5.2 , shakespeare >=2 && <2.1 , shelly >=1.8.0 && <1.9 + , statistics >=0.14.0.2 && <0.16 + , template-haskell >=2.13.0 && <2.15 , text >=1.2 && <1.3 - , bytestring >=0.10 && <0.11 - , filepath >=1.4.2 && <1.5 - , binary >= 0.8.5.1 && <0.9 - , cryptonite >=0.25 && <0.26 - , memory >=0.14 && <0.15 - , DRBG >=0.5 && <0.6 - , parsec >=3.1 && <3.2 + , time >= 1.8.0.2 && <1.9 + , tomland >=1.0 && <1.2 , transformers >=0.5 && <0.6 , transformers-base >=0.4.5 && <0.5 - , tomland >=1.0 && <1.2 - , prettyprinter >=1.2.0.1 && <1.3 - , array >=0.5 && <0.6 - , recursion-schemes >=5.0.2 && <5.2 - , time >= 1.8.0.2 && <1.9 - , lifted-base >=0.2.3 && <0.3 - , monad-control >=1.0.2 && <1.1 - , gitrev >= 1.3.1 && <1.4 - , deepseq >= 1.4.3.0 && <1.5 - , template-haskell >=2.13.0 && <2.15 - , optparse-applicative >=0.14 && <0.15 - , exceptions >=0.10.0 && <0.11 - , blaze-html >=0.9.0.1 && <0.10 - , statistics >=0.14.0.2 && <0.16 - , vector >=0.12.0.1 && <0.13 , unordered-containers >=0.2.10 && <0.3 + , vector >=0.12.0.1 && <0.13 default-extensions: OverloadedStrings executable verismith @@ -144,14 +144,14 @@ test-suite test build-depends: base >=4 && <5 , verismith , fgl >=5.6 && <5.8 - , tasty >=1.0.1.1 && <1.3 - , tasty-hunit >=0.10 && <0.11 - , tasty-hedgehog >=1.0 && <1.1 , hedgehog >=1.0 && <1.2 , lens >=4.16.1 && <4.18 + , parsec >= 3.1 && < 3.2 , shakespeare >=2 && <2.1 + , tasty >=1.0.1.1 && <1.3 + , tasty-hedgehog >=1.0 && <1.1 + , tasty-hunit >=0.10 && <0.11 , text >=1.2 && <1.3 - , parsec >= 3.1 && < 3.2 default-extensions: OverloadedStrings --test-suite doctest -- cgit