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