diff options
Diffstat (limited to 'src/VeriFuzz/Verilog')
| -rw-r--r-- | src/VeriFuzz/Verilog/AST.hs | 135 | ||||
| -rw-r--r-- | src/VeriFuzz/Verilog/CodeGen.hs | 128 | ||||
| -rw-r--r-- | src/VeriFuzz/Verilog/Helpers.hs | 16 | ||||
| -rw-r--r-- | src/VeriFuzz/Verilog/Mutate.hs | 113 |
4 files changed, 230 insertions, 162 deletions
diff --git a/src/VeriFuzz/Verilog/AST.hs b/src/VeriFuzz/Verilog/AST.hs index 35f678f..dd61f03 100644 --- a/src/VeriFuzz/Verilog/AST.hs +++ b/src/VeriFuzz/Verilog/AST.hs @@ -15,53 +15,112 @@ Defines the types to build a Verilog AST. module VeriFuzz.Verilog.AST ( -- * Top level types - VerilogSrc(..), getVerilogSrc - , Description(..), getDescription + VerilogSrc(..) + , getVerilogSrc + , Description(..) + , getDescription -- * Primitives -- ** Identifier - , Identifier(..), getIdentifier + , Identifier(..) + , getIdentifier -- ** Control - , Delay(..), getDelay + , Delay(..) + , getDelay , Event(..) -- ** Operators , BinaryOperator(..) , UnaryOperator(..) -- ** Task - , Task(..), taskName, taskExpr + , Task(..) + , taskName + , taskExpr -- ** Left hand side value - , LVal(..), regId, regExprId, regExpr, regSizeId, regSizeMSB - , regSizeLSB, regConc + , LVal(..) + , regId + , regExprId + , regExpr + , regSizeId + , regSizeMSB + , regSizeLSB + , regConc -- ** Ports , PortDir(..) - , PortType(..), regSigned - , Port(..), portType, portSize, portName + , PortType(..) + , regSigned + , Port(..) + , portType + , portSize + , portName -- * Expression - , Expr(..), exprSize, exprVal, exprId, exprConcat - , exprUnOp, exprPrim, exprLhs, exprBinOp, exprRhs - , exprCond, exprTrue, exprFalse, exprStr, traverseExpr - , ConstExpr(..), constNum + , Expr(..) + , exprSize + , exprVal + , exprId + , exprConcat + , exprUnOp + , exprPrim + , exprLhs + , exprBinOp + , exprRhs + , exprCond + , exprTrue + , exprFalse + , exprStr + , traverseExpr + , ConstExpr(..) + , constNum -- * Assignment - , Assign(..), assignReg, assignDelay, assignExpr - , ContAssign(..), contAssignNetLVal, contAssignExpr + , Assign(..) + , assignReg + , assignDelay + , assignExpr + , ContAssign(..) + , contAssignNetLVal + , contAssignExpr -- * Statment - , Stmnt(..), statDelay, statDStat, statEvent, statEStat, statements - , stmntBA, stmntNBA, stmntCA, stmntTask, stmntSysTask + , Stmnt(..) + , statDelay + , statDStat + , statEvent + , statEStat + , statements + , stmntBA + , stmntNBA + , stmntCA + , stmntTask + , stmntSysTask -- * Module - , ModDecl(..), moduleId, modOutPorts, modInPorts, modItems - , ModItem(..), _ModCA, modInstId, modInstName, modInstConns, declDir, declPort - , ModConn(..), modConn - ) where - -import Control.Lens (makeLenses, makePrisms) -import Control.Monad (replicateM) -import Data.String (IsString, fromString) -import Data.Text (Text) -import qualified Data.Text as T -import Data.Traversable (sequenceA) -import qualified Test.QuickCheck as QC + , ModDecl(..) + , moduleId + , modOutPorts + , modInPorts + , modItems + , ModItem(..) + , _ModCA + , modInstId + , modInstName + , modInstConns + , declDir + , declPort + , ModConn(..) + , modConn + ) +where + +import Control.Lens ( makeLenses + , makePrisms + ) +import Control.Monad ( replicateM ) +import Data.String ( IsString + , fromString + ) +import Data.Text ( Text ) +import qualified Data.Text as T +import Data.Traversable ( sequenceA ) +import qualified Test.QuickCheck as QC positiveArb :: (QC.Arbitrary a, Ord a, Num a) => QC.Gen a -positiveArb = QC.suchThat QC.arbitrary (>0) +positiveArb = QC.suchThat QC.arbitrary (> 0) -- | Identifier in Verilog. This is just a string of characters that can either -- be lowercase and uppercase for now. This might change in the future though, @@ -232,23 +291,24 @@ expr n [ Id <$> QC.arbitrary , Number <$> positiveArb <*> QC.arbitrary , Concat <$> QC.listOf1 (subexpr 4) - , UnOp <$> QC.arbitrary <*> QC.arbitrary + , UnOp + <$> QC.arbitrary + <*> QC.arbitrary -- , Str <$> QC.arbitrary , BinOp <$> subexpr 2 <*> QC.arbitrary <*> subexpr 2 , Cond <$> subexpr 3 <*> subexpr 3 <*> subexpr 3 ] | otherwise = expr 0 - where - subexpr y = expr (n `div` y) + where subexpr y = expr (n `div` y) instance QC.Arbitrary Expr where arbitrary = QC.sized expr traverseExpr :: (Applicative f) => (Expr -> f Expr) -> Expr -> f Expr -traverseExpr f (Concat e) = Concat <$> sequenceA (f <$> e) -traverseExpr f (UnOp un e) = UnOp un <$> f e +traverseExpr f (Concat e ) = Concat <$> sequenceA (f <$> e) +traverseExpr f (UnOp un e ) = UnOp un <$> f e traverseExpr f (BinOp l op r) = BinOp <$> f l <*> pure op <*> f r -traverseExpr f (Cond c l r) = Cond <$> f c <*> f l <*> f r +traverseExpr f (Cond c l r) = Cond <$> f c <*> f l <*> f r traverseExpr _ e = pure e makeLenses ''Expr @@ -409,8 +469,7 @@ statement n , SysTaskEnable <$> QC.arbitrary ] | otherwise = statement 0 - where - substat y = statement (n `div` y) + where substat y = statement (n `div` y) instance QC.Arbitrary Stmnt where arbitrary = QC.sized statement diff --git a/src/VeriFuzz/Verilog/CodeGen.hs b/src/VeriFuzz/Verilog/CodeGen.hs index fbc2fc1..338838f 100644 --- a/src/VeriFuzz/Verilog/CodeGen.hs +++ b/src/VeriFuzz/Verilog/CodeGen.hs @@ -15,12 +15,14 @@ This module generates the code from the Verilog AST defined in module VeriFuzz.Verilog.CodeGen where -import Control.Lens (view, (^.)) -import Data.Foldable (fold) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Numeric (showHex) +import Control.Lens ( view + , (^.) + ) +import Data.Foldable ( fold ) +import Data.Text ( Text ) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Numeric ( showHex ) import VeriFuzz.Verilog.AST -- | 'Source' class which determines that source code is able to be generated @@ -44,29 +46,30 @@ defMap = maybe ";\n" genStmnt -- | Convert the 'VerilogSrc' type to 'Text' so that it can be rendered. genVerilogSrc :: VerilogSrc -> Text -genVerilogSrc source = - fold $ genDescription <$> source ^. getVerilogSrc +genVerilogSrc source = fold $ genDescription <$> source ^. getVerilogSrc -- | Generate the 'Description' to 'Text'. genDescription :: Description -> Text -genDescription desc = - genModuleDecl $ desc ^. getDescription +genDescription desc = genModuleDecl $ desc ^. getDescription -- | Generate the 'ModDecl' for a module and convert it to 'Text'. genModuleDecl :: ModDecl -> Text genModuleDecl m = - "module " <> m ^. moduleId . getIdentifier - <> ports <> ";\n" - <> modI - <> "endmodule\n" - where - ports - | noIn && noOut = "" - | otherwise = "(" <> comma (genModPort <$> outIn) <> ")" - modI = fold $ genModuleItem <$> m ^. modItems - noOut = null $ m ^. modOutPorts - noIn = null $ m ^. modInPorts - outIn = (m ^. modOutPorts) ++ (m ^. modInPorts) + "module " + <> m + ^. moduleId + . getIdentifier + <> ports + <> ";\n" + <> modI + <> "endmodule\n" + where + ports | noIn && noOut = "" + | otherwise = "(" <> comma (genModPort <$> outIn) <> ")" + modI = fold $ genModuleItem <$> m ^. modItems + noOut = null $ m ^. modOutPorts + noIn = null $ m ^. modInPorts + outIn = (m ^. modOutPorts) ++ (m ^. modInPorts) -- | Conversts 'Port' to 'Text' for the module list, which means it only -- generates a list of identifiers. @@ -75,14 +78,12 @@ genModPort port = port ^. portName . getIdentifier -- | Generate the 'Port' description. genPort :: Port -> Text -genPort port = - t <> size <> name - where - t = (<>" ") . genPortType $ port ^. portType - size - | port ^. portSize > 1 = "[" <> showT (port ^. portSize - 1) <> ":0] " - | otherwise = "" - name = port ^. portName . getIdentifier +genPort port = t <> size <> name + where + t = (<> " ") . genPortType $ port ^. portType + size | port ^. portSize > 1 = "[" <> showT (port ^. portSize - 1) <> ":0] " + | otherwise = "" + name = port ^. portName . getIdentifier -- | Convert the 'PortDir' type to 'Text'. genPortDir :: PortDir -> Text @@ -96,30 +97,26 @@ genModuleItem (ModCA ca) = genContAssign ca genModuleItem (ModInst (Identifier i) (Identifier name) conn) = i <> " " <> name <> "(" <> comma (genExpr . _modConn <$> conn) <> ")" <> ";\n" genModuleItem (Initial stat) = "initial " <> genStmnt stat -genModuleItem (Always stat) = "always " <> genStmnt stat +genModuleItem (Always stat) = "always " <> genStmnt stat genModuleItem (Decl dir port) = (maybe "" makePort dir) <> genPort port <> ";\n" - where - makePort = (<>" ") . genPortDir + where makePort = (<> " ") . genPortDir -- | Generate continuous assignment genContAssign :: ContAssign -> Text -genContAssign (ContAssign val e) = - "assign " <> name <> " = " <> expr <> ";\n" - where - name = val ^. getIdentifier - expr = genExpr e +genContAssign (ContAssign val e) = "assign " <> name <> " = " <> expr <> ";\n" + where + name = val ^. getIdentifier + expr = genExpr e -- | Generate 'Expr' to 'Text'. genExpr :: Expr -> Text genExpr (BinOp eRhs bin eLhs) = "(" <> genExpr eRhs <> genBinaryOperator bin <> genExpr eLhs <> ")" -genExpr (Number s n) = - showT s <> "'h" <> T.pack (showHex n "") -genExpr (Id i) = i ^. getIdentifier -genExpr (Concat c) = "{" <> comma (genExpr <$> c) <> "}" -genExpr (UnOp u e) = - "(" <> genUnaryOperator u <> genExpr e <> ")" +genExpr (Number s n) = showT s <> "'h" <> T.pack (showHex n "") +genExpr (Id i ) = i ^. getIdentifier +genExpr (Concat c ) = "{" <> comma (genExpr <$> c) <> "}" +genExpr (UnOp u e ) = "(" <> genUnaryOperator u <> genExpr e <> ")" genExpr (Cond l t f) = "(" <> genExpr l <> " ? " <> genExpr t <> " : " <> genExpr f <> ")" genExpr (Str t) = "\"" <> t <> "\"" @@ -167,7 +164,7 @@ genUnaryOperator UnNxorInv = "^~" -- | Generate verilog code for an 'Event'. genEvent :: Event -> Text -genEvent (EId i) = "@(" <> i ^. getIdentifier <> ")" +genEvent (EId i ) = "@(" <> i ^. getIdentifier <> ")" genEvent (EExpr expr) = "@(" <> genExpr expr <> ")" genEvent EAll = "@*" @@ -177,44 +174,45 @@ genDelay (Delay i) = "#" <> showT i -- | Generate the verilog code for an 'LVal'. genLVal :: LVal -> Text -genLVal (RegId i) = i ^. getIdentifier -genLVal (RegExpr i expr) = - i ^. getIdentifier <> " [" <> genExpr expr <> "]" +genLVal (RegId i ) = i ^. getIdentifier +genLVal (RegExpr i expr) = i ^. getIdentifier <> " [" <> genExpr expr <> "]" genLVal (RegSize i msb lsb) = - i ^. getIdentifier <> " [" <> genConstExpr msb <> ":" <> genConstExpr lsb <> "]" -genLVal (RegConcat e) = - "{" <> comma (genExpr <$> e) <> "}" + i + ^. getIdentifier + <> " [" + <> genConstExpr msb + <> ":" + <> genConstExpr lsb + <> "]" +genLVal (RegConcat e) = "{" <> comma (genExpr <$> e) <> "}" genConstExpr :: ConstExpr -> Text genConstExpr (ConstExpr num) = showT num genPortType :: PortType -> Text genPortType Wire = "wire" -genPortType (Reg signed) - | signed = "reg signed" - | otherwise = "reg" +genPortType (Reg signed) | signed = "reg signed" + | otherwise = "reg" genAssign :: Text -> Assign -> Text genAssign op (Assign r d e) = genLVal r <> op <> maybe "" genDelay d <> genExpr e genStmnt :: Stmnt -> Text -genStmnt (TimeCtrl d stat) = genDelay d <> " " <> defMap stat -genStmnt (EventCtrl e stat) = genEvent e <> " " <> defMap stat -genStmnt (SeqBlock s) = - "begin\n" <> fold (genStmnt <$> s) <> "end\n" -genStmnt (BlockAssign a) = genAssign " = " a <> ";\n" -genStmnt (NonBlockAssign a) = genAssign " <= " a <> ";\n" -genStmnt (StatCA a) = genContAssign a -genStmnt (TaskEnable task) = genTask task <> ";\n" -genStmnt (SysTaskEnable task) = "$" <> genTask task <> ";\n" +genStmnt (TimeCtrl d stat ) = genDelay d <> " " <> defMap stat +genStmnt (EventCtrl e stat ) = genEvent e <> " " <> defMap stat +genStmnt (SeqBlock s ) = "begin\n" <> fold (genStmnt <$> s) <> "end\n" +genStmnt (BlockAssign a ) = genAssign " = " a <> ";\n" +genStmnt (NonBlockAssign a ) = genAssign " <= " a <> ";\n" +genStmnt (StatCA a ) = genContAssign a +genStmnt (TaskEnable task) = genTask task <> ";\n" +genStmnt (SysTaskEnable task) = "$" <> genTask task <> ";\n" genTask :: Task -> Text genTask (Task name expr) | null expr = i | otherwise = i <> "(" <> comma (genExpr <$> expr) <> ")" - where - i = name ^. getIdentifier + where i = name ^. getIdentifier -- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'. render :: (Source a) => a -> IO () diff --git a/src/VeriFuzz/Verilog/Helpers.hs b/src/VeriFuzz/Verilog/Helpers.hs index 554b8ba..53d219b 100644 --- a/src/VeriFuzz/Verilog/Helpers.hs +++ b/src/VeriFuzz/Verilog/Helpers.hs @@ -13,7 +13,7 @@ Defaults and common functions. module VeriFuzz.Verilog.Helpers where import Control.Lens -import Data.Text (Text) +import Data.Text ( Text ) import VeriFuzz.Verilog.AST regDecl :: Identifier -> ModItem @@ -38,16 +38,16 @@ addDescription :: Description -> VerilogSrc -> VerilogSrc addDescription desc = getVerilogSrc %~ (:) desc testBench :: ModDecl -testBench = - ModDecl "main" [] [] +testBench = ModDecl + "main" + [] + [] [ regDecl "a" , regDecl "b" , wireDecl "c" - , ModInst "and" "and_gate" - [ ModConn $ Id "c" - , ModConn $ Id "a" - , ModConn $ Id "b" - ] + , ModInst "and" + "and_gate" + [ModConn $ Id "c", ModConn $ Id "a", ModConn $ Id "b"] , Initial $ SeqBlock [ BlockAssign . Assign (RegId "a") Nothing $ Number 1 1 , BlockAssign . Assign (RegId "b") Nothing $ Number 1 1 diff --git a/src/VeriFuzz/Verilog/Mutate.hs b/src/VeriFuzz/Verilog/Mutate.hs index eddb93a..bca1c39 100644 --- a/src/VeriFuzz/Verilog/Mutate.hs +++ b/src/VeriFuzz/Verilog/Mutate.hs @@ -14,7 +14,9 @@ more random patterns, such as nesting wires instead of creating new ones. module VeriFuzz.Verilog.Mutate where import Control.Lens -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe ( catMaybes + , fromMaybe + ) import VeriFuzz.Internal.Gen import VeriFuzz.Internal.Shared import VeriFuzz.Verilog.AST @@ -23,27 +25,25 @@ import VeriFuzz.Verilog.CodeGen -- | Return if the 'Identifier' is in a 'ModDecl'. inPort :: Identifier -> ModDecl -> Bool inPort i m = inInput - where - inInput = any (\a -> a ^. portName == i) $ m ^. modInPorts ++ m ^. modOutPorts + where + inInput = + any (\a -> a ^. portName == i) $ m ^. modInPorts ++ m ^. modOutPorts -- | Find the last assignment of a specific wire/reg to an expression, and -- returns that expression. findAssign :: Identifier -> [ModItem] -> Maybe Expr -findAssign i items = - safe last . catMaybes $ isAssign <$> items - where - isAssign (ModCA (ContAssign val expr)) - | val == i = Just expr - | otherwise = Nothing - isAssign _ = Nothing +findAssign i items = safe last . catMaybes $ isAssign <$> items + where + isAssign (ModCA (ContAssign val expr)) | val == i = Just expr + | otherwise = Nothing + isAssign _ = Nothing -- | Transforms an expression by replacing an Identifier with an -- expression. This is used inside 'transformOf' and 'traverseExpr' to replace -- the 'Identifier' recursively. idTrans :: Identifier -> Expr -> Expr -> Expr -idTrans i expr (Id id') - | id' == i = expr - | otherwise = Id id' +idTrans i expr (Id id') | id' == i = expr + | otherwise = Id id' idTrans _ _ e = e -- | Replaces the identifier recursively in an expression. @@ -58,27 +58,28 @@ replace = (transformOf traverseExpr .) . idTrans -- expression. This would require a different approach though. nestId :: Identifier -> ModDecl -> ModDecl nestId i m - | not $ inPort i m = - let expr = fromMaybe def . findAssign i $ m ^. modItems - in m & get %~ replace i expr - | otherwise = m - where - get = modItems . traverse . _ModCA . contAssignExpr - def = Id i + | not $ inPort i m + = let expr = fromMaybe def . findAssign i $ m ^. modItems + in m & get %~ replace i expr + | otherwise + = m + where + get = modItems . traverse . _ModCA . contAssignExpr + def = Id i -- | Replaces an identifier by a expression in all the module declaration. nestSource :: Identifier -> VerilogSrc -> VerilogSrc -nestSource i src = - src & getVerilogSrc . traverse . getDescription %~ nestId i +nestSource i src = src & getVerilogSrc . traverse . getDescription %~ nestId i -- | Nest variables in the format @w[0-9]*@ up to a certain number. nestUpTo :: Int -> VerilogSrc -> VerilogSrc nestUpTo i src = - foldl (flip nestSource) src $ Identifier . fromNode <$> [1..i] + foldl (flip nestSource) src $ Identifier . fromNode <$> [1 .. i] allVars :: ModDecl -> [Identifier] allVars m = - (m ^.. modOutPorts . traverse . portName) ++ (m ^.. modInPorts . traverse . portName) + (m ^.. modOutPorts . traverse . portName) + ++ (m ^.. modInPorts . traverse . portName) -- $setup -- >>> let m = (ModDecl (Identifier "m") [Port Wire 5 (Identifier "y")] [Port Wire 5 "x"] []) -- >>> let main = (ModDecl "main" [] [] []) @@ -95,14 +96,21 @@ allVars m = -- endmodule -- <BLANKLINE> instantiateMod :: ModDecl -> ModDecl -> ModDecl -instantiateMod m main = - main & modItems %~ ((out ++ regIn ++ [inst])++) - where - out = Decl Nothing <$> m ^. modOutPorts - regIn = Decl Nothing <$> (m ^. modInPorts & traverse . portType .~ Reg False) - inst = ModInst (m ^. moduleId) (m ^. moduleId <> (Identifier . showT $ count+1)) conns - count = length . filter (==m ^. moduleId) $ main ^.. modItems . traverse . modInstId - conns = ModConn . Id <$> allVars m +instantiateMod m main = main & modItems %~ ((out ++ regIn ++ [inst]) ++) + where + out = Decl Nothing <$> m ^. modOutPorts + regIn = Decl Nothing <$> (m ^. modInPorts & traverse . portType .~ Reg False) + inst = ModInst (m ^. moduleId) + (m ^. moduleId <> (Identifier . showT $ count + 1)) + conns + count = + length + . filter (== m ^. moduleId) + $ main + ^.. modItems + . traverse + . modInstId + conns = ModConn . Id <$> allVars m -- | Instantiate without adding wire declarations. It also does not count the -- current instantiations of the same module. @@ -111,11 +119,13 @@ instantiateMod m main = -- m m(y, x); -- <BLANKLINE> instantiateMod_ :: ModDecl -> ModItem -instantiateMod_ m = - ModInst (m ^. moduleId) (m ^. moduleId) conns - where - conns = ModConn . Id <$> - (m ^.. modOutPorts . traverse . portName) ++ (m ^.. modInPorts . traverse . portName) +instantiateMod_ m = ModInst (m ^. moduleId) (m ^. moduleId) conns + where + conns = + ModConn + . Id + <$> (m ^.. modOutPorts . traverse . portName) + ++ (m ^.. modInPorts . traverse . portName) -- | Initialise all the inputs and outputs to a module. -- @@ -126,23 +136,24 @@ instantiateMod_ m = -- endmodule -- <BLANKLINE> initMod :: ModDecl -> ModDecl -initMod m = m & modItems %~ ((out ++ inp)++) - where - out = Decl (Just PortOut) <$> (m ^. modOutPorts) - inp = Decl (Just PortIn) <$> (m ^. modInPorts) +initMod m = m & modItems %~ ((out ++ inp) ++) + where + out = Decl (Just PortOut) <$> (m ^. modOutPorts) + inp = Decl (Just PortIn) <$> (m ^. modInPorts) makeIdFrom :: (Show a) => a -> Identifier -> Identifier -makeIdFrom a i = - (i<>) . Identifier . ("_"<>) $ showT a +makeIdFrom a i = (i <>) . Identifier . ("_" <>) $ showT a -- | Make top level module for equivalence verification. Also takes in how many -- modules to instantiate. makeTop :: Int -> ModDecl -> ModDecl -makeTop i m = - ModDecl (m ^. moduleId) ys (m ^. modInPorts) modIt - where - ys = Port Wire 90 . (flip makeIdFrom) "y" <$> [1..i] - modIt = instantiateMod_ . modN <$> [1..i] - modN n = m - & moduleId %~ makeIdFrom n - & modOutPorts .~ [Port Wire 90 (makeIdFrom n "y")] +makeTop i m = ModDecl (m ^. moduleId) ys (m ^. modInPorts) modIt + where + ys = Port Wire 90 . (flip makeIdFrom) "y" <$> [1 .. i] + modIt = instantiateMod_ . modN <$> [1 .. i] + modN n = + m + & moduleId + %~ makeIdFrom n + & modOutPorts + .~ [Port Wire 90 (makeIdFrom n "y")] |