diff options
author | Yann Herklotz <git@ymhg.org> | 2019-05-10 17:42:19 +0100 |
---|---|---|
committer | Yann Herklotz <git@ymhg.org> | 2019-05-10 17:42:19 +0100 |
commit | ee65910032449d37165a19cd84b7a9f014ea5bae (patch) | |
tree | 22a5c7769e6ca365bf81ad8439e85a0a62bfd699 | |
parent | 52fd1a61b5491b877cd36123805144e5a635bda5 (diff) | |
download | verismith-ee65910032449d37165a19cd84b7a9f014ea5bae.tar.gz verismith-ee65910032449d37165a19cd84b7a9f014ea5bae.zip |
Add always and initial blocks to parser
-rw-r--r-- | src/VeriFuzz/Verilog/Parser.hs | 125 | ||||
-rw-r--r-- | test/Parser.hs | 38 | ||||
-rw-r--r-- | test/Unit.hs | 2 |
3 files changed, 157 insertions, 8 deletions
diff --git a/src/VeriFuzz/Verilog/Parser.hs b/src/VeriFuzz/Verilog/Parser.hs index a7020ec..6cd1abd 100644 --- a/src/VeriFuzz/Verilog/Parser.hs +++ b/src/VeriFuzz/Verilog/Parser.hs @@ -15,6 +15,9 @@ module VeriFuzz.Verilog.Parser ( -- * Parser parseVerilog , parseModDecl + -- ** Internal parsers + , parseEvent + , Parser ) where @@ -24,6 +27,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 qualified Data.Text as T import Text.Parsec hiding (satisfy) @@ -132,6 +136,9 @@ parseExpr = do e <- parseExpr' option e . try $ parseCond e +parseConstExpr :: Parser ConstExpr +parseConstExpr = fmap exprToConst parseExpr + -- | Table of binary and unary operators that encode the right precedence for -- each. parseTable :: [[ParseOperator Expr]] @@ -223,17 +230,20 @@ number = number' <$> numLit (drop 2 a') | otherwise = error $ "Invalid number format: " ++ a' -toInteger' :: Decimal -> Integer -toInteger' (Decimal _ n) = n +-- toInteger' :: Decimal -> Integer +-- toInteger' (Decimal _ n) = n + +toInt' :: Decimal -> Int +toInt' (Decimal _ n) = fromInteger n -- | Parse a range and return the total size. As it is inclusive, 1 has to be -- added to the difference. -parseRange :: Parser Int +parseRange :: Parser Range parseRange = do - rangeH <- tok SymBrackL *> number - rangeL <- tok SymColon *> number + rangeH <- tok SymBrackL *> parseConstExpr + rangeL <- tok SymColon *> parseConstExpr tok' SymBrackR - return . fromInteger . toInteger' $ rangeH - rangeL + 1 + return $ Range rangeH rangeL strId :: Parser String strId = satisfy' matchId @@ -252,7 +262,7 @@ parseNetDecl pd = do range <- option 1 parseRange name <- identifier tok' SymSemi - return $ Decl pd (Port t sign (fromIntegral range) name) Nothing + return $ Decl pd (Port t sign range name) Nothing where type_ = tok KWWire $> Wire <|> tok KWReg $> Reg parsePortDir :: Parser PortDir @@ -267,8 +277,109 @@ parsePortDir = parseDecl :: Parser ModItem parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing +parseConditional :: Parser Statement +parseConditional = do + expr <- tok' KWIf *> tok' SymParenL *> parseExpr + true <- maybeEmptyStatement + false <- option Nothing maybeEmptyStatement + return $ CondStmnt expr true false + +parseLVal :: Parser LVal +parseLVal = + fmap RegConcat (braces $ commaSep parseExpr) + <|> ident + where + ident = do + i <- identifier + (try (ex i) <|> try (sz i) <|> return (RegId i)) + ex i = do + e <- tok' SymBrackL *> parseExpr + tok' SymBrackR + return $ RegExpr i e + sz i = RegSize i <$> parseRange + +parseDelay :: Parser Delay +parseDelay = Delay . toInt' <$> (tok' SymPound *> number) + +parseAssign :: TokenName -> Parser Assign +parseAssign t = do + lval <- parseLVal + tok' t + delay <- option Nothing (fmap Just parseDelay) + expr <- parseExpr + return $ Assign lval delay expr + +parseLoop :: Parser Statement +parseLoop = do + a <- tok' KWFor *> tok' SymParenL *> parseAssign SymEq + expr <- tok' SymSemi *> parseExpr + incr <- tok' SymSemi *> parseAssign SymEq + tok' SymParenR + statement <- parseStatement + return $ ForLoop a expr incr statement + +eventList :: TokenName -> Parser [Event] +eventList t = do + l <- sepBy parseEvent' (tok t) + 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) + <|> try (tok' SymAt *> parens parseEvent') + <|> try (tok' SymAt *> parens (foldr1 EOr <$> eventList KWOr)) + <|> try (tok' SymAt *> parens (foldr1 EComb <$> eventList SymComma)) + +parseEvent' :: Parser Event +parseEvent' = + try (tok' KWPosedge *> fmap EPosEdge identifier) + <|> try (tok' KWNegedge *> fmap ENegEdge identifier) + <|> try (fmap EId identifier) + <|> try (fmap EExpr parseExpr) + +parseEventCtrl :: Parser Statement +parseEventCtrl = do + event <- parseEvent + statement <- option Nothing maybeEmptyStatement + return $ EventCtrl event statement + +parseDelayCtrl :: Parser Statement +parseDelayCtrl = do + delay <- parseDelay + statement <- option Nothing maybeEmptyStatement + return $ TimeCtrl delay statement + +parseBlocking :: Parser Statement +parseBlocking = BlockAssign <$> parseAssign SymEq + +parseNonBlocking :: Parser Statement +parseNonBlocking = NonBlockAssign <$> parseAssign SymLtEq + +parseStatement :: Parser Statement +parseStatement = + parseConditional + <|> parseLoop + <|> parseEventCtrl + <|> parseDelayCtrl + <|> try parseBlocking + <|> parseNonBlocking + +maybeEmptyStatement :: Parser (Maybe Statement) +maybeEmptyStatement = + (tok' SymSemi >> return Nothing) + <|> (Just <$> parseStatement) + +parseAlways :: Parser ModItem +parseAlways = tok' KWAlways *> (Always <$> parseStatement) + +parseInitial :: Parser ModItem +parseInitial = tok' KWInitial *> (Initial <$> parseStatement) + parseModItem :: Parser ModItem parseModItem = (ModCA <$> parseContAssign) <|> parseDecl + <|> parseAlways + <|> parseInitial parseModList :: Parser [Identifier] parseModList = list <|> return [] where list = parens $ commaSep identifier diff --git a/test/Parser.hs b/test/Parser.hs index 89ab1cc..3c0b77d 100644 --- a/test/Parser.hs +++ b/test/Parser.hs @@ -12,6 +12,7 @@ Test the parser. module Parser ( parserTests + , parseUnitTests ) where @@ -21,6 +22,7 @@ import qualified Hedgehog as Hog import qualified Hedgehog.Gen as Hog import Test.Tasty import Test.Tasty.Hedgehog +import Test.Tasty.HUnit import Text.Parsec import VeriFuzz import VeriFuzz.Verilog.Lex @@ -50,7 +52,41 @@ parserIdempotent = Hog.property $ do $ alexScanTokens sv parserTests :: TestTree -parserTests = testGroup "Parser tests" +parserTests = testGroup "Parser properties" [ testProperty "Input" parserInput , 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 + 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 + Left _ -> return () + Right _ -> assertFailure "Parse incorrectly succeeded" + +parseEventUnit :: TestTree +parseEventUnit = + testGroup "Event" + [ testFailure "No empty event" "@()" + , test "@*" EAll + , test "@(*)" EAll + , test "@(posedge clk)" $ EPosEdge "clk" + , test "@(negedge clk)" $ ENegEdge "clk" + , 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"))) + ] + where + test a = testParse parseEvent ("Test " <> a) a + testFailure = testParseFail parseEvent + +parseUnitTests :: TestTree +parseUnitTests = + testGroup "Parser unit" + [ parseEventUnit + ] diff --git a/test/Unit.hs b/test/Unit.hs index 7878eaa..a45f120 100644 --- a/test/Unit.hs +++ b/test/Unit.hs @@ -4,6 +4,7 @@ module Unit where import Control.Lens +import Parser (parseUnitTests) import Test.Tasty import Test.Tasty.HUnit import VeriFuzz @@ -15,6 +16,7 @@ unitTests = testGroup "Successful transformation" transformExpectedResult (transform trans transformTestData) + , parseUnitTests ] transformTestData :: Expr |