1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
|
{-|
Module : VeriFuzz.Parser
Description : Minimal Verilog parser to reconstruct the AST.
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.
-}
module VeriFuzz.Parser
( -- * Parsers
parseVerilog
, parseVerilogSrc
, parseDescription
, parseModDecl
, parseContAssign
, parseExpr
)
where
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
parseModDecl :: Parser ModDecl
parseModDecl = do
name <- reserved "module" *> ident
modL <- fmap defaultPort <$> parseModList
_ <- symbol ";"
modItem <- lexeme $ option [] . try $ many1 parseModItem
_ <- reserved "endmodule"
return $ ModDecl name [] modL modItem
parseDescription :: Parser Description
parseDescription = Description <$> lexeme parseModDecl
parseVerilogSrc :: Parser VerilogSrc
parseVerilogSrc = VerilogSrc <$> (whiteSpace *> many parseDescription)
parseVerilog :: String -> String -> Either ParseError VerilogSrc
parseVerilog = parse parseVerilogSrc
|
