From 1930e7686025601e22de49aa4d4dbeed8311caa0 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sun, 31 Mar 2019 21:54:20 +0100 Subject: Rewrite the parser with real lexer --- src/VeriFuzz/Parser.hs | 239 ++----------------------------------------------- 1 file changed, 5 insertions(+), 234 deletions(-) (limited to 'src/VeriFuzz/Parser.hs') diff --git a/src/VeriFuzz/Parser.hs b/src/VeriFuzz/Parser.hs index 2c26b56..66608f4 100644 --- a/src/VeriFuzz/Parser.hs +++ b/src/VeriFuzz/Parser.hs @@ -1,247 +1,18 @@ {-| Module : VeriFuzz.Parser -Description : Minimal Verilog parser to reconstruct the AST. -Copyright : (c) 2019, Yann Herklotz +Description : Parser module for Verilog. +Copyright : (c) 2019, Yann Herklotz Grave License : GPL-3 Maintainer : ymherklotz [at] gmail [dot] com Stability : experimental Portability : POSIX -Minimal Verilog parser to reconstruct the AST. This parser does not support the -whole Verilog syntax, as the AST does not support it either. +Parser module for Verilog. -} module VeriFuzz.Parser - ( -- * Parsers - parseVerilog - , parseVerilogSrc - , parseDescription - , parseModDecl - , parseContAssign - , parseExpr + ( module VeriFuzz.Parser.Parser ) where -import Control.Lens -import Data.Functor (($>)) -import Data.Functor.Identity (Identity) -import qualified Data.Text as T -import Text.Parsec -import Text.Parsec.Expr -import VeriFuzz.AST ---import VeriFuzz.CodeGen -import VeriFuzz.Internal -import VeriFuzz.Lexer - -type Parser = Parsec String () - -type ParseOperator = Operator String () Identity - -sBinOp :: BinaryOperator -> Expr -> Expr -> Expr -sBinOp = sOp BinOp where sOp f b a = f a b - -parseExpr' :: Parser Expr -parseExpr' = buildExpressionParser parseTable parseTerm "expr" - -matchHex :: Char -> Bool -matchHex c = c == 'h' || c == 'H' - ---matchBin :: Char -> Bool ---matchBin c = c == 'b' || c == 'B' - -matchDec :: Char -> Bool -matchDec c = c == 'd' || c == 'D' - -matchOct :: Char -> Bool -matchOct c = c == 'o' || c == 'O' - --- | Parse a Number depending on if it is in a hex or decimal form. Octal and --- binary are not supported yet. -parseNum :: Parser Expr -parseNum = do - size <- fromIntegral <$> decimal - _ <- string "'" - matchNum size - where - matchNum size = - (satisfy matchHex >> Number size <$> hexadecimal) - <|> (satisfy matchDec >> Number size <$> decimal) - <|> (satisfy matchOct >> Number size <$> octal) - -parseVar :: Parser Expr -parseVar = Id <$> ident - -parseFunction :: Parser Function -parseFunction = - reserved "unsigned" $> UnSignedFunc <|> reserved "signed" $> SignedFunc - -parseFun :: Parser Expr -parseFun = do - f <- spaces *> reservedOp "$" *> parseFunction - expr <- string "(" *> spaces *> parseExpr - _ <- spaces *> string ")" *> spaces - return $ Func f expr - -parseTerm :: Parser Expr -parseTerm = - parens parseExpr - <|> (Concat <$> aroundList (string "{") (string "}") parseExpr) - <|> parseFun - <|> lexeme parseNum - <|> parseVar - "simple expr" - --- | Parses the ternary conditional operator. It will behave in a right --- associative way. -parseCond :: Expr -> Parser Expr -parseCond e = do - _ <- spaces *> reservedOp "?" - expr <- spaces *> parseExpr - _ <- spaces *> reservedOp ":" - Cond e expr <$> parseExpr - -parseExpr :: Parser Expr -parseExpr = do - e <- parseExpr' - option e . try $ parseCond e - --- | Table of binary and unary operators that encode the right precedence for --- each. -parseTable :: [[ParseOperator Expr]] -parseTable - = [ [prefix "!" (UnOp UnLNot), prefix "~" (UnOp UnNot)] - , [ prefix "&" (UnOp UnAnd) - , prefix "|" (UnOp UnOr) - , prefix "~&" (UnOp UnNand) - , prefix "~|" (UnOp UnNor) - , prefix "^" (UnOp UnXor) - , prefix "~^" (UnOp UnNxor) - , prefix "^~" (UnOp UnNxorInv) - ] - , [prefix "+" (UnOp UnPlus), prefix "-" (UnOp UnMinus)] - , [binary "**" (sBinOp BinPower) AssocRight] - , [ binary "*" (sBinOp BinTimes) AssocLeft - , binary "/" (sBinOp BinDiv) AssocLeft - , binary "%" (sBinOp BinMod) AssocLeft - ] - , [ binary "+" (sBinOp BinPlus) AssocLeft - , binary "-" (sBinOp BinPlus) AssocLeft - ] - , [ binary "<<" (sBinOp BinLSL) AssocLeft - , binary ">>" (sBinOp BinLSR) AssocLeft - ] - , [ binary "<<<" (sBinOp BinASL) AssocLeft - , binary ">>>" (sBinOp BinASR) AssocLeft - ] - , [ binary "<" (sBinOp BinLT) AssocNone - , binary ">" (sBinOp BinGT) AssocNone - , binary "<=" (sBinOp BinLEq) AssocNone - , binary ">=" (sBinOp BinLEq) AssocNone - ] - , [ binary "==" (sBinOp BinEq) AssocNone - , binary "!=" (sBinOp BinNEq) AssocNone - ] - , [ binary "===" (sBinOp BinEq) AssocNone - , binary "!==" (sBinOp BinNEq) AssocNone - ] - , [binary "&" (sBinOp BinAnd) AssocLeft] - , [ binary "^" (sBinOp BinXor) AssocLeft - , binary "^~" (sBinOp BinXNor) AssocLeft - , binary "~^" (sBinOp BinXNorInv) AssocLeft - ] - , [binary "|" (sBinOp BinOr) AssocLeft] - , [binary "&&" (sBinOp BinLAnd) AssocLeft] - , [binary "||" (sBinOp BinLOr) AssocLeft] - ] - -binary :: String -> (a -> a -> a) -> Assoc -> ParseOperator a -binary name fun = Infix ((reservedOp name "binary") >> return fun) - -prefix :: String -> (a -> a) -> ParseOperator a -prefix name fun = Prefix ((reservedOp name "prefix") >> return fun) - -aroundList :: Parser a -> Parser b -> Parser c -> Parser [c] -aroundList a b c = lexeme $ do - l <- a *> spaces *> commaSep c - _ <- b - return l - -parseContAssign :: Parser ContAssign -parseContAssign = do - var <- reserved "assign" *> ident - expr <- reservedOp "=" *> parseExpr - _ <- symbol ";" - return $ ContAssign var expr - --- | Parse a range and return the total size. As it is inclusive, 1 has to be --- added to the difference. -parseRange :: Parser Int -parseRange = do - rangeH <- symbol "[" *> decimal - rangeL <- symbol ":" *> decimal - _ <- symbol "]" - return . fromIntegral $ rangeH - rangeL + 1 - -ident :: Parser Identifier -ident = Identifier . T.pack <$> identifier - -parseNetDecl :: Maybe PortDir -> Parser ModItem -parseNetDecl pd = do - t <- option Wire type_ - sign <- option False (reserved "signed" $> True) - range <- option 1 parseRange - name <- ident - _ <- symbol ";" - return . Decl pd . Port t sign range $ name - where type_ = reserved "wire" $> Wire <|> reserved "reg" $> Reg - -parsePortDir :: Parser PortDir -parsePortDir = - reserved "output" - $> PortOut - <|> reserved "input" - $> PortIn - <|> reserved "inout" - $> PortInOut - -parseDecl :: Parser ModItem -parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing - -parseModItem :: Parser ModItem -parseModItem = (ModCA <$> parseContAssign) <|> parseDecl - -parseModList :: Parser [Identifier] -parseModList = list <|> spaces $> [] - where list = aroundList (string "(") (string ")") ident - -filterDecl :: PortDir -> ModItem -> Bool -filterDecl p (Decl (Just p') _) = p == p' -filterDecl _ _ = False - -modPorts :: PortDir -> [ModItem] -> [Port] -modPorts p mis = filter (filterDecl p) mis ^.. traverse . declPort - -parseModDecl :: Parser ModDecl -parseModDecl = do - name <- reserved "module" *> ident - _ <- fmap defaultPort <$> parseModList - _ <- symbol ";" - modItem <- lexeme $ option [] . try $ many1 parseModItem - _ <- reserved "endmodule" - return $ ModDecl name - (modPorts PortOut modItem) - (modPorts PortIn modItem) - modItem - -parseDescription :: Parser Description -parseDescription = Description <$> lexeme parseModDecl - --- | Parses a 'String' into 'VerilogSrc' by skipping any beginning whitespace --- and then parsing multiple Verilog source. -parseVerilogSrc :: Parser VerilogSrc -parseVerilogSrc = VerilogSrc <$> (whiteSpace *> many parseDescription) - --- | Parse a 'String' containing verilog code. The parser currently only supports --- the subset of Verilog that is being generated randomly. -parseVerilog :: String -> String -> Either ParseError VerilogSrc -parseVerilog = parse parseVerilogSrc +import VeriFuzz.Parser.Parser -- cgit