From 9c96914d48e798294e20ccd863fdb25fde1c39b9 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Tue, 23 Apr 2019 20:49:21 +0100 Subject: Add documentation to Config.hs --- src/VeriFuzz/Config.hs | 144 +++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 128 insertions(+), 16 deletions(-) (limited to 'src') diff --git a/src/VeriFuzz/Config.hs b/src/VeriFuzz/Config.hs index a863d53..77d62a4 100644 --- a/src/VeriFuzz/Config.hs +++ b/src/VeriFuzz/Config.hs @@ -7,24 +7,41 @@ Maintainer : ymherklotz [at] gmail [dot] com Stability : experimental Portability : POSIX -Configuration file format and parser. +TOML Configuration file format and parser. -} {-# LANGUAGE TemplateHaskell #-} module VeriFuzz.Config - ( Config(..) + ( -- * TOML Configuration + -- $conf + Config(..) , defaultConfig + -- ** Probabilities + , Probability(..) + -- *** Expression + , ProbExpr(..) + -- *** Event List + , ProbEventList(..) + -- *** Module Item + , ProbModItem(..) + -- *** Statement + , ProbStatement(..) + -- ** Property + , Property(..) + -- ** Simulator Description + , SimDescription(..) + -- ** Synthesiser Description + , SynthDescription(..) + -- * Useful Lenses , configProbability , configProperty , configSimulators , configSynthesisers - , Probability(..) , probModItem , probStmnt , probExpr , probEventList - , ProbExpr(..) , probExprNum , probExprId , probExprUnOp @@ -34,15 +51,12 @@ module VeriFuzz.Config , probExprStr , probExprSigned , probExprUnsigned - , ProbEventList(..) , probEventListAll , probEventListVar , probEventListClk - , ProbModItem(..) , probModItemAssign , probModItemAlways , probModItemInst - , ProbStatement(..) , probStmntBlock , probStmntNonBlock , probStmntCond @@ -52,12 +66,10 @@ module VeriFuzz.Config , propStmntDepth , propModDepth , propMaxModules - , SimDescription(..) - , SynthDescription(..) , parseConfigFile , parseConfig - , configEncode - , configToFile + , encodeConfig + , encodeConfigFile ) where @@ -66,25 +78,125 @@ import Control.Lens hiding ((.=)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe) import Data.Text (Text) -import qualified Data.Text.IO as T (writeFile) +import qualified Data.Text.IO as T import Toml (TomlCodec, (.=)) import qualified Toml +-- $conf +-- +-- VeriFuzz supports a TOML configuration file that can be passed using the @-c@ +-- flag or using the 'parseConfig' and 'encodeConfig' functions. The +-- configuration can then be manipulated using the lenses that are also provided +-- in this module. +-- +-- The configuration file can be used to tweak the random Verilog generation by +-- passing different probabilities to each of the syntax nodes in the AST. It +-- can also be used to specify which simulators to fuzz with which options. A +-- seed for the run can also be set, to replay a previous run using the same +-- exact generation. A default value is associated with each key in the +-- configuration file, which means that only the options that need overriding +-- can be added to the configuration. The defaults can be observed in +-- 'defaultConfig' or when running @verifuzz config@. +-- +-- == Configuration Sections +-- +-- There are four main configuration sections in the TOML file: +-- +-- [@probability@] The @probability@ section defines the probabilities at +-- every node in the AST. +-- +-- [@property@] Controls different properties of the generation, such as +-- adding a seed or the depth of the statements. +-- +-- [@simulator@] This is an array of tables containing descriptions of the +-- different simulators that should be used. It currently only supports +-- . +-- +-- [@synthesiser@] This is also an array of tables containing descriptions of +-- the different synthesisers that should be used. The synthesisers that are +-- currently supported are: +-- +-- - +-- - +-- - +-- - +-- +-- === Default Configuration +-- +-- >>> T.putStrLn $ encodeConfig defaultConfig +-- +-- [probability] +-- eventlist.all = 1 +-- eventlist.clk = 1 +-- eventlist.var = 1 +-- expr.binary = 1 +-- expr.concatenation = 1 +-- expr.number = 1 +-- expr.signed = 1 +-- expr.string = 0 +-- expr.ternary = 1 +-- expr.unary = 1 +-- expr.unsigned = 1 +-- expr.variable = 1 +-- moditem.always = 1 +-- moditem.assign = 5 +-- moditem.instantiation = 1 +-- statement.blocking = 0 +-- statement.conditional = 1 +-- statement.forloop = 1 +-- statement.nonblocking = 15 +-- +-- [property] +-- module.depth = 2 +-- module.max = 5 +-- size = 20 +-- statement.depth = 3 +-- +-- [[synthesiser]] +-- name = "yosys" +-- +-- [[synthesiser]] +-- name = "vivado" +-- + +-- | Probability of different expressions nodes. data ProbExpr = ProbExpr { _probExprNum :: {-# UNPACK #-} !Int + -- ^ Probability of generation a number like + -- @4'ha@. This should never be set to 0, as it is used + -- as a fallback in case there are no viable + -- identifiers, such as none being in scope. , _probExprId :: {-# UNPACK #-} !Int + -- ^ Probability of generating an identifier that is in + -- scope and of the right type. , _probExprUnOp :: {-# UNPACK #-} !Int + -- ^ Probability of generating a unary operator. , _probExprBinOp :: {-# UNPACK #-} !Int + -- ^ Probability of generation a binary operator. , _probExprCond :: {-# UNPACK #-} !Int + -- ^ probability of generating a conditional ternary + -- operator. , _probExprConcat :: {-# UNPACK #-} !Int + -- ^ Probability of generating a concatenation. , _probExprStr :: {-# UNPACK #-} !Int + -- ^ Probability of generating a string. This is not + -- fully supported therefore currently cannot be set. , _probExprSigned :: {-# UNPACK #-} !Int + -- ^ Probability of generating a signed function + -- @$signed(...)@. , _probExprUnsigned :: {-# UNPACK #-} !Int + -- ^ Probability of generating an unsigned function + -- @$unsigned(...)@. } deriving (Eq, Show) +-- | Probability of generating different nodes inside a module declaration. data ProbModItem = ProbModItem { _probModItemAssign :: {-# UNPACK #-} !Int + -- ^ Probability of generating an @assign@. , _probModItemAlways :: {-# UNPACK #-} !Int + -- ^ Probability of generating an @always@ block. , _probModItemInst :: {-# UNPACK #-} !Int + -- ^ Probability of generating a module + -- instantiation. } deriving (Eq, Show) @@ -302,8 +414,8 @@ parseConfig t = case Toml.decode configCodec t of error $ "Type mismatch with key " ++ show k Left _ -> error "Config file parse error" -configEncode :: Config -> Text -configEncode = Toml.encode configCodec +encodeConfig :: Config -> Text +encodeConfig = Toml.encode configCodec -configToFile :: FilePath -> Config -> IO () -configToFile f = T.writeFile f . configEncode +encodeConfigFile :: FilePath -> Config -> IO () +encodeConfigFile f = T.writeFile f . encodeConfig -- cgit