diff options
| -rw-r--r-- | src/VeriFuzz/Lexer.hs | 169 | ||||
| -rw-r--r-- | src/VeriFuzz/Mutate.hs | 2 | ||||
| -rw-r--r-- | src/VeriFuzz/Parser.hs | 173 | ||||
| -rw-r--r-- | verifuzz.cabal | 4 |
4 files changed, 282 insertions, 66 deletions
diff --git a/src/VeriFuzz/Lexer.hs b/src/VeriFuzz/Lexer.hs new file mode 100644 index 0000000..2357f57 --- /dev/null +++ b/src/VeriFuzz/Lexer.hs @@ -0,0 +1,169 @@ +{-| +Module : VeriFuzz.Lexer +Description : Lexer for Verilog. +Copyright : (c) 2019, Yann Herklotz Grave +License : GPL-3 +Maintainer : ymherklotz [at] gmail [dot] com +Stability : experimental +Portability : POSIX + +Lexer for Verilog. +-} + +module VeriFuzz.Lexer + ( lexer + , identifier + , reserved + , operator + , reservedOp + , charLiteral + , stringLiteral + , natural + , integer + , float + , naturalOrFloat + , decimal + , hexadecimal + , octal + , symbol + , lexeme + , whiteSpace + , parens + , braces + , angles + , brackets + , squares + , comma + , colon + , dot + , semiSep + , semiSep1 + , commaSep + , commaSep1 + ) where + +import Text.Parsec +import qualified Text.Parsec.Token as P + +type VerilogDef = P.LanguageDef () + +type Lexer = P.TokenParser () + +type Parser = Parsec String () + +verilogDef :: VerilogDef +verilogDef = P.LanguageDef "/*" "*/" "//" False letter (alphaNum <|> char '_') + (oneOf ":!#$%&*+./<=>?@\\^|-~") (oneOf ":!#$%&*+./<=>?@\\^|-~") + reserved' reservedOp' True + +lexer :: Lexer +lexer = P.makeTokenParser verilogDef + +identifier :: Parser String +identifier = P.identifier lexer + +reserved :: String -> Parser () +reserved = P.reserved lexer + +operator :: Parser String +operator = P.operator lexer + +reservedOp :: String -> Parser () +reservedOp = P.reservedOp lexer + +charLiteral :: Parser Char +charLiteral = P.charLiteral lexer + +stringLiteral :: Parser String +stringLiteral = P.stringLiteral lexer + +natural :: Parser Integer +natural = P.natural lexer + +integer :: Parser Integer +integer = P.integer lexer + +float :: Parser Double +float = P.float lexer + +naturalOrFloat :: Parser (Either Integer Double) +naturalOrFloat = P.naturalOrFloat lexer + +decimal :: Parser Integer +decimal = P.decimal lexer + +hexadecimal :: Parser Integer +hexadecimal = P.hexadecimal lexer + +octal :: Parser Integer +octal = P.octal lexer + +symbol :: String -> Parser String +symbol = P.symbol lexer + +lexeme :: Parser a -> Parser a +lexeme = P.lexeme lexer + +whiteSpace :: Parser () +whiteSpace = P.whiteSpace lexer + +parens :: Parser a -> Parser a +parens = P.parens lexer + +braces :: Parser a -> Parser a +braces = P.braces lexer + +angles :: Parser a -> Parser a +angles = P.angles lexer + +brackets :: Parser a -> Parser a +brackets = P.brackets lexer + +squares :: Parser a -> Parser a +squares = P.squares lexer + +comma :: Parser String +comma = P.comma lexer + +colon :: Parser String +colon = P.colon lexer + +dot :: Parser String +dot = P.dot lexer + +semiSep :: Parser a -> Parser [a] +semiSep = P.semiSep lexer + +semiSep1 :: Parser a -> Parser [a] +semiSep1 = P.semiSep1 lexer + +commaSep :: Parser a -> Parser [a] +commaSep = P.commaSep lexer + +commaSep1 :: Parser a -> Parser [a] +commaSep1 = P.commaSep1 lexer + +reservedOp' :: [String] +reservedOp' = [ "!", "~", "~&", "~|", "+", "-", "*", "/", "%", "==", "!=", "===", "!==" + , "&&", "||", "<", "<=", ">", ">=", "&", "|", "^", "^~", "~^", "**", "<<" + , ">>", "<<<", ">>>" + ] + +reserved' :: [String] +reserved' = [ "always", "and", "assign", "automatic", "begin", "buf", "bufif0", "bufif1" + , "case", "casex", "casez", "cell", "cmos", "config", "deassign", "default" + , "defparam", "design", "disable", "edge", "else", "end", "endcase", "endconfig" + , "endfunction", "endgenerate", "endmodule", "endprimitive", "endspecify", "endtable" + , "endtask", "event", "for", "force", "forever", "fork", "function", "generate", "genvar" + , "highz0", "highz1", "if", "ifnone", "incdir", "include", "initial", "inout", "input" + , "instance", "integer", "join", "large", "liblist", "library", "localparam", "macromodule" + , "medium", "module", "nand", "negedge", "nmos", "nor", "noshowcancelled", "not", "notif0" + , "notif1", "or", "output", "parameter", "pmos", "posedge", "primitive", "pull0", "pull1" + , "pulldown", "pullup", "pulsestyle_onevent", "pulsestyle_ondetect", "remos", "real" + , "realtime", "reg", "release", "repeat", "rnmos", "rpmos", "rtran", "rtranif0", "rtranif1" + , "scalared", "showcancelled", "signed", "small", "specify", "specparam", "strong0", "strong1" + , "supply0", "supply1", "table", "task", "time", "tran", "tranif0", "tranif1", "tri", "tri0" + , "tri1", "triand", "trior", "trireg", "unsigned", "use", "vectored", "wait", "wand", "weak0" + , "weak1", "while", "wire", "wor", "xnor", "xor" + ] + diff --git a/src/VeriFuzz/Mutate.hs b/src/VeriFuzz/Mutate.hs index 15eac90..21911b6 100644 --- a/src/VeriFuzz/Mutate.hs +++ b/src/VeriFuzz/Mutate.hs @@ -79,7 +79,7 @@ allVars m = -- $setup -- >>> import VeriFuzz.CodeGen --- >>> let m = (ModDecl (Identifier "m") [Port Wire 5 (Identifier "y")] [Port Wire 5 "x"] []) +-- >>> let m = (ModDecl (Identifier "m") [Port Wire False 5 (Identifier "y")] [Port Wire False 5 "x"] []) -- >>> let main = (ModDecl "main" [] [] []) -- | Add a Module Instantiation using 'ModInst' from the first module passed to diff --git a/src/VeriFuzz/Parser.hs b/src/VeriFuzz/Parser.hs index 3991a1f..ef91265 100644 --- a/src/VeriFuzz/Parser.hs +++ b/src/VeriFuzz/Parser.hs @@ -20,42 +20,39 @@ module VeriFuzz.Parser , parseExpr ) where -import Control.Applicative ((<|>)) -import Data.Attoparsec.Expr -import Data.Attoparsec.Text as A -import Data.Char (isLetter) -import Data.Functor (($>)) -import Data.Text (Text) +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.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 +parseExpr' :: Parser Expr +parseExpr' = buildExpressionParser parseTable parseTerm <?> "expr" parseParens :: Parser a -> Parser a parseParens a = do - val <- "(" *> skipSpace *> a - _ <- skipSpace *> ")" + val <- string "(" *> spaces *> a + _ <- spaces *> string ")" return val -constP :: Parser a -> Text -> Parser a -constP p t = case parseOnly p t of - Left _ -> fail "constP" - Right a -> return a - -parseOf :: Parser Text -> Parser a -> Parser a -parseOf ptxt pa = ptxt >>= constP pa - ignoreWS :: Parser a -> Parser a ignoreWS a = do - skipSpace + spaces t <- a - skipSpace + spaces return t matchHex :: Char -> Bool @@ -67,44 +64,61 @@ matchHex c = c == 'h' || c == 'H' matchDec :: Char -> Bool matchDec c = c == 'd' || c == 'D' ---matchOct :: Char -> Bool ---matchOct c = c == 'o' || c == 'O' +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 = ignoreWS $ do - size <- decimal - _ <- "'" + 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 = string "unsigned" $> UnSignedFunc + <|> string "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 = (Concat <$> aroundList "{" "}" parseExpr) - <|> parseCond - <|> parseParens parseExpr +parseTerm = parseParens parseExpr + <|> (Concat <$> aroundList (string "{") (string "}") parseExpr) + <|> parseFun <|> parseNum + <|> parseVar <?> "simple expr" -takeUntil :: Char -> Parser Text -takeUntil c = do - t <- takeWhile1 (/=c) - _ <- char c - return t - -- | Parses the ternary conditional operator. It will behave in a right -- associative way. -parseCond :: Parser Expr -parseCond = do - x <- parseOf (takeUntil '?') parseExpr - y <- parseOf (takeUntil ':') parseExpr - Cond x y <$> parseExpr +parseCond :: Expr -> Parser Expr +parseCond e = do + _ <- reservedOp "?" + expr <- parseExpr + _ <- reservedOp ":" + Cond e expr <$> parseExpr + +parseExpr :: Parser Expr +parseExpr = do + e <- parseExpr' + y <- option e $ parseCond e + return y -- | Table of binary and unary operators that encode the right precedence for -- each. -parseTable :: [[Operator Text Expr]] +parseTable :: [[ParseOperator Expr]] parseTable = [ [ prefix "!" (UnOp UnLNot), prefix "~" (UnOp UnNot) ] , [ prefix "&" (UnOp UnAnd), prefix "|" (UnOp UnOr), prefix "~&" (UnOp UnNand) @@ -133,48 +147,81 @@ parseTable = , [ binary "|" (sBinOp BinLOr) AssocLeft ] ] -binary :: Text -> (a -> a -> a) -> Assoc -> Operator Text a -binary name fun = Infix ((string name <?> "binary") >> return fun) - -prefix :: Text -> (a -> a) -> Operator Text a -prefix name fun = Prefix ((string name <?> "prefix") >> return fun) +binary :: String -> (a -> a -> a) -> Assoc -> ParseOperator a +binary name fun = Infix ((reservedOp name <?> "binary") >> return fun) -commaSep :: Parser a -> Parser [a] -commaSep f = sepBy f (skipSpace *> char ',' *> skipSpace) +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 - l <- a *> skipSpace *> commaSep c + l <- a *> spaces *> commaSep c _ <- b return l parseContAssign :: Parser ContAssign parseContAssign = do - var <- Identifier <$> (skipSpace *> "assign" *> skipSpace *> takeWhile1 isLetter) - expr <- skipSpace *> "=" *> skipSpace *> parseExpr - _ <- skipSpace *> ";" + var <- (spaces *> reserved "assign" *> spaces *> ident) + expr <- spaces *> reservedOp "=" *> spaces *> parseExpr + _ <- spaces *> string ";" return $ ContAssign var expr -parseModItem :: Parser [ModItem] -parseModItem = fmap ModCA <$> many1 parseContAssign +-- | 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 + 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" *> spaces $> True) + range <- option 1 parseRange + name <- ident + _ <- spaces *> string ";" + return . Decl pd . Port t sign range $ name + where + type_ = reserved "wire" *> spaces $> Wire + <|> reserved "reg" *> spaces $> Reg + +parsePortDir :: Parser PortDir +parsePortDir = + reserved "output" *> spaces $> PortOut + <|> reserved "input" *> spaces $> PortIn + <|> reserved "inout" *> spaces $> PortInOut + +parseDecl :: Parser ModItem +parseDecl = + (Just <$> parsePortDir >>= parseNetDecl) + <|> parseNetDecl Nothing + +parseModItem :: Parser ModItem +parseModItem = + (ModCA <$> parseContAssign) + <|> parseDecl parseModList :: Parser [Identifier] -parseModList = list <|> skipSpace $> [] +parseModList = list <|> spaces $> [] where - list = fmap Identifier - <$> aroundList "(" ")" (takeWhile1 isLetter) + list = aroundList (string "(") (string ")") ident parseModDecl :: Parser ModDecl parseModDecl = do - name <- Identifier <$> ("module" *> skipSpace *> takeWhile1 isLetter) - modL <- fmap (Port Wire 1) <$> (skipSpace *> parseModList) - _ <- skipSpace *> ";" - modItem <- parseModItem <|> skipSpace $> [] - _ <- skipSpace *> "endmodule" - return $ ModDecl name [Port Wire 1 "y"] modL modItem + name <- (reserved "module" *> ident) + modL <- fmap defaultPort <$> parseModList + _ <- string ";" + modItem <- option [] . try $ many1 parseModItem + _ <- reserved "endmodule" + return $ ModDecl name [defaultPort "y"] modL modItem parseDescription :: Parser Description -parseDescription = Description <$> (skipSpace *> parseModDecl) +parseDescription = Description <$> parseModDecl parseVerilogSrc :: Parser VerilogSrc -parseVerilogSrc = VerilogSrc <$> many1 parseDescription +parseVerilogSrc = VerilogSrc <$> many parseDescription diff --git a/verifuzz.cabal b/verifuzz.cabal index fb1583b..1cc0106 100644 --- a/verifuzz.cabal +++ b/verifuzz.cabal @@ -34,6 +34,7 @@ library , VeriFuzz.General , VeriFuzz.Gen , VeriFuzz.Icarus + , VeriFuzz.Lexer , VeriFuzz.Mutate , VeriFuzz.Parser , VeriFuzz.RandomAlt @@ -58,8 +59,7 @@ library , cryptonite >=0.25 && <0.26 , memory >=0.14 && <0.15 , DRBG >=0.5 && <0.6 - , attoparsec >=0.13 && <0.14 - , attoparsec-expr >=0.1 && <0.2 + , parsec >= 3.1 && < 3.2 default-extensions: OverloadedStrings executable verifuzz |