Copyright | (c) 2019 Yann Herklotz |
---|---|
License | GPL-3 |
Maintainer | yann [at] yannherklotz [dot] com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | None |
Language | Haskell2010 |
Verismith.Generate
Description
Various useful generators.
Synopsis
- procedural :: Text -> Config -> Gen (Verilog ann)
- proceduralIO :: Text -> Config -> IO (Verilog a)
- proceduralSrc :: Text -> Config -> Gen (SourceInfo ann)
- proceduralSrcIO :: Text -> Config -> IO (SourceInfo ann)
- randomMod :: MonadGen m => Int -> Int -> m (ModDecl ann)
- data EMIContext = EMIContext {
- _emiNewInputs :: [Port]
- emiNewInputs :: Iso' EMIContext [Port]
- data Context a = Context {
- _wires :: [Port]
- _nonblocking :: [Port]
- _blocking :: [Port]
- _outofscope :: [Port]
- _parameters :: [Parameter]
- _modules :: [ModDecl a]
- _nameCounter :: !Int
- _stmntDepth :: !Int
- _modDepth :: !Int
- _determinism :: !Bool
- _emiContext :: !(Maybe EMIContext)
- wires :: forall a f. Functor f => ([Port] -> f [Port]) -> Context a -> f (Context a)
- nonblocking :: forall a f. Functor f => ([Port] -> f [Port]) -> Context a -> f (Context a)
- blocking :: forall a f. Functor f => ([Port] -> f [Port]) -> Context a -> f (Context a)
- outofscope :: forall a f. Functor f => ([Port] -> f [Port]) -> Context a -> f (Context a)
- parameters :: forall a f. Functor f => ([Parameter] -> f [Parameter]) -> Context a -> f (Context a)
- modules :: forall a1 a2 f. Functor f => ([ModDecl a1] -> f [ModDecl a2]) -> Context a1 -> f (Context a2)
- nameCounter :: forall a f. Functor f => (Int -> f Int) -> Context a -> f (Context a)
- stmntDepth :: forall a f. Functor f => (Int -> f Int) -> Context a -> f (Context a)
- modDepth :: forall a f. Functor f => (Int -> f Int) -> Context a -> f (Context a)
- determinism :: forall a f. Functor f => (Bool -> f Bool) -> Context a -> f (Context a)
- emiContext :: forall a f. Functor f => (Maybe EMIContext -> f (Maybe EMIContext)) -> Context a -> f (Context a)
- type StateGen a = ReaderT Config (GenT (State (Context a)))
- largeNum :: MonadGen m => m Int
- wireSize :: MonadGen m => m Int
- range :: MonadGen m => m Range
- genBitVec :: MonadGen m => m BitVec
- binOp :: MonadGen m => m BinaryOperator
- unOp :: MonadGen m => m UnaryOperator
- constExprWithContext :: MonadGen m => [Parameter] -> ProbExpr -> Size -> m ConstExpr
- exprSafeList :: MonadGen m => ProbExpr -> [(Int, m Expr)]
- exprRecList :: MonadGen m => ProbExpr -> (Size -> m Expr) -> [(Int, m Expr)]
- exprWithContext :: MonadGen m => ProbExpr -> [Parameter] -> [Port] -> Size -> m Expr
- makeIdentifier :: Text -> StateGen ann Identifier
- nextWirePort :: Maybe Text -> StateGen ann Port
- nextNBPort :: Maybe Text -> StateGen ann Port
- nextBPort :: Maybe Text -> StateGen ann Port
- newWirePort :: Identifier -> StateGen ann Port
- newNBPort :: Identifier -> StateGen ann Port
- newBPort :: Identifier -> StateGen ann Port
- scopedExpr :: StateGen ann Expr
- contAssign :: StateGen ann ContAssign
- lvalFromPort :: Port -> LVal
- assignment :: Bool -> StateGen ann Assign
- seqBlock :: StateGen ann (Statement ann)
- conditional :: StateGen ann (Statement ann)
- forLoop :: StateGen ann (Statement ann)
- statement :: StateGen ann (Statement ann)
- alwaysSeq :: StateGen ann (ModItem ann)
- instantiate :: ModDecl ann -> StateGen ann (ModItem ann)
- modInst :: StateGen ann (ModItem ann)
- modItem :: StateGen ann (ModItem ann)
- constExpr :: StateGen ann ConstExpr
- parameter :: StateGen ann Parameter
- moduleDef :: Maybe Identifier -> StateGen ann (ModDecl ann)
- someI :: Int -> StateGen ann a -> StateGen ann [a]
- probability :: Config -> Probability
- askProbability :: StateGen ann Probability
- resizePort :: [Parameter] -> Identifier -> Range -> [Port] -> [Port]
- moduleName :: Maybe Identifier -> StateGen ann Identifier
- evalRange :: [Parameter] -> Int -> Range -> Range
- calcRange :: [Parameter] -> Maybe Int -> Range -> Int
Generation methods
proceduralSrc :: Text -> Config -> Gen (SourceInfo ann) Source #
proceduralSrcIO :: Text -> Config -> IO (SourceInfo ann) Source #
Sampled and wrapped into a '(SourceInfo ann)' with the given top module name.
Data types
data EMIContext Source #
Constructors
EMIContext | |
Fields
|
emiNewInputs :: Iso' EMIContext [Port] Source #
Constructors
Context | |
Fields
|
parameters :: forall a f. Functor f => ([Parameter] -> f [Parameter]) -> Context a -> f (Context a) Source #
modules :: forall a1 a2 f. Functor f => ([ModDecl a1] -> f [ModDecl a2]) -> Context a1 -> f (Context a2) Source #
emiContext :: forall a f. Functor f => (Maybe EMIContext -> f (Maybe EMIContext)) -> Context a -> f (Context a) Source #
Generate Functions
largeNum :: MonadGen m => m Int Source #
Generates a random large number, which can also be negative.
wireSize :: MonadGen m => m Int Source #
Generates a random size for a wire so that it is not too small and not too large.
range :: MonadGen m => m Range Source #
Generates a random range by using the wireSize
and 0 as the lower bound.
binOp :: MonadGen m => m BinaryOperator Source #
Return a random BinaryOperator
. This currently excludes BinDiv
,
BinMod
because they can take a long time to synthesis, and BinCEq
,
BinCNEq
, because these are not synthesisable. BinPower
is also excluded
because it can only be used in conjunction with base powers of 2 which is
currently not enforced.
unOp :: MonadGen m => m UnaryOperator Source #
Generate a random UnaryOperator
.
exprRecList :: MonadGen m => ProbExpr -> (Size -> m Expr) -> [(Int, m Expr)] Source #
List of Expr
that have the chance to recurse and will therefore not be
used when the expression grows too large.
makeIdentifier :: Text -> StateGen ann Identifier Source #
Make a new name with a prefix and the current nameCounter. The nameCounter is then increased so that the label is unique.
nextWirePort :: Maybe Text -> StateGen ann Port Source #
Makes a new Identifier
and then checks if the Port
already exists, if
it does the existant Port
is returned, otherwise a new port is created with
newPort
. This is used subsequently in all the functions to create a port,
in case a port with the same name was already created. This could be because
the generation is currently in the other branch of an if-statement.
newWirePort :: Identifier -> StateGen ann Port Source #
Creates a new port based on the current name counter and adds it to the
current context. It will be added to the _wires
list.
newNBPort :: Identifier -> StateGen ann Port Source #
Creates a new port based on the current name counter and adds it to the
current context. It will be added to the _nonblocking
list.
newBPort :: Identifier -> StateGen ann Port Source #
Creates a new port based on the current name counter and adds it to the
current context. It will be added to the _blocking
list.
scopedExpr :: StateGen ann Expr Source #
contAssign :: StateGen ann ContAssign Source #
Generates a random continuous assignment and assigns it to a random wire that is created.
lvalFromPort :: Port -> LVal Source #
Converts a Port
to an LVal
by only keeping the Identifier
of the
Port
.
assignment :: Bool -> StateGen ann Assign Source #
Generate a random assignment and assign it to a random Reg
.
seqBlock :: StateGen ann (Statement ann) Source #
Generate a random Statement
safely, by also increasing the depth counter.
conditional :: StateGen ann (Statement ann) Source #
forLoop :: StateGen ann (Statement ann) Source #
Generate a random for loop by creating a new variable name for the counter and then generating random statements in the body.
alwaysSeq :: StateGen ann (ModItem ann) Source #
Generate a sequential always block which is dependent on the clock.
instantiate :: ModDecl ann -> StateGen ann (ModItem ann) Source #
Instantiate a module, where the outputs are new nets that are created, and the inputs are taken from existing ports in the context.
1 is subtracted from the inputs for the length because the clock is not counted and is assumed to be there, this should be made nicer by filtering out the clock instead. I think that in general there should be a special representation for the clock.
modInst :: StateGen ann (ModItem ann) Source #
Generates a module instance by also generating a new module if there are not enough modules currently in the context. It keeps generating new modules for every instance and for every level until either the deepest level is achieved, or the maximum number of modules are reached.
If the maximum number of levels are reached, it will always pick an instance from the current context. The problem with this approach is that at the end there may be many more than the max amount of modules, as the modules are always set to empty when entering a new level. This is to fix recursive definitions of modules, which are not defined.
One way to fix that is to also decrement the max modules for every level, depending on how many modules have already been generated. This would mean there would be moments when the module cannot generate a new instance but also not take a module from the current context. A fix for that may be to have a default definition of a simple module that is used instead.
Another different way to handle this would be to have a probability of taking a module from a context or generating a new one.
constExpr :: StateGen ann ConstExpr Source #
Generate a random ConstExpr
by using the current context of Parameters
.
parameter :: StateGen ann Parameter Source #
Generate a random Parameter
and assign it to a constant expression which
it will be initialised to. The assumption is that this constant expression
should always be able to be evaluated with the current context of parameters.
moduleDef :: Maybe Identifier -> StateGen ann (ModDecl ann) Source #
Generates a module definition randomly. It always has one output port which
is set to y
. The size of y
is the total combination of all the locally
defined wires, so that it correctly reflects the internal state of the
module.
Helpers
probability :: Config -> Probability Source #
Returns the probability from the configuration.
askProbability :: StateGen ann Probability Source #
Gets the current probabilities from the State
.
resizePort :: [Parameter] -> Identifier -> Range -> [Port] -> [Port] Source #
Should resize a port that connects to a module port if the latter is larger. This should not cause any problems if the same net is used as input multiple times, and is resized multiple times, as it should only get larger.
moduleName :: Maybe Identifier -> StateGen ann Identifier Source #
Either return the Identifier
that was passed to it, or generate a new
Identifier
based on the current nameCounter
.