Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / VHDL / vhdl_ast_fold_sensitivity.ml @ bd1f1929

History | View | Annotate | Download (16 KB)

1
open Vhdl_ast
2

    
3
let _ = fun (_ : vhdl_cst_val_t)  -> () 
4
let _ = fun (_ : vhdl_type_t)  -> () 
5
let _ = fun (_ : vhdl_element_declaration_t)  -> () 
6
let _ = fun (_ : vhdl_subtype_indication_t)  -> () 
7
let _ = fun (_ : vhdl_discrete_range_t)  -> () 
8
let _ = fun (_ : vhdl_constraint_t)  -> () 
9
let _ = fun (_ : vhdl_definition_t)  -> () 
10
let _ = fun (_ : vhdl_expr_t)  -> () 
11
let _ = fun (_ : vhdl_name_t)  -> () 
12
let _ = fun (_ : vhdl_assoc_element_t)  -> () 
13
let _ = fun (_ : vhdl_element_assoc_t)  -> () 
14
let _ = fun (_ : vhdl_array_attributes_t)  -> () 
15
let _ = fun (_ : vhdl_signal_attributes_t)  -> () 
16
let _ = fun (_ : vhdl_string_attributes_t)  -> () 
17
let _ = fun (_ : vhdl_suffix_selection_t)  -> () 
18
(*let _ = fun (_ : 'basetype vhdl_type_attributes_t)  -> () *)
19
let _ = fun (_ : vhdl_parameter_t)  -> () 
20
let _ = fun (_ : vhdl_subprogram_spec_t)  -> () 
21
let _ = fun (_ : vhdl_waveform_element_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_port_mode_t)  -> () 
26
let _ = fun (_ : vhdl_port_t)  -> () 
27
let _ = fun (_ : vhdl_declaration_t)  -> () 
28
let _ = fun (_ : vhdl_load_t)  -> () 
29
let _ = fun (_ : vhdl_declarative_item_t)  -> () 
30
let _ = fun (_ : vhdl_signal_condition_t)  -> () 
31
let _ = fun (_ : vhdl_signal_selection_t)  -> () 
32
let _ = fun (_ : vhdl_conditional_signal_t)  -> () 
33
let _ = fun (_ : vhdl_process_t)  -> () 
34
let _ = fun (_ : vhdl_selected_signal_t)  -> () 
35
let _ = fun (_ : vhdl_component_instantiation_t)  -> () 
36
let _ = fun (_ : vhdl_concurrent_stmt_t)  -> () 
37
let _ = fun (_ : vhdl_entity_t)  -> () 
38
let _ = fun (_ : vhdl_package_t)  -> () 
39
let _ = fun (_ : vhdl_architecture_t)  -> () 
40
let _ = fun (_ : vhdl_configuration_t)  -> () 
41
let _ = fun (_ : vhdl_library_unit_t)  -> () 
42
let _ = fun (_ : vhdl_design_unit_t)  -> () 
43
let _ = fun (_ : vhdl_design_file_t)  -> () 
44
let _ = fun (_ : vhdl_file_t)  -> () 
45

    
46
class virtual ['acc] fold_sensitivity =
47
  object (self)
48

    
49
    method list : 'a. ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc=
50
      fun f -> fun l -> fun acc -> List.fold_right f l acc
51

    
52
    method option : 'a. ('a -> 'acc -> 'acc) -> 'a option -> 'acc -> 'acc=
53
      fun f -> fun e -> fun acc -> match e with None -> acc | Some e -> f e acc
54

    
55
    method string : string -> 'acc -> 'acc=
56
      fun e -> fun acc -> acc
57

    
58
    method int : int -> 'acc -> 'acc=
59
      fun e -> fun acc -> acc
60

    
61
    method bool : bool -> 'acc -> 'acc=
62
      fun e -> fun acc -> acc
63

    
64
    method vhdl_cst_val_t : vhdl_cst_val_t -> 'acc -> 'acc=
65
      fun x  ->
66
        fun acc  -> acc
67

    
68
    method vhdl_type_t : vhdl_type_t -> 'acc -> 'acc=
69
      fun x  ->
70
        fun acc  -> acc
71

    
72
    method vhdl_element_declaration_t :
73
      vhdl_element_declaration_t -> 'acc -> 'acc=
74
      fun { ed_names; definition }  ->
75
        fun acc  -> acc
76

    
77
    method vhdl_subtype_indication_t :
78
      vhdl_subtype_indication_t -> 'acc -> 'acc=
79
      fun { si_name; functionName; const }  ->
80
        fun acc  ->
81
          let acc = self#vhdl_name_t si_name acc  in
82
          let acc = self#vhdl_name_t functionName acc  in
83
          let acc = self#vhdl_constraint_t const acc  in acc
84

    
85
    method vhdl_discrete_range_t : vhdl_discrete_range_t -> 'acc -> 'acc=
86
      fun x  ->
87
        fun acc  ->
88
          match x with
89
          | SubDiscreteRange a -> self#vhdl_subtype_indication_t a acc
90
          | NamedRange a -> self#vhdl_name_t a acc
91
          | DirectedRange { direction; from; _to } ->
92
              let acc = self#vhdl_expr_t from acc  in
93
              let acc = self#vhdl_expr_t _to acc  in acc
94

    
95
    method vhdl_constraint_t : vhdl_constraint_t -> 'acc -> 'acc=
96
      fun x  ->
97
        fun acc  ->
98
          match x with
99
          | RefConstraint { ref_name } -> self#vhdl_name_t ref_name acc
100
          | RangeConstraint { range } -> self#vhdl_discrete_range_t range acc
101
          | IndexConstraint { ranges } ->
102
              self#list self#vhdl_discrete_range_t ranges acc
103
          | ArrayConstraint { ranges; sub } ->
104
              let acc = self#list self#vhdl_discrete_range_t ranges acc  in
105
              let acc = self#vhdl_constraint_t sub acc  in acc
106
          | RecordConstraint  -> acc
107
          | NoConstraint  -> acc
108

    
109
    method vhdl_definition_t : vhdl_definition_t -> 'acc -> 'acc=
110
      fun x  ->
111
        fun acc  ->
112
          match x with
113
          | Type { name; definition } ->
114
              let acc = self#vhdl_name_t name acc  in
115
              let acc = self#vhdl_type_t definition acc  in acc
116
          | Subtype { name; typ } ->
117
              let acc = self#vhdl_name_t name acc  in
118
              let acc = self#vhdl_subtype_indication_t typ acc  in acc
119

    
120
    method vhdl_expr_t : vhdl_expr_t -> 'acc -> 'acc=
121
      fun x  ->
122
        fun acc  ->
123
          match x with
124
          | Call a -> a::acc
125
          | Cst { value; unit_name } ->
126
              let acc = self#vhdl_cst_val_t value acc  in
127
              let acc = self#option self#vhdl_name_t unit_name acc  in acc
128
          | Op { id; args } ->
129
              let acc = self#string id acc  in
130
              let acc = self#list self#vhdl_expr_t args acc  in acc
131
          | IsNull  -> acc
132
          | Time { value; phy_unit } ->
133
              let acc = self#int value acc  in
134
              let acc = self#string phy_unit acc  in acc
135
          | Sig { name; att } ->
136
              let acc = name::acc  in
137
              let acc = self#option self#vhdl_signal_attributes_t att acc  in
138
              acc
139
          | SuffixMod { expr; selection } ->
140
              let acc = self#vhdl_expr_t expr acc  in
141
              let acc = self#vhdl_suffix_selection_t selection acc  in acc
142
          | Aggregate { elems } ->
143
              self#list self#vhdl_element_assoc_t elems acc
144
          | QualifiedExpression { type_mark; aggregate; expression } ->
145
              let acc = type_mark::acc  in
146
              let acc = self#list self#vhdl_element_assoc_t aggregate acc  in
147
              let acc = self#option self#vhdl_expr_t expression acc  in acc
148
          | Others  -> acc
149

    
150
    method vhdl_name_t : vhdl_name_t -> 'acc -> 'acc=
151
      fun x  ->
152
        fun acc  ->
153
          match x with
154
          | Simple a -> x::acc
155
          | Identifier a -> x::acc
156
          | Selected a -> a@acc
157
          | Index { id; exprs } -> x::acc
158
          | Slice { id; range } -> x::acc
159
          | Attribute { id; designator; expr } ->
160
              let acc = x::acc in
161
              let acc = self#vhdl_expr_t expr acc  in acc
162
          | Function { id; assoc_list } ->
163
              let acc = x::acc in
164
              let acc = self#list self#vhdl_assoc_element_t assoc_list acc
165
                 in
166
              acc
167
          | Open -> acc
168
          | NoName  -> acc
169

    
170
    method vhdl_assoc_element_t : vhdl_assoc_element_t -> 'acc -> 'acc=
171
      fun
172
        { formal_name; formal_arg; actual_name; actual_designator;
173
          actual_expr }
174
         ->
175
        fun acc  ->
176
          let acc = match formal_name with None -> acc | Some a -> a::acc in
177
          let acc = match formal_arg with None -> acc | Some a -> a::acc in
178
          let acc = match actual_name with None -> acc | Some a -> a::acc in
179
          let acc = match actual_designator with None -> acc | Some a -> a::acc in
180
          let acc = self#option self#vhdl_expr_t actual_expr acc  in acc
181

    
182
    method vhdl_element_assoc_t : vhdl_element_assoc_t -> 'acc -> 'acc=
183
      fun { choices; expr }  ->
184
        fun acc  ->
185
          let acc = self#list self#vhdl_expr_t choices acc  in
186
          let acc = self#vhdl_expr_t expr acc  in acc
187

    
188
    method vhdl_array_attributes_t : vhdl_array_attributes_t -> 'acc -> 'acc=
189
      fun x  ->
190
        fun acc  ->
191
          match x with
192
          | AAttInt { id; arg } ->
193
              let acc = self#string id acc  in
194
              let acc = self#int arg acc  in acc
195
          | AAttAscending  -> acc
196

    
197
    method vhdl_signal_attributes_t :
198
      vhdl_signal_attributes_t -> 'acc -> 'acc=
199
      fun x  -> fun acc  -> match x with | SigAtt a -> self#string a acc
200

    
201
    method vhdl_string_attributes_t :
202
      vhdl_string_attributes_t -> 'acc -> 'acc=
203
      fun x  -> fun acc  -> match x with | StringAtt a -> self#string a acc
204

    
205
    method vhdl_suffix_selection_t : vhdl_suffix_selection_t -> 'acc -> 'acc=
206
      fun x  ->
207
        fun acc  ->
208
          match x with
209
          | Idx a -> self#int a acc
210
          | SuffixRange (a,b) ->
211
              let acc = self#int a acc  in let acc = self#int b acc  in acc
212

    
213
(*    method vhdl_type_attributes_t :
214
      'a . ('a -> 'acc -> 'acc) -> 'a vhdl_type_attributes_t -> 'acc -> 'acc=
215
      fun _basetype  ->
216
        fun x  ->
217
          fun acc  ->
218
            match x with
219
            | TAttNoArg { id } -> self#string id acc
220
            | TAttIntArg { id; arg } ->
221
                let acc = self#string id acc  in
222
                let acc = self#int arg acc  in acc
223
            | TAttValArg { id; arg } ->
224
                let acc = self#string id acc  in
225
                let acc = _basetype arg acc  in acc
226
            | TAttStringArg { id; arg } ->
227
                let acc = self#string id acc  in
228
                let acc = self#string arg acc  in acc *)
229

    
230
    method vhdl_parameter_t : vhdl_parameter_t -> 'acc -> 'acc=
231
      fun { parameter_names; parameter_mode; parameter_typ; init_val }  ->
232
        fun acc  ->
233
          let acc = self#list self#vhdl_name_t parameter_names acc  in
234
          let acc = self#list self#string parameter_mode acc  in
235
          let acc = self#vhdl_subtype_indication_t parameter_typ acc  in
236
          let acc = self#option self#vhdl_cst_val_t init_val acc  in acc
237

    
238
    method vhdl_subprogram_spec_t : vhdl_subprogram_spec_t -> 'acc -> 'acc=
239
      fun { ss_name; subprogram_type; typeMark; parameters; isPure }  ->
240
        fun acc  ->
241
          let acc = self#string ss_name acc  in
242
          let acc = self#string subprogram_type acc  in
243
          let acc = self#vhdl_name_t typeMark acc  in
244
          let acc = self#list self#vhdl_parameter_t parameters acc  in
245
          let acc = self#bool isPure acc  in acc
246

    
247
    method vhdl_waveform_element_t : vhdl_waveform_element_t -> 'acc -> 'acc=
248
      fun { value; we_delay }  ->
249
        fun acc  ->
250
          let acc = self#option self#vhdl_expr_t value acc  in
251
          let acc = self#option self#vhdl_expr_t we_delay acc  in acc
252

    
253
    method vhdl_sequential_stmt_t : vhdl_sequential_stmt_t -> 'acc -> 'acc=
254
      fun x  ->
255
        fun acc  ->
256
          match x with
257
          | VarAssign { label; seqs_lhs; rhs } ->
258
              let acc = self#vhdl_expr_t rhs acc  in acc
259
          | SigSeqAssign { label; seqs_lhs; rhs } ->
260
              let acc = self#list self#vhdl_waveform_element_t rhs acc  in
261
              acc
262
          | If { label; if_cases; default } ->
263
              let acc = self#list self#vhdl_if_case_t if_cases acc  in
264
              let acc = self#list self#vhdl_sequential_stmt_t default acc  in
265
              acc
266
          | Case { label; guard; branches } ->
267
              let acc = self#vhdl_expr_t guard acc  in
268
              let acc = self#list self#vhdl_case_item_t branches acc  in acc
269
          | Exit { label; loop_label; condition } ->
270
              let acc = self#option self#string loop_label acc  in
271
              let acc = self#option self#vhdl_expr_t condition acc  in acc
272
          | Assert { label; cond; report; severity } ->
273
              let acc = self#vhdl_expr_t cond acc  in
274
              let acc = self#vhdl_expr_t report acc  in
275
              let acc = self#vhdl_expr_t severity acc  in acc
276
          | ProcedureCall { label; name; assocs } ->
277
              let acc = self#vhdl_name_t name acc  in
278
              let acc = self#list self#vhdl_assoc_element_t assocs acc  in
279
              acc
280
          | Wait { sensitivity } -> sensitivity@acc
281
          | Null { label } -> acc
282
          | Return { label; expr } ->
283
              let acc = self#option self#vhdl_expr_t expr acc  in acc
284

    
285
    method vhdl_if_case_t : vhdl_if_case_t -> 'acc -> 'acc=
286
      fun { if_cond; if_block }  ->
287
        fun acc  ->
288
          let acc = self#vhdl_expr_t if_cond acc  in
289
          let acc = self#list self#vhdl_sequential_stmt_t if_block acc  in
290
          acc
291

    
292
    method vhdl_case_item_t : vhdl_case_item_t -> 'acc -> 'acc=
293
      fun { when_cond; when_stmt }  ->
294
        fun acc  ->
295
          let acc = self#list self#vhdl_expr_t when_cond acc  in
296
          let acc = self#list self#vhdl_sequential_stmt_t when_stmt acc  in
297
          acc
298

    
299
    method vhdl_port_mode_t : vhdl_port_mode_t -> 'acc -> 'acc=
300
      fun _  -> fun acc  -> acc
301

    
302
    method vhdl_port_t : vhdl_port_t -> 'acc -> 'acc=
303
      fun { port_names; port_mode; port_typ; port_expr }  ->
304
        fun acc  ->
305
          let acc = self#list self#vhdl_name_t port_names acc  in
306
          let acc = self#vhdl_port_mode_t port_mode acc  in
307
          let acc = self#vhdl_subtype_indication_t port_typ acc  in
308
          let acc = self#vhdl_expr_t port_expr acc  in acc
309

    
310
    method vhdl_declaration_t : vhdl_declaration_t -> 'acc -> 'acc=
311
      fun x  ->
312
        fun acc  -> acc
313

    
314
    method vhdl_load_t : vhdl_load_t -> 'acc -> 'acc=
315
      fun x  ->
316
        fun acc  -> acc
317

    
318
    method vhdl_declarative_item_t : vhdl_declarative_item_t -> 'acc -> 'acc=
319
      fun { use_clause; di_declaration; di_definition }  ->
320
        fun acc  -> acc
321

    
322
    method vhdl_signal_condition_t : vhdl_signal_condition_t -> 'acc -> 'acc=
323
      fun { sc_expr; cond }  ->
324
        fun acc  ->
325
          let acc = self#list self#vhdl_waveform_element_t sc_expr acc  in
326
          let acc = self#option self#vhdl_expr_t cond acc  in acc
327

    
328
    method vhdl_signal_selection_t : vhdl_signal_selection_t -> 'acc -> 'acc=
329
      fun { ss_expr; when_sel }  ->
330
        fun acc  ->
331
          let acc = self#list self#vhdl_waveform_element_t ss_expr acc  in
332
          let acc = self#list self#vhdl_expr_t when_sel acc  in acc
333
    
334
    method vhdl_conditional_signal_t :
335
      vhdl_conditional_signal_t -> 'acc -> 'acc=
336
      fun { cs_postponed; cs_label; cs_lhs; rhs; cs_delay }  ->
337
        fun acc  ->
338
          let acc = self#list self#vhdl_signal_condition_t rhs acc  in
339
          let acc = self#vhdl_expr_t cs_delay acc  in acc
340

    
341
    method vhdl_process_t : vhdl_process_t -> 'acc -> 'acc=
342
      fun { id; p_declarations; active_sigs; p_body }  ->
343
        fun acc  ->
344
          let acc = self#list self#vhdl_sequential_stmt_t p_body acc  in acc
345

    
346
    method vhdl_selected_signal_t : vhdl_selected_signal_t -> 'acc -> 'acc=
347
      fun { ss_postponed; ss_label; ss_lhs; sel; branches; ss_delay }  ->
348
        fun acc  ->
349
          let acc = self#vhdl_expr_t sel acc  in
350
          let acc = self#list self#vhdl_signal_selection_t branches acc  in
351
          let acc = self#option self#vhdl_expr_t ss_delay acc  in acc
352

    
353
    method vhdl_component_instantiation_t :
354
      vhdl_component_instantiation_t -> 'acc -> 'acc=
355
      fun
356
        { ci_name; inst_unit; inst_unit_type; archi_name; generic_map; port_map
357
          }
358
         ->
359
        fun acc  -> acc
360

    
361
    method vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t -> 'acc -> 'acc=
362
      fun x  ->
363
        fun acc  ->
364
          match x with
365
          | SigAssign a -> self#vhdl_conditional_signal_t a acc
366
          | Process a -> self#vhdl_process_t a acc
367
          | SelectedSig a -> self#vhdl_selected_signal_t a acc
368
          | ComponentInst a -> self#vhdl_component_instantiation_t a acc
369

    
370
    method vhdl_entity_t : vhdl_entity_t -> 'acc -> 'acc=
371
      fun { e_name; generics; ports; e_declaration; stmts }  ->
372
        fun acc  -> acc
373

    
374
    method vhdl_package_t : vhdl_package_t -> 'acc -> 'acc=
375
      fun { p_name; shared_defs; shared_decls; shared_uses }  ->
376
        fun acc  -> acc
377

    
378
    method vhdl_architecture_t : vhdl_architecture_t -> 'acc -> 'acc=
379
      fun { a_name; entity; a_declarations; a_body }  ->
380
        fun acc  -> acc
381

    
382
    method vhdl_configuration_t : vhdl_configuration_t -> 'acc -> 'acc=
383
      fun x -> fun acc -> acc
384

    
385
    method vhdl_library_unit_t : vhdl_library_unit_t -> 'acc -> 'acc=
386
      fun x  ->
387
        fun acc  -> acc
388

    
389
    method vhdl_design_unit_t : vhdl_design_unit_t -> 'acc -> 'acc=
390
      fun { contexts; library }  ->
391
        fun acc  -> acc
392

    
393
    method vhdl_design_file_t : vhdl_design_file_t -> 'acc -> 'acc=
394
      fun { design_units }  ->
395
        fun acc  -> acc
396

    
397
    method vhdl_file_t : vhdl_file_t -> 'acc -> 'acc=
398
      fun { design_file }  -> 
399
        fun acc  -> acc
400
  end