{-| Module : VeriFuzz.Config Description : Configuration file format and parser. Copyright : (c) 2019, Yann Herklotz License : GPL-3 Maintainer : ymherklotz [at] gmail [dot] com Stability : experimental Portability : POSIX TOML Configuration file format and parser. -} {-# LANGUAGE TemplateHaskell #-} module VeriFuzz.Config ( -- * TOML Configuration -- $conf Config(..) , defaultConfig -- ** Probabilities , Probability(..) -- *** Expression , ProbExpr(..) -- *** Module Item , ProbModItem(..) -- *** Statement , ProbStatement(..) -- ** Property , Property(..) -- ** Simulator Description , SimDescription(..) -- ** Synthesiser Description , SynthDescription(..) -- * Useful Lenses , fromXST , fromYosys , fromVivado , fromQuartus , configProbability , configProperty , configSimulators , configSynthesisers , probModItem , probStmnt , probExpr , probExprNum , probExprId , probExprRangeSelect , probExprUnOp , probExprBinOp , probExprCond , probExprConcat , probExprStr , probExprSigned , probExprUnsigned , probModItemAssign , probModItemSeqAlways , probModItemCombAlways , probModItemInst , probStmntBlock , probStmntNonBlock , probStmntCond , probStmntFor , propSize , propSeed , propStmntDepth , propModDepth , propMaxModules , parseConfigFile , parseConfig , encodeConfig , encodeConfigFile ) where import Control.Applicative (Alternative) import Control.Lens hiding ((.=)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text.IO as T import Hedgehog.Internal.Seed (Seed) import Shelly (toTextIgnore) import Toml (TomlCodec, (.=)) import qualified Toml import VeriFuzz.Sim.Quartus import VeriFuzz.Sim.Vivado import VeriFuzz.Sim.XST import VeriFuzz.Sim.Yosys -- $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] -- expr.binary = 5 -- expr.concatenation = 3 -- expr.number = 1 -- expr.rangeselect = 5 -- expr.signed = 5 -- expr.string = 0 -- expr.ternary = 5 -- expr.unary = 5 -- expr.unsigned = 5 -- expr.variable = 5 -- moditem.assign = 5 -- moditem.combinational = 1 -- moditem.instantiation = 1 -- moditem.sequential = 1 -- statement.blocking = 0 -- statement.conditional = 1 -- statement.forloop = 0 -- statement.nonblocking = 3 -- -- [property] -- module.depth = 2 -- module.max = 5 -- size = 20 -- statement.depth = 3 -- -- [[synthesiser]] -- name = "yosys" -- yosys.description = "yosys" -- yosys.output = "syn_yosys.v" -- -- [[synthesiser]] -- name = "vivado" -- vivado.description = "vivado" -- vivado.output = "syn_vivado.v" -- -- | 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. , _probExprRangeSelect :: {-# UNPACK #-} !Int -- ^ Probability of generating a range selection from a port. , _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@. , _probModItemSeqAlways :: {-# UNPACK #-} !Int -- ^ Probability of generating a sequential @always@ block. , _probModItemCombAlways :: {-# UNPACK #-} !Int -- ^ Probability of generating an combinational @always@ block. , _probModItemInst :: {-# UNPACK #-} !Int -- ^ Probability of generating a module -- instantiation. } deriving (Eq, Show) data ProbStatement = ProbStatement { _probStmntBlock :: {-# UNPACK #-} !Int , _probStmntNonBlock :: {-# UNPACK #-} !Int , _probStmntCond :: {-# UNPACK #-} !Int , _probStmntFor :: {-# UNPACK #-} !Int } deriving (Eq, Show) data Probability = Probability { _probModItem :: {-# UNPACK #-} !ProbModItem , _probStmnt :: {-# UNPACK #-} !ProbStatement , _probExpr :: {-# UNPACK #-} !ProbExpr } deriving (Eq, Show) data Property = Property { _propSize :: {-# UNPACK #-} !Int , _propSeed :: !(Maybe Seed) , _propStmntDepth :: {-# UNPACK #-} !Int , _propModDepth :: {-# UNPACK #-} !Int , _propMaxModules :: {-# UNPACK #-} !Int } deriving (Eq, Show) data SimDescription = SimDescription { simName :: {-# UNPACK #-} !Text } deriving (Eq, Show) data SynthDescription = SynthDescription { synthName :: {-# UNPACK #-} !Text , synthYosysBin :: Maybe Text , synthYosysDesc :: Maybe Text , synthYosysOutput :: Maybe Text , synthXstBin :: Maybe Text , synthXstDesc :: Maybe Text , synthXstOutput :: Maybe Text , synthVivadoBin :: Maybe Text , synthVivadoDesc :: Maybe Text , synthVivadoOutput :: Maybe Text , synthQuartusBin :: Maybe Text , synthQuartusDesc :: Maybe Text , synthQuartusOutput :: Maybe Text } deriving (Eq, Show) data Config = Config { _configProbability :: {-# UNPACK #-} !Probability , _configProperty :: {-# UNPACK #-} !Property , _configSimulators :: [SimDescription] , _configSynthesisers :: [SynthDescription] } deriving (Eq, Show) makeLenses ''ProbExpr makeLenses ''ProbModItem makeLenses ''ProbStatement makeLenses ''Probability makeLenses ''Property makeLenses ''Config defaultValue :: (Alternative r, Applicative w) => b -> Toml.Codec r w a b -> Toml.Codec r w a b defaultValue x = Toml.dimap Just (fromMaybe x) . Toml.dioptional fromXST :: XST -> SynthDescription fromXST (XST a b c) = SynthDescription "xst" Nothing Nothing Nothing (toTextIgnore <$> a) (Just b) (Just $ toTextIgnore c) Nothing Nothing Nothing Nothing Nothing Nothing fromYosys :: Yosys -> SynthDescription fromYosys (Yosys a b c) = SynthDescription "yosys" (toTextIgnore <$> a) (Just b) (Just $ toTextIgnore c) Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing fromVivado :: Vivado -> SynthDescription fromVivado (Vivado a b c) = SynthDescription "vivado" Nothing Nothing Nothing Nothing Nothing Nothing (toTextIgnore <$> a) (Just b) (Just $ toTextIgnore c) Nothing Nothing Nothing fromQuartus :: Quartus -> SynthDescription fromQuartus (Quartus a b c) = SynthDescription "quartus" Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (toTextIgnore <$> a) (Just b) (Just $ toTextIgnore c) defaultConfig :: Config defaultConfig = Config (Probability defModItem defStmnt defExpr) (Property 20 Nothing 3 2 5) [] [fromYosys defaultYosys, fromVivado defaultVivado] where defModItem = ProbModItem 5 -- Assign 1 -- Sequential Always 1 -- Combinational Always 1 -- Instantiation defStmnt = ProbStatement 0 -- Blocking assignment 3 -- Non-blocking assignment 1 -- Conditional 0 -- For loop defExpr = ProbExpr 1 -- Number 5 -- Identifier 5 -- Range selection 5 -- Unary operator 5 -- Binary operator 5 -- Ternary conditional 3 -- Concatenation 0 -- String 5 -- Signed function 5 -- Unsigned funtion twoKey :: Toml.Piece -> Toml.Piece -> Toml.Key twoKey a b = Toml.Key (a :| [b]) int :: Toml.Piece -> Toml.Piece -> TomlCodec Int int a = Toml.int . twoKey a exprCodec :: TomlCodec ProbExpr exprCodec = ProbExpr <$> defaultValue (defProb probExprNum) (intE "number") .= _probExprNum <*> defaultValue (defProb probExprId) (intE "variable") .= _probExprId <*> defaultValue (defProb probExprRangeSelect) (intE "rangeselect") .= _probExprRangeSelect <*> defaultValue (defProb probExprUnOp) (intE "unary") .= _probExprUnOp <*> defaultValue (defProb probExprBinOp) (intE "binary") .= _probExprBinOp <*> defaultValue (defProb probExprCond) (intE "ternary") .= _probExprCond <*> defaultValue (defProb probExprConcat) (intE "concatenation") .= _probExprConcat <*> defaultValue (defProb probExprStr) (intE "string") .= _probExprStr <*> defaultValue (defProb probExprSigned) (intE "signed") .= _probExprSigned <*> defaultValue (defProb probExprUnsigned) (intE "unsigned") .= _probExprUnsigned where defProb i = defaultConfig ^. configProbability . probExpr . i intE = int "expr" stmntCodec :: TomlCodec ProbStatement stmntCodec = ProbStatement <$> defaultValue (defProb probStmntBlock) (intS "blocking") .= _probStmntBlock <*> defaultValue (defProb probStmntNonBlock) (intS "nonblocking") .= _probStmntNonBlock <*> defaultValue (defProb probStmntCond) (intS "conditional") .= _probStmntCond <*> defaultValue (defProb probStmntFor) (intS "forloop") .= _probStmntFor where defProb i = defaultConfig ^. configProbability . probStmnt . i intS = int "statement" modItemCodec :: TomlCodec ProbModItem modItemCodec = ProbModItem <$> defaultValue (defProb probModItemAssign) (intM "assign") .= _probModItemAssign <*> defaultValue (defProb probModItemSeqAlways) (intM "sequential") .= _probModItemSeqAlways <*> defaultValue (defProb probModItemCombAlways) (intM "combinational") .= _probModItemCombAlways <*> defaultValue (defProb probModItemInst) (intM "instantiation") .= _probModItemInst where defProb i = defaultConfig ^. configProbability . probModItem . i intM = int "moditem" probCodec :: TomlCodec Probability probCodec = Probability <$> defaultValue (defProb probModItem) modItemCodec .= _probModItem <*> defaultValue (defProb probStmnt) stmntCodec .= _probStmnt <*> defaultValue (defProb probExpr) exprCodec .= _probExpr where defProb i = defaultConfig ^. configProbability . i propCodec :: TomlCodec Property propCodec = Property <$> defaultValue (defProp propSize) (Toml.int "size") .= _propSize <*> Toml.dioptional (Toml.read "seed") .= _propSeed <*> defaultValue (defProp propStmntDepth) (int "statement" "depth") .= _propStmntDepth <*> defaultValue (defProp propModDepth) (int "module" "depth") .= _propModDepth <*> defaultValue (defProp propMaxModules) (int "module" "max") .= _propMaxModules where defProp i = defaultConfig ^. configProperty . i simulator :: TomlCodec SimDescription simulator = Toml.textBy pprint parseIcarus "name" where parseIcarus i@"icarus" = Right $ SimDescription i parseIcarus s = Left $ "Could not match '" <> s <> "' with a simulator." pprint (SimDescription a) = a synthesiser :: TomlCodec SynthDescription synthesiser = SynthDescription <$> Toml.textBy id parseSynth "name" .= synthName <*> Toml.dioptional (Toml.text $ twoKey "yosys" "bin") .= synthYosysBin <*> Toml.dioptional (Toml.text $ twoKey "yosys" "description") .= synthYosysDesc <*> Toml.dioptional (Toml.text $ twoKey "yosys" "output") .= synthYosysOutput <*> Toml.dioptional (Toml.text $ twoKey "xst" "bin") .= synthXstBin <*> Toml.dioptional (Toml.text $ twoKey "xst" "description") .= synthXstDesc <*> Toml.dioptional (Toml.text $ twoKey "xst" "output") .= synthXstOutput <*> Toml.dioptional (Toml.text $ twoKey "vivado" "bin") .= synthVivadoBin <*> Toml.dioptional (Toml.text $ twoKey "vivado" "description") .= synthVivadoDesc <*> Toml.dioptional (Toml.text $ twoKey "vivado" "output") .= synthVivadoOutput <*> Toml.dioptional (Toml.text $ twoKey "quartus" "bin") .= synthQuartusBin <*> Toml.dioptional (Toml.text $ twoKey "quartus" "description") .= synthQuartusDesc <*> Toml.dioptional (Toml.text $ twoKey "quartus" "output") .= synthQuartusOutput where parseSynth s@"yosys" = Right s parseSynth s@"vivado" = Right s parseSynth s@"quartus" = Right s parseSynth s@"xst" = Right s parseSynth s = Left $ "Could not match '" <> s <> "' with a synthesiser." configCodec :: TomlCodec Config configCodec = Config <$> defaultValue (defaultConfig ^. configProbability) (Toml.table probCodec "probability") .= _configProbability <*> defaultValue (defaultConfig ^. configProperty) (Toml.table propCodec "property") .= _configProperty <*> defaultValue (defaultConfig ^. configSimulators) (Toml.list simulator "simulator") .= _configSimulators <*> defaultValue (defaultConfig ^. configSynthesisers) (Toml.list synthesiser "synthesiser") .= _configSynthesisers parseConfigFile :: FilePath -> IO Config parseConfigFile = Toml.decodeFile configCodec parseConfig :: Text -> Config parseConfig t = case Toml.decode configCodec t of Right c -> c Left Toml.TrivialError -> error "Trivial error while parsing Toml config" Left (Toml.KeyNotFound k) -> error $ "Key " ++ show k ++ " not found" Left (Toml.TableNotFound k) -> error $ "Table " ++ show k ++ " not found" Left (Toml.TypeMismatch k _ _) -> error $ "Type mismatch with key " ++ show k Left _ -> error "Config file parse error" encodeConfig :: Config -> Text encodeConfig = Toml.encode configCodec encodeConfigFile :: FilePath -> Config -> IO () encodeConfigFile f = T.writeFile f . encodeConfig