blob: 3e36cf5bfff0cc802d2d2b00d46a0cf6538947ad (
plain)
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
|
{-|
Module : VeriFuzz.CodeGen
Description : Code generation for Verilog AST.
Copyright : (c) 2018-2019, Yann Herklotz Grave
License : BSD-3
Maintainer : ymherklotz [at] gmail [dot] com
Stability : experimental
Portability : POSIX
This module generates the code from the Verilog AST defined in
"VeriFuzz.Verilog.AST".
-}
{-# LANGUAGE FlexibleInstances #-}
module VeriFuzz.CodeGen
( -- * Code Generation
GenVerilog(..)
, genSource
, render
) where
import Control.Lens (view, (^.))
import Data.Foldable (fold)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Numeric (showHex)
import Test.QuickCheck (Arbitrary, arbitrary)
import VeriFuzz.AST
import VeriFuzz.Internal
-- | 'Source' class which determines that source code is able to be generated
-- from the data structure using 'genSource'. This will be stored in 'Text' and
-- can then be processed further.
class Source a where
genSource :: a -> Text
-- | Map a 'Maybe Stmnt' to 'Text'. If it is 'Just stmnt', the generated
-- statements are returned. If it is 'Nothing', then @;\n@ is returned.
defMap :: Maybe Stmnt -> Text
defMap = maybe ";\n" genStmnt
-- | Convert the 'VerilogSrc' type to 'Text' so that it can be rendered.
genVerilogSrc :: VerilogSrc -> Text
genVerilogSrc source = fold $ genDescription <$> source ^. getVerilogSrc
-- | Generate the 'Description' to 'Text'.
genDescription :: Description -> Text
genDescription desc = genModuleDecl $ desc ^. getDescription
-- | Generate the 'ModDecl' for a module and convert it to 'Text'.
genModuleDecl :: ModDecl -> Text
genModuleDecl m =
"module " <> m ^. modId . getIdentifier <> ports <> ";\n" <> modI <> "endmodule\n"
where
ports | noIn && noOut = ""
| otherwise = "(" <> comma (genModPort <$> outIn) <> ")"
modI = fold $ genModuleItem <$> m ^. modItems
noOut = null $ m ^. modOutPorts
noIn = null $ m ^. modInPorts
outIn = (m ^. modOutPorts) ++ (m ^. modInPorts)
-- | Conversts 'Port' to 'Text' for the module list, which means it only
-- generates a list of identifiers.
genModPort :: Port -> Text
genModPort port = port ^. portName . getIdentifier
-- | Generate the 'Port' description.
genPort :: Port -> Text
genPort port = t <> sign <> size <> name
where
t = flip mappend " " . genPortType $ port ^. portType
size | port ^. portSize > 1 = "[" <> showT (port ^. portSize - 1) <> ":0] "
| otherwise = ""
name = port ^. portName . getIdentifier
sign = genSigned $ port ^. portSigned
genSigned :: Bool -> Text
genSigned True = "signed "
genSigned _ = ""
-- | Convert the 'PortDir' type to 'Text'.
genPortDir :: PortDir -> Text
genPortDir PortIn = "input"
genPortDir PortOut = "output"
genPortDir PortInOut = "inout"
-- | Generate a 'ModItem'.
genModuleItem :: ModItem -> Text
genModuleItem (ModCA ca) = genContAssign ca
genModuleItem (ModInst (Identifier i) (Identifier name) conn) =
i <> " " <> name <> "(" <> comma (genModConn <$> conn) <> ")" <> ";\n"
genModuleItem (Initial stat ) = "initial " <> genStmnt stat
genModuleItem (Always stat ) = "always " <> genStmnt stat
genModuleItem (Decl dir port) = maybe "" makePort dir <> genPort port <> ";\n"
where makePort = (<> " ") . genPortDir
genModConn :: ModConn -> Text
genModConn (ModConn c) =
genExpr c
genModConn (ModConnNamed n c) =
"." <> n ^. getIdentifier <> "(" <> genExpr c <> ")"
-- | Generate continuous assignment
genContAssign :: ContAssign -> Text
genContAssign (ContAssign val e) = "assign " <> name <> " = " <> expr <> ";\n"
where
name = val ^. getIdentifier
expr = genExpr e
-- | Generate 'Function' to 'Text'
genFunc :: Function -> Text
genFunc SignedFunc = "$signed"
genFunc UnSignedFunc = "$unsigned"
-- | Generate 'Expr' to 'Text'.
genExpr :: Expr -> Text
genExpr (BinOp eRhs bin eLhs) = "(" <> genExpr eRhs <> genBinaryOperator bin <> genExpr eLhs <> ")"
genExpr (Number s n ) = "(" <> minus <> showT s <> "'h" <> T.pack (showHex (abs n) "") <> ")"
where minus | signum n > 0 = "" | otherwise = "-"
genExpr (Id i ) = i ^. getIdentifier
genExpr (Concat c ) = "{" <> comma (genExpr <$> c) <> "}"
genExpr (UnOp u e ) = "(" <> genUnaryOperator u <> genExpr e <> ")"
genExpr (Cond l t f ) = "(" <> genExpr l <> " ? " <> genExpr t <> " : " <> genExpr f <> ")"
genExpr (Func f e ) = genFunc f <> "(" <> genExpr e <> ")"
genExpr (Str t ) = "\"" <> t <> "\""
-- | Convert 'BinaryOperator' to 'Text'.
genBinaryOperator :: BinaryOperator -> Text
genBinaryOperator BinPlus = " + "
genBinaryOperator BinMinus = " - "
genBinaryOperator BinTimes = " * "
genBinaryOperator BinDiv = " / "
genBinaryOperator BinMod = " % "
genBinaryOperator BinEq = " == "
genBinaryOperator BinNEq = " != "
genBinaryOperator BinCEq = " === "
genBinaryOperator BinCNEq = " !== "
genBinaryOperator BinLAnd = " && "
genBinaryOperator BinLOr = " || "
genBinaryOperator BinLT = " < "
genBinaryOperator BinLEq = " <= "
genBinaryOperator BinGT = " > "
genBinaryOperator BinGEq = " >= "
genBinaryOperator BinAnd = " & "
genBinaryOperator BinOr = " | "
genBinaryOperator BinXor = " ^ "
genBinaryOperator BinXNor = " ^~ "
genBinaryOperator BinXNorInv = " ~^ "
genBinaryOperator BinPower = " ** "
genBinaryOperator BinLSL = " << "
genBinaryOperator BinLSR = " >> "
genBinaryOperator BinASL = " <<< "
genBinaryOperator BinASR = " >>> "
-- | Convert 'UnaryOperator' to 'Text'.
genUnaryOperator :: UnaryOperator -> Text
genUnaryOperator UnPlus = "+"
genUnaryOperator UnMinus = "-"
genUnaryOperator UnLNot = "!"
genUnaryOperator UnNot = "~"
genUnaryOperator UnAnd = "&"
genUnaryOperator UnNand = "~&"
genUnaryOperator UnOr = "|"
genUnaryOperator UnNor = "~|"
genUnaryOperator UnXor = "^"
genUnaryOperator UnNxor = "~^"
genUnaryOperator UnNxorInv = "^~"
-- | Generate verilog code for an 'Event'.
genEvent :: Event -> Text
genEvent (EId i ) = "@(" <> i ^. getIdentifier <> ")"
genEvent (EExpr expr) = "@(" <> genExpr expr <> ")"
genEvent EAll = "@*"
genEvent (EPosEdge i) = "@(posedge " <> i ^. getIdentifier <> ")"
genEvent (ENegEdge i) = "@(negedge " <> i ^. getIdentifier <> ")"
-- | Generates verilog code for a 'Delay'.
genDelay :: Delay -> Text
genDelay (Delay i) = "#" <> showT i
-- | Generate the verilog code for an 'LVal'.
genLVal :: LVal -> Text
genLVal (RegId i ) = i ^. getIdentifier
genLVal (RegExpr i expr) = i ^. getIdentifier <> " [" <> genExpr expr <> "]"
genLVal (RegSize i msb lsb) =
i ^. getIdentifier <> " [" <> genConstExpr msb <> ":" <> genConstExpr lsb <> "]"
genLVal (RegConcat e) = "{" <> comma (genExpr <$> e) <> "}"
genConstExpr :: ConstExpr -> Text
genConstExpr (ConstExpr num) = showT num
genPortType :: PortType -> Text
genPortType Wire = "wire"
genPortType Reg = "reg"
genAssign :: Text -> Assign -> Text
genAssign op (Assign r d e) = genLVal r <> op <> maybe "" genDelay d <> genExpr e
genStmnt :: Stmnt -> Text
genStmnt (TimeCtrl d stat ) = genDelay d <> " " <> defMap stat
genStmnt (EventCtrl e stat ) = genEvent e <> " " <> defMap stat
genStmnt (SeqBlock s ) = "begin\n" <> fold (genStmnt <$> s) <> "end\n"
genStmnt (BlockAssign a ) = genAssign " = " a <> ";\n"
genStmnt (NonBlockAssign a ) = genAssign " <= " a <> ";\n"
genStmnt (StatCA a ) = genContAssign a
genStmnt (TaskEnable task) = genTask task <> ";\n"
genStmnt (SysTaskEnable task) = "$" <> genTask task <> ";\n"
genTask :: Task -> Text
genTask (Task name expr) | null expr = i
| otherwise = i <> "(" <> comma (genExpr <$> expr) <> ")"
where i = name ^. getIdentifier
-- | Render the 'Text' to 'IO'. This is equivalent to 'putStrLn'.
render :: (Source a) => a -> IO ()
render = T.putStrLn . genSource
-- Instances
instance Source Identifier where
genSource = view getIdentifier
instance Source Task where
genSource = genTask
instance Source Stmnt where
genSource = genStmnt
instance Source PortType where
genSource = genPortType
instance Source ConstExpr where
genSource = genConstExpr
instance Source LVal where
genSource = genLVal
instance Source Delay where
genSource = genDelay
instance Source Event where
genSource = genEvent
instance Source UnaryOperator where
genSource = genUnaryOperator
instance Source Expr where
genSource = genExpr
instance Source ContAssign where
genSource = genContAssign
instance Source ModItem where
genSource = genModuleItem
instance Source PortDir where
genSource = genPortDir
instance Source Port where
genSource = genPort
instance Source ModDecl where
genSource = genModuleDecl
instance Source Description where
genSource = genDescription
instance Source VerilogSrc where
genSource = genVerilogSrc
newtype GenVerilog a = GenVerilog { unGenVerilog :: a }
instance (Source a) => Show (GenVerilog a) where
show = T.unpack . genSource . unGenVerilog
instance (Arbitrary a) => Arbitrary (GenVerilog a) where
arbitrary = GenVerilog <$> arbitrary
|