diff options
author | Yann Herklotz <git@ymhg.org> | 2019-05-10 19:09:28 +0100 |
---|---|---|
committer | Yann Herklotz <git@ymhg.org> | 2019-05-10 19:09:28 +0100 |
commit | 5691f81906b703e2b29be24091c5585b33cb9428 (patch) | |
tree | 025a5b4e2fac85e507ad88ff60e4c97e8cb4bdc6 | |
parent | ee65910032449d37165a19cd84b7a9f014ea5bae (diff) | |
download | verismith-5691f81906b703e2b29be24091c5585b33cb9428.tar.gz verismith-5691f81906b703e2b29be24091c5585b33cb9428.zip |
Fixed parser to parse all the generated verilog
-rw-r--r-- | src/VeriFuzz/Config.hs | 14 | ||||
-rw-r--r-- | src/VeriFuzz/Verilog/Parser.hs | 90 | ||||
-rw-r--r-- | test/Parser.hs | 54 |
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 ] |