{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Verismith.Generate
(
procedural
, proceduralIO
, proceduralSrc
, proceduralSrcIO
, randomMod
, largeNum
, wireSize
, range
, genBitVec
, binOp
, unOp
, constExprWithContext
, exprSafeList
, exprRecList
, exprWithContext
, makeIdentifier
, nextPort
, newPort
, scopedExpr
, contAssign
, lvalFromPort
, assignment
, seqBlock
, conditional
, forLoop
, statement
, alwaysSeq
, instantiate
, modInst
, modItem
, constExpr
, parameter
, moduleDef
, someI
, probability
, askProbability
, resizePort
, moduleName
, evalRange
, calcRange
)
where
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
import Verismith.Verilog.BitVec
import Verismith.Verilog.Eval
import Verismith.Verilog.Internal
import Verismith.Verilog.Mutate
data Context = Context { _variables :: [Port]
, _parameters :: [Parameter]
, _modules :: [ModDecl]
, _nameCounter :: {-# UNPACK #-} !Int
, _stmntDepth :: {-# UNPACK #-} !Int
, _modDepth :: {-# UNPACK #-} !Int
, _determinism :: !Bool
}
makeLenses ''Context
type StateGen = ReaderT Config (GenT (State Context))
toId :: Int -> Identifier
toId = Identifier . ("w" <>) . T.pack . show
toPort :: (MonadGen m) => Identifier -> m Port
toPort ident = do
i <- range
return $ wire i ident
sumSize :: [Port] -> Range
sumSize ps = sum $ ps ^.. traverse . portSize
random :: (MonadGen m) => [Port] -> (Expr -> ContAssign) -> m ModItem
random ctx fun = do
expr <- Hog.sized (exprWithContext (ProbExpr 1 1 0 1 1 1 1 0 1 1) [] ctx)
return . ModCA $ fun expr
randomOrdAssigns :: (MonadGen m) => [Port] -> [Port] -> [m ModItem]
randomOrdAssigns inp ids = snd $ foldr generate (inp, []) ids
where
generate cid (i, o) = (cid : i, random i (ContAssign (_portName cid)) : o)
randomMod :: (MonadGen m) => Int -> Int -> m ModDecl
randomMod inps total = do
ident <- sequence $ toPort <$> ids
x <- sequence $ randomOrdAssigns (start ident) (end ident)
let inputs_ = take inps ident
let other = drop inps ident
let y = ModCA . ContAssign "y" . fold $ Id <$> drop inps ids
let yport = [wire (sumSize other) "y"]
return . declareMod other $ ModDecl "test_module"
yport
inputs_
(x ++ [y])
[]
where
ids = toId <$> [1 .. total]
end = drop inps
start = take inps
lvalFromPort :: Port -> LVal
lvalFromPort (Port _ _ _ i) = RegId i
probability :: Config -> Probability
probability c = c ^. configProbability
askProbability :: StateGen Probability
askProbability = asks probability
largeNum :: (MonadGen m) => m Int
largeNum = Hog.int $ Hog.linear (-100) 100
wireSize :: (MonadGen m) => m Int
wireSize = Hog.int $ Hog.linear 2 100
range :: (MonadGen m) => m Range
range = Range <$> fmap fromIntegral wireSize <*> pure 0
genBitVec :: (MonadGen m) => m BitVec
genBitVec = fmap fromIntegral largeNum
binOp :: (MonadGen m) => m BinaryOperator
binOp = Hog.element
[ BinPlus
, BinMinus
, BinTimes
, BinEq
, BinNEq
, BinLAnd
, BinLOr
, BinLT
, BinLEq
, BinGT
, BinGEq
, BinAnd
, BinOr
, BinXor
, BinXNor
, BinXNorInv
, BinLSL
, BinLSR
, BinASL
, BinASR
]
unOp :: (MonadGen m) => m UnaryOperator
unOp = Hog.element
[ UnPlus
, UnMinus
, UnNot
, UnLNot
, UnAnd
, UnNand
, UnOr
, UnNor
, UnXor
, UnNxor
, UnNxorInv
]
constExprWithContext :: (MonadGen m) => [Parameter] -> ProbExpr -> Hog.Size -> m ConstExpr
constExprWithContext ps prob size
| size == 0 = Hog.frequency
[ (prob ^. probExprNum, ConstNum <$> genBitVec)
, ( if null ps then 0 else prob ^. probExprId
, ParamId . view paramIdent <$> Hog.element ps
)
]
| size > 0 = Hog.frequency
[ (prob ^. probExprNum, ConstNum <$> genBitVec)
, ( if null ps then 0 else prob ^. probExprId
, ParamId . view paramIdent <$> Hog.element ps
)
, (prob ^. probExprUnOp, ConstUnOp <$> unOp <*> subexpr 2)
, ( prob ^. probExprBinOp
, ConstBinOp <$> subexpr 2 <*> binOp <*> subexpr 2
)
, ( prob ^. probExprCond
, ConstCond <$> subexpr 2 <*> subexpr 2 <*> subexpr 2
)
, ( prob ^. probExprConcat
, ConstConcat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2)
)
]
| otherwise = constExprWithContext ps prob 0
where subexpr y = constExprWithContext ps prob $ size `div` y
exprSafeList :: (MonadGen m) => ProbExpr -> [(Int, m Expr)]
exprSafeList prob = [(prob ^. probExprNum, Number <$> genBitVec)]
exprRecList :: (MonadGen m) => ProbExpr -> (Hog.Size -> m Expr) -> [(Int, m Expr)]
exprRecList prob subexpr =
[ (prob ^. probExprNum, Number <$> genBitVec)
, ( prob ^. probExprConcat
, Concat <$> Hog.nonEmpty (Hog.linear 0 10) (subexpr 2)
)
, (prob ^. probExprUnOp , UnOp <$> unOp <*> subexpr 2)
, (prob ^. probExprStr, Str <$> Hog.text (Hog.linear 0 100) Hog.alphaNum)
, (prob ^. probExprBinOp , BinOp <$> subexpr 2 <*> binOp <*> subexpr 2)
, (prob ^. probExprCond , Cond <$> subexpr 2 <*> subexpr 2 <*> subexpr 2)
, (prob ^. probExprSigned , Appl <$> pure "$signed" <*> subexpr 2)
, (prob ^. probExprUnsigned, Appl <$> pure "$unsigned" <*> subexpr 2)
]
rangeSelect :: (MonadGen m) => [Parameter] -> [Port] -> m Expr
rangeSelect ps ports = do
p <- Hog.element ports
let s = calcRange ps (Just 32) $ _portSize p
msb <- Hog.int (Hog.constantFrom (s `div` 2) 0 (s - 1))
lsb <- Hog.int (Hog.constantFrom (msb `div` 2) 0 msb)
return . RangeSelect (_portName p) $ Range (fromIntegral msb)
(fromIntegral lsb)
exprWithContext :: (MonadGen m) => ProbExpr -> [Parameter] -> [Port] -> Hog.Size -> m Expr
exprWithContext prob ps [] n | n == 0 = Hog.frequency $ exprSafeList prob
| n > 0 = Hog.frequency $ exprRecList prob subexpr
| otherwise = exprWithContext prob ps [] 0
where subexpr y = exprWithContext prob ps [] $ n `div` y
exprWithContext prob ps l n
| n == 0
= Hog.frequency
$ (prob ^. probExprId, Id . fromPort <$> Hog.element l)
: exprSafeList prob
| n > 0
= Hog.frequency
$ (prob ^. probExprId , Id . fromPort <$> Hog.element l)
: (prob ^. probExprRangeSelect, rangeSelect ps l)
: exprRecList prob subexpr
| otherwise
= exprWithContext prob ps l 0
where subexpr y = exprWithContext prob ps l $ n `div` y
someI :: Int -> StateGen a -> StateGen [a]
someI m f = do
amount <- Hog.int (Hog.linear 1 m)
replicateM amount f
makeIdentifier :: T.Text -> StateGen Identifier
makeIdentifier prefix = do
context <- get
let ident = Identifier $ prefix <> showT (context ^. nameCounter)
nameCounter += 1
return ident
getPort' :: PortType -> Identifier -> [Port] -> StateGen Port
getPort' pt i c = case filter portId c of
x : _ -> return x
[] -> newPort i pt
where portId (Port pt' _ _ i') = i == i' && pt == pt'
nextPort :: PortType -> StateGen Port
nextPort pt = do
context <- get
ident <- makeIdentifier . T.toLower $ showT pt
getPort' pt ident (_variables context)
newPort :: Identifier -> PortType -> StateGen Port
newPort ident pt = do
p <- Port pt <$> Hog.bool <*> range <*> pure ident
variables %= (p :)
return p
scopedExpr :: StateGen Expr
scopedExpr = do
context <- get
prob <- askProbability
Hog.sized
. exprWithContext (_probExpr prob) (_parameters context)
$ _variables context
contAssign :: StateGen ContAssign
contAssign = do
expr <- scopedExpr
p <- nextPort Wire
return $ ContAssign (p ^. portName) expr
assignment :: StateGen Assign
assignment = do
expr <- scopedExpr
lval <- lvalFromPort <$> nextPort Reg
return $ Assign lval Nothing expr
seqBlock :: StateGen Statement
seqBlock = do
stmntDepth -= 1
tstat <- SeqBlock <$> someI 20 statement
stmntDepth += 1
return tstat
conditional :: StateGen Statement
conditional = do
expr <- scopedExpr
nc <- _nameCounter <$> get
tstat <- seqBlock
nc' <- _nameCounter <$> get
nameCounter .= nc
fstat <- seqBlock
nc'' <- _nameCounter <$> get
nameCounter .= max nc' nc''
return $ CondStmnt expr (Just tstat) (Just fstat)
forLoop :: StateGen Statement
forLoop = do
num <- Hog.int (Hog.linear 0 20)
var <- lvalFromPort <$> nextPort Reg
ForLoop (Assign var Nothing 0)
(BinOp (varId var) BinLT $ fromIntegral num)
(Assign var Nothing $ BinOp (varId var) BinPlus 1)
<$> seqBlock
where varId v = Id (v ^. regId)
statement :: StateGen Statement
statement = do
prob <- askProbability
cont <- get
let defProb i = prob ^. probStmnt . i
Hog.frequency
[ (defProb probStmntBlock , BlockAssign <$> assignment)
, (defProb probStmntNonBlock , NonBlockAssign <$> assignment)
, (onDepth cont (defProb probStmntCond), conditional)
, (onDepth cont (defProb probStmntFor) , forLoop)
]
where onDepth c n = if c ^. stmntDepth > 0 then n else 0
alwaysSeq :: StateGen ModItem
alwaysSeq = Always . EventCtrl (EPosEdge "clk") . Just <$> seqBlock
resizePort :: [Parameter] -> Identifier -> Range -> [Port] -> [Port]
resizePort ps i ra = foldl' func []
where
func l p@(Port t _ ri i')
| i' == i && calc ri < calc ra = (p & portSize .~ ra) : l
| otherwise = p : l
calc = calcRange ps $ Just 64
instantiate :: ModDecl -> StateGen ModItem
instantiate (ModDecl i outP inP _ _) = do
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 <$> get
Hog.choice
[ return . ModInst i ident $ ModConn <$> (toE (outs <> clkPort <> ins) <> insLit)
, ModInst i ident <$> Hog.shuffle
(zipWith ModConnNamed (view portName <$> outP <> clkPort <> inpFixed)
(toE (outs <> clkPort <> ins) <> insLit))
]
where
toE ins = Id . view portName <$> ins
(inpFixed, clkPort) = partition filterFunc inP
filterFunc (Port _ _ _ n)
| n == "clk" = False
| otherwise = True
process p r = do
params <- view parameters <$> get
variables %= resizePort params p r
modInst :: StateGen ModItem
modInst = do
prob <- ask
context <- get
let maxMods = prob ^. configProperty . propMaxModules
if length (context ^. modules) < maxMods
then do
let currMods = context ^. modules
let params = context ^. parameters
let vars = context ^. variables
modules .= []
variables .= []
parameters .= []
modDepth -= 1
chosenMod <- moduleDef Nothing
ncont <- get
let genMods = ncont ^. modules
modDepth += 1
parameters .= params
variables .= vars
modules .= chosenMod : currMods <> genMods
instantiate chosenMod
else Hog.element (context ^. modules) >>= instantiate
modItem :: StateGen ModItem
modItem = do
conf <- ask
let prob = conf ^. configProbability
context <- get
let defProb i = prob ^. probModItem . i
det <- Hog.frequency [ (conf ^. configProperty . propDeterminism, return True)
, (conf ^. configProperty . propNonDeterminism, return False) ]
determinism .= det
Hog.frequency
[ (defProb probModItemAssign , ModCA <$> contAssign)
, (defProb probModItemSeqAlways, alwaysSeq)
, ( if context ^. modDepth > 0 then defProb probModItemInst else 0
, modInst )
]
moduleName :: Maybe Identifier -> StateGen Identifier
moduleName (Just t) = return t
moduleName Nothing = makeIdentifier "module"
constExpr :: StateGen ConstExpr
constExpr = do
prob <- askProbability
context <- get
Hog.sized $ constExprWithContext (context ^. parameters)
(prob ^. probExpr)
parameter :: StateGen Parameter
parameter = do
ident <- makeIdentifier "param"
cexpr <- constExpr
let param = Parameter ident cexpr
parameters %= (param :)
return param
evalRange :: [Parameter] -> Int -> Range -> Range
evalRange ps n (Range l r) = Range (eval l) (eval r)
where eval = ConstNum . cata (evaluateConst ps) . resize n
calcRange :: [Parameter] -> Maybe Int -> Range -> Int
calcRange ps i (Range l r) = eval l - eval r + 1
where
eval a = fromIntegral . cata (evaluateConst ps) $ maybe a (`resize` a) i
identElem :: Port -> [Port] -> Bool
identElem p = elem (p ^. portName) . toListOf (traverse . portName)
moduleDef :: Maybe Identifier -> StateGen ModDecl
moduleDef top = do
name <- moduleName top
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 <- get
config <- ask
let (newPorts, local) = partition (`identElem` portList) $ _variables context
let
size =
evalRange (_parameters context) 32
. sum
$ local
^.. traverse
. portSize
let combine = config ^. configProperty . propCombine
let clock = Port Wire False 1 "clk"
let yport =
if combine then Port Wire False 1 "y" else Port Wire False size "y"
let comb = combineAssigns_ combine yport local
return
. declareMod local
. ModDecl name [yport] (clock : newPorts) (comb : mi)
$ ps
procedural :: T.Text -> Config -> Gen Verilog
procedural top config = do
(mainMod, st) <- Hog.resize num $ runStateT
(Hog.distributeT (runReaderT (moduleDef (Just $ Identifier top)) config))
context
return . Verilog $ mainMod : st ^. modules
where
context =
Context [] [] [] 0 (confProp propStmntDepth) (confProp propModDepth) True
num = fromIntegral $ confProp propSize
confProp i = config ^. configProperty . i
proceduralIO :: T.Text -> Config -> IO Verilog
proceduralIO t = Hog.sample . procedural t
proceduralSrc :: T.Text -> Config -> Gen SourceInfo
proceduralSrc t c = SourceInfo t <$> procedural t c
proceduralSrcIO :: T.Text -> Config -> IO SourceInfo
proceduralSrcIO t c = SourceInfo t <$> proceduralIO t c