Project

General

Profile

« Previous | Next » 

Revision 1732ef44

Added by Arnaud Dieumegard about 6 years ago

Start of the Lustre generator

View differences:

src/backends/VHDL/mini_vhdl_ast.ml
1 1
open Vhdl_ast
2
open Vhdl_ast_eq
3 2

  
4 3
type mini_vhdl_component_instantiation_t =
5 4
  {
src/backends/VHDL/vhdl_ast_utils.ml
1 1
open Vhdl_ast_map
2
open Vhdl_to_lustre
2
open Mini_vhdl_to_lustre
3 3
open Vhdl_2_mini_vhdl_map
4 4
open Vhdl_ast
5 5
open Mini_vhdl_ast
......
20 20

  
21 21
let to_lustre = object (self)
22 22
  inherit Ppxlib_traverse_builtins.map
23
  inherit vhdl_to_lustre_map as super
23
  inherit mini_vhdl_to_lustre_map as super
24 24

  
25 25
  method unit: unit T.map = any
26 26
end
src/tools/importer/main_lustre_importer.ml
10 10

  
11 11
 *)
12 12
open Yojson.Safe
13
open Vhdl_to_lustre
13
open Mini_vhdl_to_lustre
14 14
open Vhdl_ast_utils
15 15
open Vhdl_ast_map
16 16
open Vhdl_ast
......
91 91
          output_result mini_vhdl_value;
92 92
          ()
93 93
        )
94
        | GenLus -> ()
94
        | GenLus -> (
95
          let mini_vhdl = to_mini_vhdl#vhdl_design_file_t folded.design_file in
96
          let program = to_lustre#mini_vhdl_design_file_t mini_vhdl in
97
          (* Pretty print lustre value *)
98
          Printers.pp_prog str_formatter program;
99
          output_result (Format.flush_str_formatter ());
100
          ()
101
        )
95 102
      )
96
        (* Pretty print lustre value *)
97
        (* Printers.pp_prog std_formatter program; *)
98 103
      | Error e -> failwith (Format.sprintf "Error: %s\n" e)
99 104
  )
100 105
  | None -> ()
src/tools/importer/mini_vhdl_to_lustre.ml
1
open Vhdl_ast
2
open Vhdl_ast_pp
3
open Mini_vhdl_ast
4
open Vhdl_2_mini_vhdl_map
5
open Lustre_types
6
open Utils
7

  
8
let _ = fun (_ : mini_vhdl_component_instantiation_t)  -> () 
9
let _ = fun (_ : mini_vhdl_concurrent_stmt_t)  -> () 
10
let _ = fun (_ : mini_vhdl_component_t)  -> () 
11
let _ = fun (_ : mini_vhdl_design_file_t)  -> () 
12

  
13
class virtual mini_vhdl_to_lustre_map =
14
  object (self)
15
    inherit vhdl_2_mini_vhdl_map
16
    method virtual  list : 'a . ('a -> 'a) -> 'a list -> 'a list
17
    method virtual  mini_vhdl_component_instantiation_t : 
18
      mini_vhdl_component_instantiation_t -> statement
19
    method virtual  mini_vhdl_concurrent_stmt_t : 
20
      mini_vhdl_concurrent_stmt_t -> statement
21
    method virtual  mini_vhdl_component_t : 
22
      mini_vhdl_component_t -> top_decl_desc
23
    method virtual  mini_vhdl_design_file_t : 
24
      mini_vhdl_design_file_t -> program
25

  
26
    method mini_vhdl_component_instantiation_t :
27
      mini_vhdl_component_instantiation_t -> statement=
28
      fun { name; archi; entity; generic_map; port_map }  ->
29
        let name = self#vhdl_name_t name  in
30
        let archi = archi  in
31
        let entity = entity  in
32
        let generic_map = self#list self#vhdl_assoc_element_t generic_map  in
33
        let port_map = self#list self#vhdl_assoc_element_t port_map  in
34
        Eq {eq_lhs=[show_vhdl_name_t name];
35
            eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";
36
                    expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};
37
                    expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};
38
            eq_loc=Location.dummy_loc}
39

  
40
    method mini_vhdl_concurrent_stmt_t :
41
      mini_vhdl_concurrent_stmt_t -> statement=
42
      fun x  ->
43
        match x with
44
        | SigAssign a ->
45
            let a = self#vhdl_conditional_signal_t a  in
46
            Eq {eq_lhs=["SigAssign"];
47
                eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";
48
                        expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};
49
                        expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};
50
                eq_loc=Location.dummy_loc}
51
        | Process a -> let a = self#vhdl_process_t a  in
52
            Eq {eq_lhs=["Process"];
53
                eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";
54
                        expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};
55
                        expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};
56
                eq_loc=Location.dummy_loc}
57
        | SelectedSig a ->
58
            let a = self#vhdl_selected_signal_t a  in 
59
            Eq {eq_lhs=["SelectedSig"];
60
                eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";
61
                        expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};
62
                        expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};
63
                eq_loc=Location.dummy_loc}
64
        | ComponentInst a ->
65
            let a = self#mini_vhdl_component_instantiation_t a  in a
66

  
67
    method mini_vhdl_package_t : vhdl_package_t -> top_decl_desc=
68
      fun { name; shared_defs; shared_decls; shared_uses }  ->
69
        let name = self#vhdl_name_t name  in
70
        let shared_defs = self#list self#vhdl_definition_t shared_defs  in
71
        let shared_decls = self#list self#vhdl_declaration_t shared_decls  in
72
        let shared_uses = self#list self#vhdl_load_t shared_uses in
73
        let node_id = show_vhdl_name_t name in
74
        let node_type = Types.new_var () in
75
        let node_clock = Clocks.new_ck Cvar false in
76
        Node { node_id; node_type; node_clock; 
77
               node_inputs=[]; node_outputs = []; node_locals = [];
78
               node_gencalls = []; node_checks = []; node_asserts = [];
79
               node_stmts = []; node_dec_stateless = false; node_stateless = None; 
80
               node_spec = None; node_annot = [] }
81

  
82
    method mini_vhdl_component_t :
83
      mini_vhdl_component_t -> top_decl_desc=
84
      fun
85
        { names; generics; ports; contexts; declarations; definitions; body }
86
         ->
87
        let names = self#list self#vhdl_name_t names  in
88
        let generics = self#list self#vhdl_port_t generics  in
89
        let ports = self#list self#vhdl_port_t ports  in
90
        let contexts = self#list self#vhdl_load_t contexts  in
91
        let declarations = self#list self#vhdl_declaration_t declarations  in
92
        let definitions = self#list self#vhdl_definition_t definitions  in
93
        let body = List.map self#mini_vhdl_concurrent_stmt_t body  in
94
        let node_id = String.concat "__" (List.map show_vhdl_name_t names) in
95
        let node_type = Types.new_var () in
96
        let node_clock = Clocks.new_ck Cvar false in
97
        Node { node_id; node_type; node_clock; 
98
               node_inputs=[]; node_outputs = []; node_locals = [];
99
               node_gencalls = []; node_checks = []; node_asserts = [];
100
               node_stmts = body; node_dec_stateless = false; node_stateless = None; 
101
               node_spec = None; node_annot = [] }
102

  
103
    method mini_vhdl_design_file_t :
104
      mini_vhdl_design_file_t -> program =
105
      fun { components; packages }  ->
106
        let components = List.map self#mini_vhdl_component_t components  in
107
        let packages = List.map self#mini_vhdl_package_t packages  in
108
        let desc x = { top_decl_desc = x; top_decl_owner = ""; top_decl_itf = false; top_decl_loc = Location.dummy_loc } in
109
        let desc1 = List.map desc components in
110
        let desc2 = List.map desc packages in
111
        desc1 @ desc2
112
  end
src/tools/importer/vhdl_to_lustre.ml
1
open Vhdl_ast
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; expr } ->
352
            let label = self#option self#vhdl_name_t label  in
353
            let expr = self#option self#vhdl_expr_t expr in
354
            Return { label; expr }
355
    method vhdl_if_case_t : vhdl_if_case_t -> vhdl_if_case_t=
356
      fun { if_cond; if_block }  ->
357
        let if_cond = self#vhdl_expr_t if_cond  in
358
        let if_block = self#list self#vhdl_sequential_stmt_t if_block  in
359
        { if_cond; if_block }
360
    method vhdl_case_item_t : vhdl_case_item_t -> vhdl_case_item_t=
361
      fun { when_cond; when_stmt }  ->
362
        let when_cond = self#list self#vhdl_expr_t when_cond  in
363
        let when_stmt = self#list self#vhdl_sequential_stmt_t when_stmt  in
364
        { when_cond; when_stmt }
365

  
366
    method vhdl_declaration_t : vhdl_declaration_t -> vhdl_declaration_t=
367
      fun x  ->
368
        match x with
369
        | VarDecl { names; typ; init_val } ->
370
            let names = self#list self#vhdl_name_t names  in
371
            let typ = self#vhdl_subtype_indication_t typ  in
372
            let init_val = self#vhdl_expr_t init_val  in
373
            VarDecl { names; typ; init_val }
374
        | CstDecl { names; typ; init_val } ->
375
            let names = self#list self#vhdl_name_t names  in
376
            let typ = self#vhdl_subtype_indication_t typ  in
377
            let init_val = self#vhdl_expr_t init_val  in
378
            CstDecl { names; typ; init_val }
379
        | SigDecl { names; typ; init_val } ->
380
            let names = self#list self#vhdl_name_t names  in
381
            let typ = self#vhdl_subtype_indication_t typ  in
382
            let init_val = self#vhdl_expr_t init_val  in
383
            SigDecl { names; typ; init_val }
384
        | ComponentDecl { name; generics; ports } ->
385
            let name = self#vhdl_name_t name  in
386
            let generics = self#list self#vhdl_port_t generics  in
387
            let ports = self#list self#vhdl_port_t ports  in
388
            ComponentDecl { name; generics; ports }
389
        | Subprogram { spec; decl_part; stmts } ->
390
            let spec = self#vhdl_subprogram_spec_t spec  in
391
            let decl_part = self#list self#vhdl_declaration_t decl_part  in
392
            let stmts = self#list self#vhdl_sequential_stmt_t stmts  in
393
            Subprogram { spec; decl_part; stmts }
394

  
395
    method vhdl_declarative_item_t :
396
      vhdl_declarative_item_t -> vhdl_declarative_item_t=
397
      fun { use_clause; declaration; definition }  ->
398
        let use_clause = self#option self#vhdl_load_t use_clause  in
399
        let declaration = self#option self#vhdl_declaration_t declaration  in
400
        let definition = self#option self#vhdl_definition_t definition  in
401
        { use_clause; declaration; definition }
402

  
403
    method vhdl_waveform_element_t :
404
      vhdl_waveform_element_t -> vhdl_waveform_element_t=
405
      fun { value; delay }  ->
406
        let value = self#option self#vhdl_expr_t value  in
407
        let delay = self#option self#vhdl_expr_t delay  in { value; delay }
408

  
409
    method vhdl_signal_condition_t :
410
      vhdl_signal_condition_t -> vhdl_signal_condition_t=
411
      fun { expr; cond }  ->
412
        let expr = self#list self#vhdl_waveform_element_t expr  in
413
        let cond = self#option self#vhdl_expr_t cond  in { expr; cond }
414

  
415
    method vhdl_signal_selection_t :
416
      vhdl_signal_selection_t -> vhdl_signal_selection_t=
417
      fun { expr; when_sel }  ->
418
        let expr = self#list self#vhdl_waveform_element_t expr  in
419
        let when_sel = self#list self#vhdl_expr_t when_sel  in
420
        { expr; when_sel }
421

  
422
    method vhdl_conditional_signal_t :
423
      vhdl_conditional_signal_t -> vhdl_conditional_signal_t=
424
      fun { postponed; label; lhs; rhs; delay }  ->
425
        let postponed = self#bool postponed  in
426
        let label = self#vhdl_name_t label  in
427
        let lhs = self#vhdl_name_t lhs  in
428
        let rhs = self#list self#vhdl_signal_condition_t rhs  in
429
        let delay = self#vhdl_expr_t delay  in
430
        { postponed; label; lhs; rhs; delay }
431

  
432
    method vhdl_process_t : vhdl_process_t -> vhdl_process_t=
433
      fun { id; declarations; active_sigs; body }  ->
434
        let id = self#vhdl_name_t id  in
435
        let declarations = self#list self#vhdl_declarative_item_t declarations  in
436
        let active_sigs = self#list self#vhdl_name_t active_sigs  in
437
        let body = self#list self#vhdl_sequential_stmt_t body  in
438
        { id; declarations; active_sigs; body }
439

  
440
    method vhdl_selected_signal_t :
441
      vhdl_selected_signal_t -> vhdl_selected_signal_t=
442
      fun { postponed; label; lhs; sel; branches; delay }  ->
443
        let postponed = self#bool postponed  in
444
        let label = self#vhdl_name_t label  in
445
        let lhs = self#vhdl_name_t lhs  in
446
        let sel = self#vhdl_expr_t sel  in
447
        let branches = self#list self#vhdl_signal_selection_t branches  in
448
        let delay = self#option self#vhdl_expr_t delay  in
449
        { postponed; label; lhs; sel; branches; delay }
450

  
451
    method vhdl_port_mode_t : vhdl_port_mode_t -> vhdl_port_mode_t=
452
      fun x  -> x
453

  
454
    method vhdl_component_instantiation_t :
455
      vhdl_component_instantiation_t -> vhdl_component_instantiation_t=
456
        fun { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }  ->
457
        let name = self#vhdl_name_t name  in
458
        let inst_unit = self#vhdl_name_t inst_unit  in
459
        let inst_unit_type = self#string inst_unit_type  in
460
        let archi_name = self#option self#vhdl_name_t archi_name  in
461
        let generic_map = self#list self#vhdl_assoc_element_t generic_map  in
462
        let port_map = self#list self#vhdl_assoc_element_t port_map  in
463
        { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }
464

  
465
    method vhdl_concurrent_stmt_t :
466
      vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t=
467
      fun x  ->
468
        match x with
469
        | SigAssign a -> let a = self#vhdl_conditional_signal_t a  in SigAssign a
470
        | Process a -> let a = self#vhdl_process_t a  in Process a
471
        | SelectedSig a -> let a = self#vhdl_selected_signal_t a  in SelectedSig a
472
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a 
473

  
474
    method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
475
      fun { names; mode; typ; expr }  ->
476
        let names = self#list self#vhdl_name_t names  in
477
        let mode = self#vhdl_port_mode_t mode  in
478
        let typ = self#vhdl_subtype_indication_t typ  in
479
        let expr = self#vhdl_expr_t expr  in { names; mode; typ; expr }
480

  
481
    method vhdl_entity_t : vhdl_entity_t -> vhdl_entity_t=
482
      fun { name; generics; ports; declaration; stmts }  ->
483
        let name = self#vhdl_name_t name  in
484
        let generics = self#list self#vhdl_port_t generics  in
485
        let ports = self#list self#vhdl_port_t ports  in
486
        let declaration = self#list self#vhdl_declarative_item_t declaration
487
           in
488
        let stmts = self#list self#vhdl_concurrent_stmt_t stmts  in
489
        { name; generics; ports; declaration; stmts }
490

  
491
    method vhdl_package_t : vhdl_package_t -> vhdl_package_t=
492
      fun { name; shared_defs; shared_decls; shared_uses }  ->
493
        let name = self#vhdl_name_t name  in
494
        let shared_defs = self#list self#vhdl_definition_t shared_defs  in
495
        let shared_decls = self#list self#vhdl_declaration_t shared_decls  in
496
        let shared_uses = self#list self#vhdl_load_t shared_uses  in
497
        { name; shared_defs; shared_decls; shared_uses }
498

  
499
    method vhdl_load_t : vhdl_load_t -> vhdl_load_t=
500
      fun x  ->
501
        match x with
502
        | Library a -> let a = self#list self#vhdl_name_t a  in Library a
503
        | Use a -> let a = self#list self#vhdl_name_t a  in Use a
504

  
505
    method vhdl_architecture_t : vhdl_architecture_t -> vhdl_architecture_t=
506
      fun { name; entity; declarations; body }  ->
507
        let name = self#vhdl_name_t name  in
508
        let entity = self#vhdl_name_t entity  in
509
        let declarations = self#list self#vhdl_declarative_item_t declarations  in
510
        let body = self#list self#vhdl_concurrent_stmt_t body  in
511
        { name; entity; declarations; body }
512

  
513
    method vhdl_configuration_t :
514
      vhdl_configuration_t -> vhdl_configuration_t= self#unit
515

  
516
    method vhdl_library_unit_t : vhdl_library_unit_t -> vhdl_library_unit_t=
517
      fun x  ->
518
        match x with
519
        | Package a -> let a = self#vhdl_package_t a  in Package a
520
        | Entities a -> let a = self#vhdl_entity_t a  in Entities a
521
        | Architecture a ->
522
            let a = self#vhdl_architecture_t a  in Architecture a
523
        | Configuration a ->
524
            let a = self#vhdl_configuration_t a  in Configuration a
525

  
526
    method vhdl_design_unit_t : vhdl_design_unit_t -> vhdl_design_unit_t=
527
      fun { contexts; library }  ->
528
        let contexts = self#list self#vhdl_load_t contexts  in
529
        let library = self#vhdl_library_unit_t library  in
530
        { contexts; library }
531

  
532
    method vhdl_design_file_t : vhdl_design_file_t -> vhdl_design_file_t=
533
      fun { design_units }  ->
534
        let design_units = self#list self#vhdl_design_unit_t design_units  in
535
        { design_units }
536

  
537
    method vhdl_file_t : vhdl_file_t -> vhdl_file_t=
538
      fun { design_file }  ->
539
        let design_file = self#vhdl_design_file_t design_file  in
540
        { design_file }
541
  end

Also available in: Unified diff