1
|
open Vhdl_ast
|
2
|
open Mini_vhdl_ast
|
3
|
|
4
|
let _ = fun (_ : vhdl_cst_val_t) -> ()
|
5
|
let _ = fun (_ : vhdl_type_t) -> ()
|
6
|
let _ = fun (_ : vhdl_element_declaration_t) -> ()
|
7
|
let _ = fun (_ : vhdl_subtype_indication_t) -> ()
|
8
|
let _ = fun (_ : vhdl_discrete_range_t) -> ()
|
9
|
let _ = fun (_ : vhdl_constraint_t) -> ()
|
10
|
let _ = fun (_ : vhdl_definition_t) -> ()
|
11
|
let _ = fun (_ : vhdl_expr_t) -> ()
|
12
|
let _ = fun (_ : vhdl_name_t) -> ()
|
13
|
let _ = fun (_ : vhdl_assoc_element_t) -> ()
|
14
|
let _ = fun (_ : vhdl_element_assoc_t) -> ()
|
15
|
let _ = fun (_ : vhdl_array_attributes_t) -> ()
|
16
|
let _ = fun (_ : vhdl_signal_attributes_t) -> ()
|
17
|
let _ = fun (_ : vhdl_string_attributes_t) -> ()
|
18
|
let _ = fun (_ : vhdl_suffix_selection_t) -> ()
|
19
|
let _ = fun (_ : 'basetype vhdl_type_attributes_t) -> ()
|
20
|
let _ = fun (_ : vhdl_parameter_t) -> ()
|
21
|
let _ = fun (_ : vhdl_subprogram_spec_t) -> ()
|
22
|
let _ = fun (_ : vhdl_sequential_stmt_t) -> ()
|
23
|
let _ = fun (_ : vhdl_if_case_t) -> ()
|
24
|
let _ = fun (_ : vhdl_case_item_t) -> ()
|
25
|
let _ = fun (_ : vhdl_declaration_t) -> ()
|
26
|
let _ = fun (_ : vhdl_signal_selection_t) -> ()
|
27
|
let _ = fun (_ : vhdl_declarative_item_t) -> ()
|
28
|
let _ = fun (_ : vhdl_waveform_element_t) -> ()
|
29
|
let _ = fun (_ : vhdl_signal_condition_t) -> ()
|
30
|
let _ = fun (_ : vhdl_conditional_signal_t) -> ()
|
31
|
let _ = fun (_ : vhdl_process_t) -> ()
|
32
|
let _ = fun (_ : vhdl_selected_signal_t) -> ()
|
33
|
let _ = fun (_ : vhdl_port_mode_t) -> ()
|
34
|
let _ = fun (_ : vhdl_component_instantiation_t) -> ()
|
35
|
let _ = fun (_ : vhdl_concurrent_stmt_t) -> ()
|
36
|
let _ = fun (_ : vhdl_port_t) -> ()
|
37
|
let _ = fun (_ : vhdl_entity_t) -> ()
|
38
|
let _ = fun (_ : vhdl_package_t) -> ()
|
39
|
let _ = fun (_ : vhdl_load_t) -> ()
|
40
|
let _ = fun (_ : vhdl_architecture_t) -> ()
|
41
|
let _ = fun (_ : vhdl_configuration_t) -> ()
|
42
|
let _ = fun (_ : vhdl_library_unit_t) -> ()
|
43
|
let _ = fun (_ : vhdl_design_unit_t) -> ()
|
44
|
let _ = fun (_ : vhdl_design_file_t) -> ()
|
45
|
|
46
|
class virtual vhdl_2_mini_vhdl_map =
|
47
|
object (self)
|
48
|
method virtual string : string -> string
|
49
|
method virtual list : 'a . ('a -> 'a) -> 'a list -> 'a list
|
50
|
method virtual unit : unit -> unit
|
51
|
method virtual bool : bool -> bool
|
52
|
method virtual option : 'a . ('a -> 'a) -> 'a option -> 'a option
|
53
|
method virtual int : int -> int
|
54
|
method virtual vhdl_name_t : vhdl_name_t -> vhdl_name_t
|
55
|
method virtual vhdl_definition_t : vhdl_definition_t -> vhdl_definition_t
|
56
|
method virtual vhdl_port_t : vhdl_port_t -> vhdl_port_t
|
57
|
method virtual vhdl_expr_t : vhdl_expr_t -> vhdl_expr_t
|
58
|
method virtual vhdl_port_mode_t : vhdl_port_mode_t -> vhdl_port_mode_t
|
59
|
method virtual vhdl_element_declaration_t : vhdl_element_declaration_t -> vhdl_element_declaration_t
|
60
|
method virtual vhdl_subtype_indication_t : vhdl_subtype_indication_t -> vhdl_subtype_indication_t
|
61
|
method virtual vhdl_conditional_signal_t : vhdl_conditional_signal_t -> vhdl_conditional_signal_t
|
62
|
method virtual vhdl_process_t : vhdl_process_t -> vhdl_process_t
|
63
|
method virtual vhdl_selected_signal_t : vhdl_selected_signal_t -> vhdl_selected_signal_t
|
64
|
method virtual vhdl_signal_selection_t : vhdl_signal_selection_t -> vhdl_signal_selection_t
|
65
|
method virtual vhdl_suffix_selection_t : vhdl_suffix_selection_t -> vhdl_suffix_selection_t
|
66
|
method virtual vhdl_declaration_t : vhdl_declaration_t -> vhdl_declaration_t
|
67
|
method virtual vhdl_sequential_stmt_t : vhdl_sequential_stmt_t -> vhdl_sequential_stmt_t
|
68
|
method virtual vhdl_declarative_item_t : vhdl_declarative_item_t -> vhdl_declarative_item_t
|
69
|
method virtual vhdl_waveform_element_t : vhdl_waveform_element_t -> vhdl_waveform_element_t
|
70
|
method virtual vhdl_signal_condition_t : vhdl_signal_condition_t -> vhdl_signal_condition_t
|
71
|
method virtual vhdl_cst_val_t : vhdl_cst_val_t -> vhdl_cst_val_t
|
72
|
method virtual vhdl_subprogram_spec_t : vhdl_subprogram_spec_t -> vhdl_subprogram_spec_t
|
73
|
method virtual vhdl_discrete_range_t : vhdl_discrete_range_t -> vhdl_discrete_range_t
|
74
|
method virtual vhdl_parameter_t : vhdl_parameter_t -> vhdl_parameter_t
|
75
|
method virtual vhdl_component_instantiation_t : vhdl_component_instantiation_t -> vhdl_component_instantiation_t
|
76
|
method virtual vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t
|
77
|
method virtual vhdl_declaration_t : vhdl_declaration_t -> vhdl_declaration_t
|
78
|
method virtual vhdl_configuration_t : vhdl_configuration_t -> unit
|
79
|
method virtual vhdl_entity_t : vhdl_entity_t -> unit
|
80
|
method virtual vhdl_library_unit_t : vhdl_library_unit_t -> unit
|
81
|
method virtual vhdl_load_t : vhdl_load_t -> vhdl_load_t
|
82
|
method virtual vhdl_design_unit_t : vhdl_design_unit_t -> unit
|
83
|
method virtual vhdl_design_file_t : vhdl_design_file_t -> mini_vhdl_design_file_t
|
84
|
|
85
|
method virtual vhdl_package_t : (vhdl_load_t list * vhdl_package_t) -> vhdl_package_t
|
86
|
method virtual vhdl_architecture_t : ((vhdl_load_t list * vhdl_package_t) list *
|
87
|
(vhdl_load_t list * vhdl_entity_t) list *
|
88
|
(vhdl_load_t list * vhdl_configuration_t) list *
|
89
|
(vhdl_load_t list * vhdl_architecture_t)) -> mini_vhdl_component_t
|
90
|
method virtual declarative_items_declarations : vhdl_declarative_item_t list -> vhdl_declaration_t list
|
91
|
method virtual declarative_items_definitions : vhdl_declarative_item_t list -> vhdl_definition_t list
|
92
|
method virtual declarative_items_uses : vhdl_declarative_item_t list -> vhdl_load_t list
|
93
|
method virtual filter_entity : ((vhdl_load_t list * vhdl_entity_t) list * vhdl_name_t) ->
|
94
|
(vhdl_load_t list * vhdl_entity_t)
|
95
|
|
96
|
method vhdl_cst_val_t : vhdl_cst_val_t -> vhdl_cst_val_t=
|
97
|
fun x ->
|
98
|
match x with
|
99
|
| CstInt a -> let a = self#int a in CstInt a
|
100
|
| CstStdLogic a -> let a = self#string a in CstStdLogic a
|
101
|
| CstLiteral a -> let a = self#string a in CstLiteral a
|
102
|
|
103
|
method vhdl_type_t : vhdl_type_t -> vhdl_type_t=
|
104
|
fun x ->
|
105
|
match x with
|
106
|
| Base a -> let a = self#string a in Base a
|
107
|
| Range (a,b,c) ->
|
108
|
let a = self#option self#string a in
|
109
|
let b = self#int b in let c = self#int c in Range (a, b, c)
|
110
|
| Bit_vector (a,b) ->
|
111
|
let a = self#int a in let b = self#int b in Bit_vector (a, b)
|
112
|
| Array { indexes; const; definition } ->
|
113
|
let indexes = self#list self#vhdl_name_t indexes in
|
114
|
let const = self#option self#vhdl_constraint_t const in
|
115
|
let definition = self#vhdl_subtype_indication_t definition in
|
116
|
Array { indexes; const; definition }
|
117
|
| Record a ->
|
118
|
let a = self#list self#vhdl_element_declaration_t a in Record a
|
119
|
| Enumerated a ->
|
120
|
let a = self#list self#vhdl_name_t a in Enumerated a
|
121
|
| Void -> Void
|
122
|
method vhdl_element_declaration_t :
|
123
|
vhdl_element_declaration_t -> vhdl_element_declaration_t=
|
124
|
fun { names; definition } ->
|
125
|
let names = self#list self#vhdl_name_t names in
|
126
|
let definition = self#vhdl_subtype_indication_t definition in
|
127
|
{ names; definition }
|
128
|
method vhdl_subtype_indication_t :
|
129
|
vhdl_subtype_indication_t -> vhdl_subtype_indication_t=
|
130
|
fun { name; functionName; const } ->
|
131
|
let name = self#vhdl_name_t name in
|
132
|
let functionName = self#vhdl_name_t functionName in
|
133
|
let const = self#vhdl_constraint_t const in
|
134
|
{ name; functionName; const }
|
135
|
method vhdl_discrete_range_t :
|
136
|
vhdl_discrete_range_t -> vhdl_discrete_range_t=
|
137
|
fun x ->
|
138
|
match x with
|
139
|
| SubDiscreteRange a ->
|
140
|
let a = self#vhdl_subtype_indication_t a in SubDiscreteRange a
|
141
|
| NamedRange a -> let a = self#vhdl_name_t a in NamedRange a
|
142
|
| DirectedRange { direction; from; _to } ->
|
143
|
let direction = self#string direction in
|
144
|
let from = self#vhdl_expr_t from in
|
145
|
let _to = self#vhdl_expr_t _to in
|
146
|
DirectedRange { direction; from; _to }
|
147
|
|
148
|
method vhdl_constraint_t : vhdl_constraint_t -> vhdl_constraint_t=
|
149
|
fun x ->
|
150
|
match x with
|
151
|
| RefConstraint { ref_name } ->
|
152
|
let ref_name = self#vhdl_name_t ref_name in
|
153
|
RefConstraint { ref_name }
|
154
|
| RangeConstraint { range } ->
|
155
|
let range = self#vhdl_discrete_range_t range in
|
156
|
RangeConstraint { range }
|
157
|
| IndexConstraint { ranges } ->
|
158
|
let ranges = self#list self#vhdl_discrete_range_t ranges in
|
159
|
IndexConstraint { ranges }
|
160
|
| ArrayConstraint { ranges; sub } ->
|
161
|
let ranges = self#list self#vhdl_discrete_range_t ranges in
|
162
|
let sub = self#vhdl_constraint_t sub in
|
163
|
ArrayConstraint { ranges; sub }
|
164
|
| RecordConstraint -> RecordConstraint
|
165
|
| NoConstraint -> NoConstraint
|
166
|
|
167
|
method vhdl_definition_t : vhdl_definition_t -> vhdl_definition_t=
|
168
|
fun x ->
|
169
|
match x with
|
170
|
| Type { name; definition } ->
|
171
|
let name = self#vhdl_name_t name in
|
172
|
let definition = self#vhdl_type_t definition in
|
173
|
Type { name; definition }
|
174
|
| Subtype { name; typ } ->
|
175
|
let name = self#vhdl_name_t name in
|
176
|
let typ = self#vhdl_subtype_indication_t typ in
|
177
|
Subtype { name; typ }
|
178
|
method vhdl_expr_t : vhdl_expr_t -> vhdl_expr_t=
|
179
|
fun x ->
|
180
|
match x with
|
181
|
| Call a -> let a = self#vhdl_name_t a in Call a
|
182
|
| Cst { value; unit_name } ->
|
183
|
let value = self#vhdl_cst_val_t value in
|
184
|
let unit_name = self#option self#vhdl_name_t unit_name in
|
185
|
Cst { value; unit_name }
|
186
|
| Op { id; args } ->
|
187
|
let id = self#string id in
|
188
|
let args = self#list self#vhdl_expr_t args in Op { id; args }
|
189
|
| IsNull -> IsNull
|
190
|
| Time { value; phy_unit } ->
|
191
|
let value = self#int value in
|
192
|
let phy_unit = self#string phy_unit in Time { value; phy_unit }
|
193
|
| Sig { name; att } ->
|
194
|
let name = self#vhdl_name_t name in
|
195
|
let att = self#option self#vhdl_signal_attributes_t att in
|
196
|
Sig { name; att }
|
197
|
| SuffixMod { expr; selection } ->
|
198
|
let expr = self#vhdl_expr_t expr in
|
199
|
let selection = self#vhdl_suffix_selection_t selection in
|
200
|
SuffixMod { expr; selection }
|
201
|
| Aggregate { elems } ->
|
202
|
let elems = self#list self#vhdl_element_assoc_t elems in
|
203
|
Aggregate { elems }
|
204
|
| QualifiedExpression { type_mark; aggregate; expression } ->
|
205
|
let type_mark = self#vhdl_name_t type_mark in
|
206
|
let aggregate = self#list self#vhdl_element_assoc_t aggregate in
|
207
|
let expression = self#option self#vhdl_expr_t expression in
|
208
|
QualifiedExpression { type_mark; aggregate; expression }
|
209
|
| Others -> Others
|
210
|
method vhdl_name_t : vhdl_name_t -> vhdl_name_t=
|
211
|
fun x ->
|
212
|
match x with
|
213
|
| Simple a -> let a = self#string a in Simple a
|
214
|
| Identifier a -> let a = self#string a in Identifier a
|
215
|
| Selected a -> let a = self#list self#vhdl_name_t a in Selected a
|
216
|
| Index { id; exprs } ->
|
217
|
let id = self#vhdl_name_t id in
|
218
|
let exprs = self#list self#vhdl_expr_t exprs in
|
219
|
Index { id; exprs }
|
220
|
| Slice { id; range } ->
|
221
|
let id = self#vhdl_name_t id in
|
222
|
let range = self#vhdl_discrete_range_t range in
|
223
|
Slice { id; range }
|
224
|
| Attribute { id; designator; expr } ->
|
225
|
let id = self#vhdl_name_t id in
|
226
|
let designator = self#vhdl_name_t designator in
|
227
|
let expr = self#vhdl_expr_t expr in
|
228
|
Attribute { id; designator; expr }
|
229
|
| Function { id; assoc_list } ->
|
230
|
let id = self#vhdl_name_t id in
|
231
|
let assoc_list = self#list self#vhdl_assoc_element_t assoc_list
|
232
|
in
|
233
|
Function { id; assoc_list }
|
234
|
| NoName -> NoName
|
235
|
method vhdl_assoc_element_t :
|
236
|
vhdl_assoc_element_t -> vhdl_assoc_element_t=
|
237
|
fun
|
238
|
{ formal_name; formal_arg; actual_name; actual_designator;
|
239
|
actual_expr }
|
240
|
->
|
241
|
let formal_name = self#option self#vhdl_name_t formal_name in
|
242
|
let formal_arg = self#option self#vhdl_name_t formal_arg in
|
243
|
let actual_name = self#option self#vhdl_name_t actual_name in
|
244
|
let actual_designator =
|
245
|
self#option self#vhdl_name_t actual_designator in
|
246
|
let actual_expr = self#option self#vhdl_expr_t actual_expr in
|
247
|
{
|
248
|
formal_name;
|
249
|
formal_arg;
|
250
|
actual_name;
|
251
|
actual_designator;
|
252
|
actual_expr
|
253
|
}
|
254
|
method vhdl_element_assoc_t :
|
255
|
vhdl_element_assoc_t -> vhdl_element_assoc_t=
|
256
|
fun { choices; expr } ->
|
257
|
let choices = self#list self#vhdl_expr_t choices in
|
258
|
let expr = self#vhdl_expr_t expr in { choices; expr }
|
259
|
method vhdl_array_attributes_t :
|
260
|
vhdl_array_attributes_t -> vhdl_array_attributes_t=
|
261
|
fun x ->
|
262
|
match x with
|
263
|
| AAttInt { id; arg } ->
|
264
|
let id = self#string id in
|
265
|
let arg = self#int arg in AAttInt { id; arg }
|
266
|
| AAttAscending -> AAttAscending
|
267
|
method vhdl_signal_attributes_t :
|
268
|
vhdl_signal_attributes_t -> vhdl_signal_attributes_t=
|
269
|
fun x -> match x with | SigAtt a -> let a = self#string a in SigAtt a
|
270
|
method vhdl_string_attributes_t :
|
271
|
vhdl_string_attributes_t -> vhdl_string_attributes_t=
|
272
|
fun x ->
|
273
|
match x with | StringAtt a -> let a = self#string a in StringAtt a
|
274
|
method vhdl_suffix_selection_t : vhdl_suffix_selection_t -> vhdl_suffix_selection_t=
|
275
|
fun x ->
|
276
|
match x with
|
277
|
| Idx a -> let a = self#int a in Idx a
|
278
|
| SuffixRange (a,b) ->
|
279
|
let a = self#int a in let b = self#int b in SuffixRange (a, b)
|
280
|
|
281
|
method vhdl_type_attributes_t :
|
282
|
'a .
|
283
|
('a -> 'a) -> 'a vhdl_type_attributes_t -> 'a vhdl_type_attributes_t=
|
284
|
fun _basetype ->
|
285
|
fun x ->
|
286
|
match x with
|
287
|
| TAttNoArg { id } -> let id = self#string id in TAttNoArg { id }
|
288
|
| TAttIntArg { id; arg } ->
|
289
|
let id = self#string id in
|
290
|
let arg = self#int arg in TAttIntArg { id; arg }
|
291
|
| TAttValArg { id; arg } ->
|
292
|
let id = self#string id in
|
293
|
let arg = _basetype arg in TAttValArg { id; arg }
|
294
|
| TAttStringArg { id; arg } ->
|
295
|
let id = self#string id in
|
296
|
let arg = self#string arg in TAttStringArg { id; arg }
|
297
|
|
298
|
method vhdl_parameter_t : vhdl_parameter_t -> vhdl_parameter_t=
|
299
|
fun { names; mode; typ; init_val } ->
|
300
|
let names = self#list self#vhdl_name_t names in
|
301
|
let mode = self#list self#string mode in
|
302
|
let typ = self#vhdl_subtype_indication_t typ in
|
303
|
let init_val = self#option self#vhdl_cst_val_t init_val in
|
304
|
{ names; mode; typ; init_val }
|
305
|
|
306
|
method vhdl_subprogram_spec_t :
|
307
|
vhdl_subprogram_spec_t -> vhdl_subprogram_spec_t=
|
308
|
fun { name; subprogram_type; typeMark; parameters; isPure } ->
|
309
|
let name = self#string name in
|
310
|
let subprogram_type = self#string subprogram_type in
|
311
|
let typeMark = self#vhdl_name_t typeMark in
|
312
|
let parameters = self#list self#vhdl_parameter_t parameters in
|
313
|
let isPure = self#bool isPure in
|
314
|
{ name; subprogram_type; typeMark; parameters; isPure }
|
315
|
|
316
|
method vhdl_sequential_stmt_t :
|
317
|
vhdl_sequential_stmt_t -> vhdl_sequential_stmt_t=
|
318
|
fun x ->
|
319
|
match x with
|
320
|
| VarAssign { label; lhs; rhs } ->
|
321
|
let label = self#vhdl_name_t label in
|
322
|
let lhs = self#vhdl_name_t lhs in
|
323
|
let rhs = self#vhdl_expr_t rhs in VarAssign { label; lhs; rhs }
|
324
|
| SigSeqAssign { label; lhs; rhs } ->
|
325
|
let label = self#vhdl_name_t label in
|
326
|
let lhs = self#vhdl_name_t lhs in
|
327
|
let rhs = self#list self#vhdl_waveform_element_t rhs in
|
328
|
SigSeqAssign { label; lhs; rhs }
|
329
|
| If { label; if_cases; default } ->
|
330
|
let label = self#vhdl_name_t label in
|
331
|
let if_cases = self#list self#vhdl_if_case_t if_cases in
|
332
|
let default = self#list self#vhdl_sequential_stmt_t default in
|
333
|
If { label; if_cases; default }
|
334
|
| Case { label; guard; branches } ->
|
335
|
let label = self#vhdl_name_t label in
|
336
|
let guard = self#vhdl_expr_t guard in
|
337
|
let branches = self#list self#vhdl_case_item_t branches in
|
338
|
Case { label; guard; branches }
|
339
|
| Exit { label; loop_label; condition } ->
|
340
|
let label = self#vhdl_name_t label in
|
341
|
let loop_label = self#option self#string loop_label in
|
342
|
let condition = self#option self#vhdl_expr_t condition in
|
343
|
Exit { label; loop_label; condition }
|
344
|
| Assert { label; cond; report; severity } ->
|
345
|
let label = self#vhdl_name_t label in
|
346
|
let cond = self#vhdl_expr_t cond in
|
347
|
let report = self#vhdl_expr_t report in
|
348
|
let severity = self#vhdl_expr_t severity in
|
349
|
Assert { label; cond; report; severity }
|
350
|
| ProcedureCall { label; name; assocs } ->
|
351
|
let label = self#vhdl_name_t label in
|
352
|
let name = self#vhdl_name_t name in
|
353
|
let assocs = self#list self#vhdl_assoc_element_t assocs in
|
354
|
ProcedureCall { label; name; assocs }
|
355
|
| Wait -> Wait
|
356
|
| Null { label } ->
|
357
|
let label = self#vhdl_name_t label in Null { label }
|
358
|
| Return { label; expr } ->
|
359
|
let label = self#option self#vhdl_name_t label in
|
360
|
let expr = self#option self#vhdl_expr_t expr in
|
361
|
Return { label; expr }
|
362
|
method vhdl_if_case_t : vhdl_if_case_t -> vhdl_if_case_t=
|
363
|
fun { if_cond; if_block } ->
|
364
|
let if_cond = self#vhdl_expr_t if_cond in
|
365
|
let if_block = self#list self#vhdl_sequential_stmt_t if_block in
|
366
|
{ if_cond; if_block }
|
367
|
method vhdl_case_item_t : vhdl_case_item_t -> vhdl_case_item_t=
|
368
|
fun { when_cond; when_stmt } ->
|
369
|
let when_cond = self#list self#vhdl_expr_t when_cond in
|
370
|
let when_stmt = self#list self#vhdl_sequential_stmt_t when_stmt in
|
371
|
{ when_cond; when_stmt }
|
372
|
|
373
|
method vhdl_declaration_t : vhdl_declaration_t -> vhdl_declaration_t=
|
374
|
fun x ->
|
375
|
match x with
|
376
|
| VarDecl { names; typ; init_val } ->
|
377
|
let names = self#list self#vhdl_name_t names in
|
378
|
let typ = self#vhdl_subtype_indication_t typ in
|
379
|
let init_val = self#vhdl_expr_t init_val in
|
380
|
VarDecl { names; typ; init_val }
|
381
|
| CstDecl { names; typ; init_val } ->
|
382
|
let names = self#list self#vhdl_name_t names in
|
383
|
let typ = self#vhdl_subtype_indication_t typ in
|
384
|
let init_val = self#vhdl_expr_t init_val in
|
385
|
CstDecl { names; typ; init_val }
|
386
|
| SigDecl { names; typ; init_val } ->
|
387
|
let names = self#list self#vhdl_name_t names in
|
388
|
let typ = self#vhdl_subtype_indication_t typ in
|
389
|
let init_val = self#vhdl_expr_t init_val in
|
390
|
SigDecl { names; typ; init_val }
|
391
|
| ComponentDecl { name; generics; ports } ->
|
392
|
let name = self#vhdl_name_t name in
|
393
|
let generics = self#list self#vhdl_port_t generics in
|
394
|
let ports = self#list self#vhdl_port_t ports in
|
395
|
ComponentDecl { name; generics; ports }
|
396
|
| Subprogram { spec; decl_part; stmts } ->
|
397
|
let spec = self#vhdl_subprogram_spec_t spec in
|
398
|
let decl_part = self#list self#vhdl_declaration_t decl_part in
|
399
|
let stmts = self#list self#vhdl_sequential_stmt_t stmts in
|
400
|
Subprogram { spec; decl_part; stmts }
|
401
|
|
402
|
method vhdl_declarative_item_t :
|
403
|
vhdl_declarative_item_t -> vhdl_declarative_item_t=
|
404
|
fun { use_clause; declaration; definition } ->
|
405
|
let use_clause = self#option self#vhdl_load_t use_clause in
|
406
|
let declaration = self#option self#vhdl_declaration_t declaration in
|
407
|
let definition = self#option self#vhdl_definition_t definition in
|
408
|
{ use_clause; declaration; definition }
|
409
|
|
410
|
method vhdl_waveform_element_t :
|
411
|
vhdl_waveform_element_t -> vhdl_waveform_element_t=
|
412
|
fun { value; delay } ->
|
413
|
let value = self#option self#vhdl_expr_t value in
|
414
|
let delay = self#option self#vhdl_expr_t delay in { value; delay }
|
415
|
|
416
|
method vhdl_signal_condition_t :
|
417
|
vhdl_signal_condition_t -> vhdl_signal_condition_t=
|
418
|
fun { expr; cond } ->
|
419
|
let expr = self#list self#vhdl_waveform_element_t expr in
|
420
|
let cond = self#option self#vhdl_expr_t cond in { expr; cond }
|
421
|
|
422
|
method vhdl_signal_selection_t :
|
423
|
vhdl_signal_selection_t -> vhdl_signal_selection_t=
|
424
|
fun { expr; when_sel } ->
|
425
|
let expr = self#list self#vhdl_waveform_element_t expr in
|
426
|
let when_sel = self#list self#vhdl_expr_t when_sel in
|
427
|
{ expr; when_sel }
|
428
|
|
429
|
method vhdl_conditional_signal_t :
|
430
|
vhdl_conditional_signal_t -> vhdl_conditional_signal_t=
|
431
|
fun { postponed; label; lhs; rhs; delay } ->
|
432
|
let postponed = self#bool postponed in
|
433
|
let label = self#vhdl_name_t label in
|
434
|
let lhs = self#vhdl_name_t lhs in
|
435
|
let rhs = self#list self#vhdl_signal_condition_t rhs in
|
436
|
let delay = self#vhdl_expr_t delay in
|
437
|
{ postponed; label; lhs; rhs; delay }
|
438
|
|
439
|
method vhdl_process_t : vhdl_process_t -> vhdl_process_t=
|
440
|
fun { id; declarations; active_sigs; body } ->
|
441
|
let id = self#vhdl_name_t id in
|
442
|
let declarations = self#list self#vhdl_declarative_item_t declarations in
|
443
|
let active_sigs = self#list self#vhdl_name_t active_sigs in
|
444
|
let body = self#list self#vhdl_sequential_stmt_t body in
|
445
|
{ id; declarations; active_sigs; body }
|
446
|
|
447
|
method vhdl_selected_signal_t :
|
448
|
vhdl_selected_signal_t -> vhdl_selected_signal_t=
|
449
|
fun { postponed; label; lhs; sel; branches; delay } ->
|
450
|
let postponed = self#bool postponed in
|
451
|
let label = self#vhdl_name_t label in
|
452
|
let lhs = self#vhdl_name_t lhs in
|
453
|
let sel = self#vhdl_expr_t sel in
|
454
|
let branches = self#list self#vhdl_signal_selection_t branches in
|
455
|
let delay = self#option self#vhdl_expr_t delay in
|
456
|
{ postponed; label; lhs; sel; branches; delay }
|
457
|
|
458
|
method vhdl_port_mode_t : vhdl_port_mode_t -> vhdl_port_mode_t=
|
459
|
fun x -> x
|
460
|
|
461
|
method vhdl_component_instantiation_t :
|
462
|
vhdl_component_instantiation_t -> vhdl_component_instantiation_t=
|
463
|
fun { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map } ->
|
464
|
let name = self#vhdl_name_t name in
|
465
|
let inst_unit = self#vhdl_name_t inst_unit in
|
466
|
let inst_unit_type = self#string inst_unit_type in
|
467
|
let archi_name = self#option self#vhdl_name_t archi_name in
|
468
|
let generic_map = self#list self#vhdl_assoc_element_t generic_map in
|
469
|
let port_map = self#list self#vhdl_assoc_element_t port_map in
|
470
|
{ name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }
|
471
|
|
472
|
method vhdl_concurrent_stmt_t :
|
473
|
vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t=
|
474
|
fun x ->
|
475
|
match x with
|
476
|
| SigAssign a -> let a = self#vhdl_conditional_signal_t a in SigAssign a
|
477
|
| Process a -> let a = self#vhdl_process_t a in Process a
|
478
|
| SelectedSig a -> let a = self#vhdl_selected_signal_t a in SelectedSig a
|
479
|
| ComponentInst a -> let a = self#vhdl_component_instantiation_t a in ComponentInst a
|
480
|
|
481
|
method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
|
482
|
fun { names; mode; typ; expr } ->
|
483
|
let names = self#list self#vhdl_name_t names in
|
484
|
let mode = self#vhdl_port_mode_t mode in
|
485
|
let typ = self#vhdl_subtype_indication_t typ in
|
486
|
let expr = self#vhdl_expr_t expr in { names; mode; typ; expr }
|
487
|
|
488
|
method vhdl_entity_t : vhdl_entity_t -> unit =
|
489
|
fun { name; generics; ports; declaration; stmts } ->
|
490
|
let name = self#vhdl_name_t name in
|
491
|
let generics = self#list self#vhdl_port_t generics in
|
492
|
let ports = self#list self#vhdl_port_t ports in
|
493
|
let declaration = self#list self#vhdl_declarative_item_t declaration
|
494
|
in
|
495
|
let stmts = self#list self#vhdl_concurrent_stmt_t stmts in ()
|
496
|
|
497
|
|
498
|
|
499
|
method vhdl_package_t : (vhdl_load_t list * vhdl_package_t) -> vhdl_package_t=
|
500
|
fun ( ctxs, {name; shared_defs; shared_decls; shared_uses }) ->
|
501
|
let name = self#vhdl_name_t name in
|
502
|
let shared_defs = self#list self#vhdl_definition_t shared_defs in
|
503
|
let shared_decls = self#list self#vhdl_declaration_t shared_decls in
|
504
|
let shared_uses = self#list self#vhdl_load_t shared_uses @ ctxs in
|
505
|
{ name; shared_defs; shared_decls; shared_uses }
|
506
|
|
507
|
method vhdl_load_t : vhdl_load_t -> vhdl_load_t=
|
508
|
fun x ->
|
509
|
match x with
|
510
|
| Library a -> let a = self#list self#vhdl_name_t a in Library a
|
511
|
| Use a -> let a = self#list self#vhdl_name_t a in Use a
|
512
|
|
513
|
method vhdl_architecture_t : ((vhdl_load_t list * vhdl_package_t) list *
|
514
|
(vhdl_load_t list * vhdl_entity_t) list *
|
515
|
(vhdl_load_t list * vhdl_configuration_t) list *
|
516
|
(vhdl_load_t list * vhdl_architecture_t)) -> mini_vhdl_component_t=
|
517
|
fun ( packs_pairs, ents_pairs, confs_pairs, (arch_ctx, arch) ) ->
|
518
|
let names = arch.name::(arch.entity::[]) in
|
519
|
let (ref_ent_ctx,ref_ent) = self#filter_entity (ents_pairs, arch.entity) in
|
520
|
let contexts =
|
521
|
arch_ctx @
|
522
|
ref_ent_ctx @
|
523
|
self#declarative_items_uses arch.declarations @
|
524
|
self#declarative_items_uses ref_ent.declaration in
|
525
|
let declarations =
|
526
|
self#declarative_items_declarations arch.declarations @
|
527
|
self#declarative_items_declarations ref_ent.declaration in
|
528
|
let definitions =
|
529
|
self#declarative_items_definitions arch.declarations @
|
530
|
self#declarative_items_definitions ref_ent.declaration in
|
531
|
let body =
|
532
|
arch.body @
|
533
|
ref_ent.stmts in
|
534
|
{ names; generics=ref_ent.generics; ports=ref_ent.ports; contexts=contexts; declarations=declarations; definitions=definitions; body=body }
|
535
|
|
536
|
method declarative_items_declarations : vhdl_declarative_item_t list -> vhdl_declaration_t list =
|
537
|
fun x ->
|
538
|
let rec map_decls l = match l with
|
539
|
| {use_clause=_; declaration=Some a;definition=_}::tl -> a::map_decls tl
|
540
|
| _::tl -> map_decls tl
|
541
|
| [] -> [] in map_decls x
|
542
|
|
543
|
method declarative_items_definitions : vhdl_declarative_item_t list -> vhdl_definition_t list =
|
544
|
fun x ->
|
545
|
let rec map_decls l = match l with
|
546
|
| {use_clause=_; declaration=_;definition=Some a}::tl -> a::map_decls tl
|
547
|
| _::tl -> map_decls tl
|
548
|
| [] -> [] in map_decls x
|
549
|
|
550
|
method declarative_items_uses : vhdl_declarative_item_t list -> vhdl_load_t list =
|
551
|
fun x ->
|
552
|
let rec map_decls l = match l with
|
553
|
| {use_clause=Some a; declaration=_;definition=_}::tl -> a::map_decls tl
|
554
|
| _::tl -> map_decls tl
|
555
|
| [] -> [] in map_decls x
|
556
|
|
557
|
method filter_entity : ((vhdl_load_t list * vhdl_entity_t) list * vhdl_name_t) ->
|
558
|
(vhdl_load_t list * vhdl_entity_t) =
|
559
|
fun ( entities_pair, filter_name ) ->
|
560
|
let rec filter ep n = match ep with
|
561
|
| [] -> failwith "Impossible to find a matching entity"
|
562
|
| (c,{name; generics; ports; declaration;stmts})::tl ->
|
563
|
if (name = n) then
|
564
|
List.hd ep
|
565
|
else filter (List.tl ep) n in
|
566
|
filter entities_pair filter_name
|
567
|
|
568
|
method vhdl_configuration_t :
|
569
|
vhdl_configuration_t -> unit= self#unit
|
570
|
|
571
|
method vhdl_library_unit_t : vhdl_library_unit_t -> unit=
|
572
|
fun x ->
|
573
|
match x with
|
574
|
| Package a -> let a = self#vhdl_package_t ([],a) in ()
|
575
|
| Entities a -> let a = self#vhdl_entity_t a in ()
|
576
|
| Architecture a ->
|
577
|
let a = self#vhdl_architecture_t ([],[],[],([],a)) in ()
|
578
|
| Configuration a ->
|
579
|
let a = self#vhdl_configuration_t a in ()
|
580
|
|
581
|
method vhdl_design_unit_t : vhdl_design_unit_t -> unit=
|
582
|
fun { contexts; library } ->
|
583
|
let contexts = self#list self#vhdl_load_t contexts in
|
584
|
let library = self#vhdl_library_unit_t library in ()
|
585
|
|
586
|
method vhdl_design_file_t : vhdl_design_file_t -> mini_vhdl_design_file_t=
|
587
|
fun { design_units } ->
|
588
|
let rec inline_df l packs ents archs confs = match l with
|
589
|
| [] -> (List.rev packs, List.rev ents, List.rev archs, List.rev confs)
|
590
|
| {contexts = c; library = lib}::tl -> match lib with
|
591
|
| Package p -> inline_df tl ((c,p)::packs) ents archs confs
|
592
|
| Entities e -> inline_df tl packs ((c,e)::ents) archs confs
|
593
|
| Architecture a -> inline_df tl packs ents ((c,a)::archs) confs
|
594
|
| Configuration conf -> inline_df tl packs ents archs ((c,conf)::confs) in
|
595
|
let (p,e,a,con) = inline_df design_units [] [] [] [] in
|
596
|
let app x = self#vhdl_architecture_t (p,e,con,x) in
|
597
|
let components = List.map app a in
|
598
|
let packages = List.map self#vhdl_package_t p in
|
599
|
{ components; packages }
|
600
|
|
601
|
end
|