aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/VeriFuzz/Config.hs14
-rw-r--r--src/VeriFuzz/Verilog/Parser.hs90
-rw-r--r--test/Parser.hs54
3 files changed, 129 insertions, 29 deletions
diff --git a/src/VeriFuzz/Config.hs b/src/VeriFuzz/Config.hs
index 1ce7b11..04b2d78 100644
--- a/src/VeriFuzz/Config.hs
+++ b/src/VeriFuzz/Config.hs
@@ -189,13 +189,13 @@ data Probability = Probability { _probModItem :: {-# UNPACK #-} !ProbModItem
}
deriving (Eq, Show)
-data ConfProperty = ConfProperty { _propSize :: {-# UNPACK #-} !Int
- , _propSeed :: !(Maybe Seed)
- , _propStmntDepth :: {-# UNPACK #-} !Int
- , _propModDepth :: {-# UNPACK #-} !Int
- , _propMaxModules :: {-# UNPACK #-} !Int
- }
- deriving (Eq, Show)
+data ConfProperty = ConfProperty { _propSize :: {-# UNPACK #-} !Int
+ , _propSeed :: !(Maybe Seed)
+ , _propStmntDepth :: {-# UNPACK #-} !Int
+ , _propModDepth :: {-# UNPACK #-} !Int
+ , _propMaxModules :: {-# UNPACK #-} !Int
+ }
+ deriving (Eq, Show)
data Info = Info { _infoCommit :: !Text
, _infoVersion :: !Text
diff --git a/src/VeriFuzz/Verilog/Parser.hs b/src/VeriFuzz/Verilog/Parser.hs
index 6cd1abd..383a72e 100644
--- a/src/VeriFuzz/Verilog/Parser.hs
+++ b/src/VeriFuzz/Verilog/Parser.hs
@@ -17,6 +17,8 @@ module VeriFuzz.Verilog.Parser
, parseModDecl
-- ** Internal parsers
, parseEvent
+ , parseStatement
+ , parseModItem
, Parser
)
where
@@ -27,8 +29,7 @@ import Data.Bifunctor (bimap)
import Data.Bits
import Data.Functor (($>))
import Data.Functor.Identity (Identity)
-import Data.List (null)
-import Data.List (isInfixOf, isPrefixOf)
+import Data.List (isInfixOf, isPrefixOf, null)
import qualified Data.Text as T
import Text.Parsec hiding (satisfy)
import Text.Parsec.Expr
@@ -81,6 +82,9 @@ tok' p = void $ tok p
parens :: Parser a -> Parser a
parens = between (tok SymParenL) (tok SymParenR)
+brackets :: Parser a -> Parser a
+brackets = between (tok SymBrackL) (tok SymBrackR)
+
braces :: Parser a -> Parser a
braces = between (tok SymBraceL) (tok SymBraceR)
@@ -101,6 +105,18 @@ parseNum = decToExpr <$> number
parseVar :: Parser Expr
parseVar = Id <$> identifier
+parseVecSelect :: Parser Expr
+parseVecSelect = do
+ i <- identifier
+ expr <- brackets parseExpr
+ return $ VecSelect i expr
+
+parseRangeSelect :: Parser Expr
+parseRangeSelect = do
+ i <- identifier
+ range <- parseRange
+ return $ RangeSelect i range
+
systemFunc :: Parser String
systemFunc = satisfy' matchId
where
@@ -119,6 +135,8 @@ parseTerm =
<|> (Concat <$> braces (commaSep parseExpr))
<|> parseFun
<|> parseNum
+ <|> try parseVecSelect
+ <|> try parseRangeSelect
<|> parseVar
<?> "simple expr"
@@ -261,8 +279,9 @@ parseNetDecl pd = do
sign <- option False (tok KWSigned $> True)
range <- option 1 parseRange
name <- identifier
+ i <- option Nothing (fmap Just (tok' SymEq *> parseConstExpr))
tok' SymSemi
- return $ Decl pd (Port t sign range name) Nothing
+ return $ Decl pd (Port t sign range name) i
where type_ = tok KWWire $> Wire <|> tok KWReg $> Reg
parsePortDir :: Parser PortDir
@@ -279,9 +298,9 @@ parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing
parseConditional :: Parser Statement
parseConditional = do
- expr <- tok' KWIf *> tok' SymParenL *> parseExpr
+ expr <- tok' KWIf *> parens parseExpr
true <- maybeEmptyStatement
- false <- option Nothing maybeEmptyStatement
+ false <- option Nothing (tok' KWElse *> maybeEmptyStatement)
return $ CondStmnt expr true false
parseLVal :: Parser LVal
@@ -324,9 +343,9 @@ eventList t = do
if null l then fail "Could not parse list" else return l
parseEvent :: Parser Event
-parseEvent = tok' SymAtAster *> return EAll
- <|> try (tok' SymAt *> tok' SymParenLAsterParenR *> return EAll)
- <|> try (tok' SymAt *> tok' SymParenL *> tok' SymAster *> tok' SymParenR *> return EAll)
+parseEvent = tok' SymAtAster $> EAll
+ <|> try (tok' SymAt *> tok' SymParenLAsterParenR $> EAll)
+ <|> try (tok' SymAt *> tok' SymParenL *> tok' SymAster *> tok' SymParenR $> EAll)
<|> try (tok' SymAt *> parens parseEvent')
<|> try (tok' SymAt *> parens (foldr1 EOr <$> eventList KWOr))
<|> try (tok' SymAt *> parens (foldr1 EComb <$> eventList SymComma))
@@ -351,14 +370,27 @@ parseDelayCtrl = do
return $ TimeCtrl delay statement
parseBlocking :: Parser Statement
-parseBlocking = BlockAssign <$> parseAssign SymEq
+parseBlocking = do
+ a <- parseAssign SymEq
+ tok' SymSemi
+ return $ BlockAssign a
parseNonBlocking :: Parser Statement
-parseNonBlocking = NonBlockAssign <$> parseAssign SymLtEq
+parseNonBlocking = do
+ a <- parseAssign SymLtEq
+ tok' SymSemi
+ return $ NonBlockAssign a
+
+parseSeq :: Parser Statement
+parseSeq = do
+ seq' <- tok' KWBegin *> many parseStatement
+ tok' KWEnd
+ return $ SeqBlock seq'
parseStatement :: Parser Statement
parseStatement =
- parseConditional
+ parseSeq
+ <|> parseConditional
<|> parseLoop
<|> parseEventCtrl
<|> parseDelayCtrl
@@ -376,10 +408,32 @@ parseAlways = tok' KWAlways *> (Always <$> parseStatement)
parseInitial :: Parser ModItem
parseInitial = tok' KWInitial *> (Initial <$> parseStatement)
+namedModConn :: Parser ModConn
+namedModConn = do
+ target <- tok' SymDot *> identifier
+ expr <- parens parseExpr
+ return $ ModConnNamed target expr
+
+parseModConn :: Parser ModConn
+parseModConn =
+ try (fmap ModConn parseExpr)
+ <|> namedModConn
+
+parseModInst :: Parser ModItem
+parseModInst = do
+ m <- identifier
+ name <- identifier
+ modconns <- parens (commaSep parseModConn)
+ tok' SymSemi
+ return $ ModInst m name modconns
+
parseModItem :: Parser ModItem
-parseModItem = (ModCA <$> parseContAssign) <|> parseDecl
+parseModItem =
+ try (ModCA <$> parseContAssign)
+ <|> try parseDecl
<|> parseAlways
<|> parseInitial
+ <|> parseModInst
parseModList :: Parser [Identifier]
parseModList = list <|> return [] where list = parens $ commaSep identifier
@@ -391,9 +445,19 @@ filterDecl _ _ = False
modPorts :: PortDir -> [ModItem] -> [Port]
modPorts p mis = filter (filterDecl p) mis ^.. traverse . declPort
+parseParam :: Parser Parameter
+parseParam = do
+ i <- tok' KWParameter *> identifier
+ expr <- tok' SymEq *> parseConstExpr
+ return $ Parameter i expr
+
+parseParams :: Parser [Parameter]
+parseParams = tok' SymPound *> parens (commaSep parseParam)
+
parseModDecl :: Parser ModDecl
parseModDecl = do
name <- tok KWModule *> identifier
+ paramList <- option [] $ try parseParams
_ <- fmap defaultPort <$> parseModList
tok' SymSemi
modItem <- option [] . try $ many1 parseModItem
@@ -402,7 +466,7 @@ parseModDecl = do
(modPorts PortOut modItem)
(modPorts PortIn modItem)
modItem
- []
+ paramList
-- | Parses a 'String' into 'Verilog' by skipping any beginning whitespace
-- and then parsing multiple Verilog source.
diff --git a/test/Parser.hs b/test/Parser.hs
index 3c0b77d..d473e05 100644
--- a/test/Parser.hs
+++ b/test/Parser.hs
@@ -16,6 +16,7 @@ module Parser
)
where
+import Control.Lens
import Data.Either (either, isRight)
import Hedgehog (Gen, Property, (===))
import qualified Hedgehog as Hog
@@ -28,19 +29,22 @@ import VeriFuzz
import VeriFuzz.Verilog.Lex
import VeriFuzz.Verilog.Parser
+smallConfig :: Config
+smallConfig = defaultConfig & configProperty . propSize .~ 5
+
randomMod' :: Gen ModDecl
randomMod' = Hog.resize 20 (randomMod 3 10)
-parserInput :: Property
-parserInput = Hog.property $ do
+parserInputMod :: Property
+parserInputMod = Hog.property $ do
v <- Hog.forAll randomMod'
Hog.assert . isRight $ parse parseModDecl
- "input_test.v"
+ "input_test_mod"
(alexScanTokens $ str v)
where str = show . GenVerilog
-parserIdempotent :: Property
-parserIdempotent = Hog.property $ do
+parserIdempotentMod :: Property
+parserIdempotentMod = Hog.property $ do
v <- Hog.forAll randomMod'
let sv = vshow v
p sv === (p . p) sv
@@ -48,24 +52,44 @@ parserIdempotent = Hog.property $ do
vshow = show . GenVerilog
p sv =
either (\x -> show x <> "\n" <> sv) vshow
- . parse parseModDecl "idempotent_test.v"
+ . parse parseModDecl "idempotent_test_mod"
$ alexScanTokens sv
+parserInput :: Property
+parserInput = Hog.property $ do
+ v <- Hog.forAll (procedural "top" smallConfig)
+ Hog.assert . isRight $ parse parseModDecl
+ "input_test"
+ (alexScanTokens $ str v)
+ where str = show . GenVerilog
+
+parserIdempotent :: Property
+parserIdempotent = Hog.property $ do
+ v <- Hog.forAll (procedural "top" smallConfig)
+ let sv = vshow v
+ p sv === (p . p) sv
+ where
+ vshow = show . GenVerilog
+ p sv =
+ either (\x -> show x <> "\n" <> sv) vshow $ parseVerilog "idempotent_test" sv
+
parserTests :: TestTree
parserTests = testGroup "Parser properties"
- [ testProperty "Input" parserInput
+ [ testProperty "Input Mod" parserInputMod
+ , testProperty "Input" parserInput
+ , testProperty "Idempotence Mod" parserIdempotentMod
, testProperty "Idempotence" parserIdempotent
]
testParse :: (Eq a, Show a) => Parser a -> String -> String -> a -> TestTree
testParse p name input golden = testCase name $
- case parse p "testcase" (alexScanTokens $ input) of
+ case parse p "testcase" (alexScanTokens input) of
Left e -> assertFailure $ show e
Right result -> golden @=? result
testParseFail :: (Eq a, Show a) => Parser a -> String -> String -> TestTree
testParseFail p name input = testCase name $
- case parse p "testcase" (alexScanTokens $ input) of
+ case parse p "testcase" (alexScanTokens input) of
Left _ -> return ()
Right _ -> assertFailure "Parse incorrectly succeeded"
@@ -80,13 +104,25 @@ parseEventUnit =
, test "@(wire1)" $ EId "wire1"
, test "@(a or b or c or d)" $ EOr (EId "a") (EOr (EId "b") (EOr (EId "c") (EId "d")))
, test "@(a, b, c, d)" $ EComb (EId "a") (EComb (EId "b") (EComb (EId "c") (EId "d")))
+ , test "@(posedge a or negedge b or c or d)" $ EOr (EPosEdge "a") (EOr (ENegEdge "b") (EOr (EId "c") (EId "d")))
]
where
test a = testParse parseEvent ("Test " <> a) a
testFailure = testParseFail parseEvent
+parseAlwaysUnit :: TestTree
+parseAlwaysUnit =
+ testGroup "Always"
+ [ test "Empty" "always begin end" $ Always (SeqBlock [])
+ , test "Empty with event @*" "always @* begin end" $ Always (EventCtrl EAll (Just (SeqBlock [])))
+ , test "Empty with event @(posedge clk)" "always @(posedge clk) begin end" $ Always (EventCtrl (EPosEdge "clk") (Just (SeqBlock [])))
+ ]
+ where
+ test = testParse parseModItem
+
parseUnitTests :: TestTree
parseUnitTests =
testGroup "Parser unit"
[ parseEventUnit
+ , parseAlwaysUnit
]
generated by cgit (git 2.34.1) at 2024-06-10 00:14:15 +0000