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
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
|
{-|
Module : Test.VeriFuzz.VerilogAST
Description : Definition of the Verilog AST types.
Copyright : (c) Yann Herklotz Grave 2018
License : GPL-3
Maintainer : ymherklotz@gmail.com
Stability : experimental
Portability : POSIX
Defines the types to build a Verilog AST.
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Test.VeriFuzz.VerilogAST where
import Control.Lens
import qualified Data.Graph.Inductive as G
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import qualified Test.QuickCheck as QC
import Test.VeriFuzz.Circuit
import Test.VeriFuzz.Graph.Random
-- | Identifier in Verilog. This is just a string of characters that can either
-- be lowercase and uppercase for now. This might change in the future though,
-- as Verilog supports many more characters in Identifiers.
newtype Identifier = Identifier { _getIdentifier :: Text }
deriving (Show, Eq, Ord)
-- | A number in Verilog which contains a size and a value.
data Number = Number { _numSize :: Int
, _numVal :: Int
} deriving (Show, Eq, Ord)
newtype Delay = Delay { _delay :: Int }
deriving (Show, Eq, Ord)
data Event = EId Identifier
| EExpr Expression
| EAll
deriving (Show, Eq, Ord)
data Net = Wire
| Tri
| Tri1
| Supply0
| Wand
| TriAnd
| Tri0
| Supply1
| Wor
| Trior
deriving (Show, Eq, Ord)
data RegLVal = RegId Identifier
| RegExpr { _regExprId :: Identifier
, _regExpr :: Expression
}
| RegSize { _regSizeId :: Identifier
, _regSizeMSB :: ConstExpr
, _regSizeLSB :: ConstExpr
}
deriving (Show, Eq, Ord)
-- | Binary operators that are currently supported in the verilog generation.
data BinaryOperator = BinPlus -- ^ @+@
| BinMinus -- ^ @-@
| BinTimes -- ^ @*@
| BinDiv -- ^ @/@
| BinMod -- ^ @%@
| BinEq -- ^ @==@
| BinNEq -- ^ @!=@
| BinCEq -- ^ @===@
| BinCNEq -- ^ @!==@
| BinLAnd -- ^ @&&@
| BinLOr -- ^ @||@
| BinLT -- ^ @<@
| BinLEq -- ^ @<=@
| BinGT -- ^ @>@
| BinGEq -- ^ @>=@
| BinAnd -- ^ @&@
| BinOr -- ^ @|@
| BinXor -- ^ @^@
| BinXNor -- ^ @^~@
| BinXNorInv -- ^ @~^@
| BinPower -- ^ @**@
| BinLSL -- ^ @<<@
| BinLSR -- ^ @>>@
| BinASL -- ^ @<<<@
| BinASR -- ^ @>>>@
deriving (Show, Eq, Ord)
-- | Unary operators that are currently supported by the generator.
data UnaryOperator = UnPlus -- ^ @+@
| UnMinus -- ^ @-@
| UnNot -- ^ @!@
| UnAnd -- ^ @&@
| UnNand -- ^ @~&@
| UnOr -- ^ @|@
| UnNor -- ^ @~|@
| UnXor -- ^ @^@
| UnNxor -- ^ @~^@
| UnNxorInv -- ^ @^~@
deriving (Show, Eq, Ord)
-- | A primary expression which can either be a number or an identifier.
data Primary = PrimNum Number -- ^ Number in primary expression.
| PrimId Identifier -- ^ Identifier in primary expression.
deriving (Show, Eq, Ord)
-- | Verilog expression, which can either be a primary expression, unary
-- expression, binary operator expression or a conditional expression.
data Expression = PrimExpr Primary
| UnPrimExpr { _exprUnOp :: UnaryOperator
, _exprPrim :: Primary
}
| OpExpr { _exprLhs :: Expression
, _exprBinOp :: BinaryOperator
, _exprRhs :: Expression
}
| CondExpr { _exprCond :: Expression
, _exprTrue :: Expression
, _exprFalse :: Expression
}
| ExprStr Text
deriving (Show, Eq, Ord)
newtype ConstExpr = ConstExpr { _constNum :: Int }
deriving (Show, Eq, Ord)
-- | Different port direction that are supported in Verilog.
data PortDir = Input -- ^ Input direction for port (@input@).
| Output -- ^ Output direction for port (@output@).
| InOut -- ^ Inout direction for port (@inout@).
deriving (Show, Eq, Ord)
data PortType = PortNet Net
| Reg { _regSigned :: Bool }
deriving (Show, Eq, Ord)
-- | Port declaration.
data Port = Port { _portDir :: Maybe PortDir
, _portType :: Maybe PortType
, _portName :: Identifier
} deriving (Show, Eq, Ord)
newtype ModConn = ModConn { _modConn :: Expression }
deriving (Show, Eq, Ord)
data Assign = Assign { _assignReg :: RegLVal
, _assignDelay :: Maybe Delay
, _assignExpr :: Expression
} deriving (Show, Eq, Ord)
data ContAssign = ContAssign { _contAssignNetLVal :: Identifier
, _contAssignExpr :: Expression
} deriving (Show, Eq, Ord)
-- | Statements in Verilog.
data Statement = TimeCtrl { _statDelay :: Delay
, _statDStat :: Maybe Statement
} -- ^ Time control (@#NUM@)
| EventCtrl { _statEvent :: Event
, _statEStat :: Maybe Statement
}
| SeqBlock { _statements :: [Statement] } -- ^ Sequential block (@begin ... end@)
| BlockAssign Assign -- ^ blocking assignment (@=@)
| NonBlockAssign Assign -- ^ Non blocking assignment (@<=@)
| StatCA ContAssign -- ^ Statement continuous assignment
| TaskEnable Task
| SysTaskEnable Task
deriving (Show, Eq, Ord)
data Task = Task { _taskName :: Identifier
, _taskExpr :: [Expression]
} deriving (Show, Eq, Ord)
-- | Module item which is the body of the module expression.
data ModItem = ModCA ContAssign
| ModInst { _modInstId :: Identifier
, _modInstName :: Identifier
, _modInstConns :: [ModConn]
}
| Initial Statement
| Always Statement
| Decl Port
deriving (Show, Eq, Ord)
-- | 'module' module_identifier [list_of_ports] ';' { module_item } 'end_module'
data ModDecl = ModDecl { _moduleId :: Identifier
, _modPorts :: [Port]
, _moduleItems :: [ModItem]
} deriving (Show, Eq, Ord)
-- | Description of the Verilog module.
newtype Description = Description { _getDescription :: ModDecl }
deriving (Show, Eq, Ord)
-- | The complete sourcetext for the Verilog module.
newtype SourceText = SourceText { _getSourceText :: [Description] }
deriving (Show, Eq, Ord)
-- Generate Arbitrary instances for the AST
instance QC.Arbitrary Identifier where
arbitrary = Identifier . T.pack <$>
(QC.shuffle (['a'..'z'] <> ['A'..'Z']) >>= QC.sublistOf)
instance QC.Arbitrary Number where
arbitrary = Number <$> QC.suchThat QC.arbitrary (>0) <*> QC.arbitrary
instance QC.Arbitrary Net where
arbitrary = QC.elements [Wire, Tri]
instance QC.Arbitrary BinaryOperator where
arbitrary = QC.elements [BinAnd, BinOr, BinXor]
instance QC.Arbitrary UnaryOperator where
arbitrary = QC.elements [UnNot, UnMinus]
instance QC.Arbitrary Primary where
arbitrary = PrimNum <$> QC.arbitrary
instance QC.Arbitrary PortDir where
arbitrary = QC.elements [Input, Output, InOut]
instance QC.Arbitrary PortType where
arbitrary = QC.oneof [PortNet <$> QC.arbitrary, Reg <$> QC.arbitrary]
instance QC.Arbitrary Port where
arbitrary = Port <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary
instance QC.Arbitrary Delay where
arbitrary = Delay <$> QC.arbitrary
instance QC.Arbitrary Event where
arbitrary = EId <$> QC.arbitrary
instance QC.Arbitrary ModConn where
arbitrary = ModConn <$> QC.arbitrary
instance QC.Arbitrary ConstExpr where
arbitrary = ConstExpr <$> QC.arbitrary
instance QC.Arbitrary RegLVal where
arbitrary = QC.oneof [ RegId <$> QC.arbitrary
, RegExpr <$> QC.arbitrary <*> QC.arbitrary
, RegSize <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary
]
instance QC.Arbitrary Assign where
arbitrary = Assign <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary
instance QC.Arbitrary Expression where
arbitrary = QC.frequency [ (1, OpExpr <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary)
, (2, PrimExpr <$> QC.arbitrary)
]
instance QC.Arbitrary Statement where
arbitrary = QC.oneof [ TimeCtrl <$> QC.arbitrary <*> QC.arbitrary
, EventCtrl <$> QC.arbitrary <*> QC.arbitrary
, SeqBlock <$> QC.arbitrary
, BlockAssign <$> QC.arbitrary
, NonBlockAssign <$> QC.arbitrary
, StatCA <$> QC.arbitrary
, TaskEnable <$> QC.arbitrary
, SysTaskEnable <$> QC.arbitrary
]
instance QC.Arbitrary ContAssign where
arbitrary = ContAssign <$> QC.arbitrary <*> QC.arbitrary
instance QC.Arbitrary Task where
arbitrary = Task <$> QC.arbitrary <*> QC.arbitrary
instance QC.Arbitrary ModItem where
arbitrary = QC.oneof [ ModCA <$> QC.arbitrary
, ModInst <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary
, Initial <$> QC.arbitrary
, Always <$> QC.arbitrary
, Decl <$> QC.arbitrary
]
instance QC.Arbitrary ModDecl where
arbitrary = ModDecl <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary
instance QC.Arbitrary Description where
arbitrary = Description <$> QC.arbitrary
instance QC.Arbitrary SourceText where
arbitrary = SourceText <$> QC.arbitrary
-- Traversal Instance
traverseExpr :: Traversal' Expression Expression
traverseExpr _ (PrimExpr e) = pure (PrimExpr e)
traverseExpr _ (UnPrimExpr un e) = pure (UnPrimExpr un e)
traverseExpr f (OpExpr l op r) = OpExpr <$> f l <*> pure op <*> f r
traverseExpr f (CondExpr c l r) = CondExpr <$> f c <*> f l <*> f r
-- Create all the necessary lenses
makeLenses ''Identifier
makeLenses ''Number
makeLenses ''SourceText
makeLenses ''Description
makeLenses ''ModDecl
makeLenses ''ModItem
makeLenses ''Port
makeLenses ''PortDir
makeLenses ''BinaryOperator
makeLenses ''UnaryOperator
makeLenses ''Primary
makeLenses ''Expression
makeLenses ''ContAssign
makeLenses ''PortType
-- Make all the necessary prisms
makePrisms ''Expression
makePrisms ''ModItem
makePrisms ''ModConn
-- Other Instances
instance IsString Identifier where
fromString = Identifier . T.pack
|