From 6175945fcacbb37573158ab80ccf3312ff068b33 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Grave Date: Sat, 16 Feb 2019 21:35:45 +0000 Subject: Fix to parser --- src/VeriFuzz/Lexer.hs | 13 +++++++--- src/VeriFuzz/Parser.hs | 70 +++++++++++++++++++++----------------------------- 2 files changed, 39 insertions(+), 44 deletions(-) (limited to 'src/VeriFuzz') diff --git a/src/VeriFuzz/Lexer.hs b/src/VeriFuzz/Lexer.hs index 2357f57..f06656b 100644 --- a/src/VeriFuzz/Lexer.hs +++ b/src/VeriFuzz/Lexer.hs @@ -42,6 +42,7 @@ module VeriFuzz.Lexer , commaSep1 ) where +import Data.Char (digitToInt) import Text.Parsec import qualified Text.Parsec.Token as P @@ -53,7 +54,7 @@ type Parser = Parsec String () verilogDef :: VerilogDef verilogDef = P.LanguageDef "/*" "*/" "//" False letter (alphaNum <|> char '_') - (oneOf ":!#$%&*+./<=>?@\\^|-~") (oneOf ":!#$%&*+./<=>?@\\^|-~") + (oneOf ":!#%&*+./<=>?@\\^|-~") (oneOf ":!#%&*+./<=>?@\\^|-~") reserved' reservedOp' True lexer :: Lexer @@ -92,11 +93,17 @@ naturalOrFloat = P.naturalOrFloat lexer decimal :: Parser Integer decimal = P.decimal lexer +number :: Integer -> Parser Char -> Parser Integer +number base baseDigit = do + digits <- many1 baseDigit + let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits + seq n (return n) + hexadecimal :: Parser Integer -hexadecimal = P.hexadecimal lexer +hexadecimal = number 16 hexDigit octal :: Parser Integer -octal = P.octal lexer +octal = number 8 octDigit symbol :: String -> Parser String symbol = P.symbol lexer diff --git a/src/VeriFuzz/Parser.hs b/src/VeriFuzz/Parser.hs index bdfde7e..48dafe2 100644 --- a/src/VeriFuzz/Parser.hs +++ b/src/VeriFuzz/Parser.hs @@ -26,6 +26,7 @@ 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 @@ -42,19 +43,6 @@ parseExpr' :: Parser Expr parseExpr' = buildExpressionParser parseTable parseTerm "expr" -parseParens :: Parser a -> Parser a -parseParens a = do - val <- string "(" *> spaces *> a - _ <- spaces *> string ")" - return val - -ignoreWS :: Parser a -> Parser a -ignoreWS a = do - spaces - t <- a - spaces - return t - matchHex :: Char -> Bool matchHex c = c == 'h' || c == 'H' @@ -70,7 +58,7 @@ 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 = ignoreWS $ do +parseNum = do size <- fromIntegral <$> decimal _ <- string "'" matchNum size @@ -83,8 +71,8 @@ parseVar :: Parser Expr parseVar = Id <$> ident parseFunction :: Parser Function -parseFunction = string "unsigned" $> UnSignedFunc - <|> string "signed" $> SignedFunc +parseFunction = reserved "unsigned" $> UnSignedFunc + <|> reserved "signed" $> SignedFunc parseFun :: Parser Expr parseFun = do @@ -94,10 +82,10 @@ parseFun = do return $ Func f expr parseTerm :: Parser Expr -parseTerm = parseParens parseExpr +parseTerm = parens parseExpr <|> (Concat <$> aroundList (string "{") (string "}") parseExpr) <|> parseFun - <|> parseNum + <|> lexeme parseNum <|> parseVar "simple expr" @@ -105,15 +93,15 @@ parseTerm = parseParens parseExpr -- associative way. parseCond :: Expr -> Parser Expr parseCond e = do - _ <- reservedOp "?" - expr <- parseExpr - _ <- reservedOp ":" + _ <- spaces *> reservedOp "?" + expr <- spaces *> parseExpr + _ <- spaces *> reservedOp ":" Cond e expr <$> parseExpr parseExpr :: Parser Expr parseExpr = do e <- parseExpr' - option e $ parseCond e + option e . try $ parseCond e -- | Table of binary and unary operators that encode the right precedence for -- each. @@ -143,7 +131,7 @@ parseTable = ] , [ binary "|" (sBinOp BinOr) AssocLeft ] , [ binary "&&" (sBinOp BinLAnd) AssocLeft ] - , [ binary "|" (sBinOp BinLOr) AssocLeft ] + , [ binary "||" (sBinOp BinLOr) AssocLeft ] ] binary :: String -> (a -> a -> a) -> Assoc -> ParseOperator a @@ -153,25 +141,25 @@ 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 = do +aroundList a b c = lexeme $ do l <- a *> spaces *> commaSep c _ <- b return l parseContAssign :: Parser ContAssign parseContAssign = do - var <- spaces *> reserved "assign" *> spaces *> ident - expr <- spaces *> reservedOp "=" *> spaces *> parseExpr - _ <- spaces *> string ";" + 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 <- string "[" *> spaces *> decimal - rangeL <- spaces *> string ":" *> spaces *> decimal - spaces *> string "]" *> spaces + rangeH <- symbol "[" *> decimal + rangeL <- symbol ":" *> decimal + _ <- symbol "]" return . fromIntegral $ rangeH - rangeL + 1 ident :: Parser Identifier @@ -180,20 +168,20 @@ ident = Identifier . T.pack <$> identifier parseNetDecl :: Maybe PortDir -> Parser ModItem parseNetDecl pd = do t <- option Wire type_ - sign <- option False (reserved "signed" *> spaces $> True) + sign <- option False (reserved "signed" $> True) range <- option 1 parseRange name <- ident - _ <- spaces *> string ";" + _ <- symbol ";" return . Decl pd . Port t sign range $ name where - type_ = reserved "wire" *> spaces $> Wire - <|> reserved "reg" *> spaces $> Reg + type_ = reserved "wire" $> Wire + <|> reserved "reg" $> Reg parsePortDir :: Parser PortDir parsePortDir = - reserved "output" *> spaces $> PortOut - <|> reserved "input" *> spaces $> PortIn - <|> reserved "inout" *> spaces $> PortInOut + reserved "output" $> PortOut + <|> reserved "input" $> PortIn + <|> reserved "inout" $> PortInOut parseDecl :: Parser ModItem parseDecl = @@ -214,13 +202,13 @@ parseModDecl :: Parser ModDecl parseModDecl = do name <- reserved "module" *> ident modL <- fmap defaultPort <$> parseModList - _ <- string ";" - modItem <- option [] . try $ many1 parseModItem + _ <- symbol ";" + modItem <- lexeme $ option [] . try $ many1 parseModItem _ <- reserved "endmodule" return $ ModDecl name [defaultPort "y"] modL modItem parseDescription :: Parser Description -parseDescription = Description <$> parseModDecl +parseDescription = Description <$> lexeme parseModDecl parseVerilogSrc :: Parser VerilogSrc -parseVerilogSrc = VerilogSrc <$> many parseDescription +parseVerilogSrc = VerilogSrc <$> (whiteSpace *> (many parseDescription)) -- cgit