Project

General

Profile

Revision 62b6a61c

View differences:

src/tools/importer/main_lustre_importer.ml
14 14
open Vhdl_test
15 15
  *)
16 16
open Yojson.Safe
17
open Vhdl_deriving_yojson
18
open Vhdl_json_lib
17
open Vhdl_ast
19 18
open Printf
20 19

  
21 20
let _ =
22
(*
23 21
  (* Load model with Yojson *)
24
  let json = xx in
25

  
26
  (* Create VHDL values *)
27
  let vhdl : vhdl_design_t = xxxx json in
28

  
29
  (* Printing result *)
30
  Format.printf "Loaded VHDL:@.%a@." pp_vhdl_design vhdl
31
 *)
32

  
33 22
  let vhdl_json = from_file Sys.argv.(1) in
34
  Format.printf "Original file:\n%s\n\n" (pretty_to_string vhdl_json);
35 23

  
36
  (*let vhdl = design1 in
37
  Format.printf "Loaded VHDL:@.%a@." pp_vhdl_design vhdl;*)
38

  
39
  let vhdl1_json = vhdl_json |> 
40
                   prune_str "TOKEN" |>
41
                   prune_str "IDENTIFIER" |>
42
                   prune_str "SUBTYPE_INDICATION" |>
43
                   prune_null_assoc |>
44
                   to_list_content_str "DESIGN_UNIT" |>
45
                   to_list_content_str "INTERFACE_VARIABLE_DECLARATION" |>
46
                   flatten_ivd |>
47
                   flatten_numeric_literal |>
48
                   to_list_str "ENTITY_DECLARATION" |>
49
                   to_list_str "ARCHITECTURE_BODY" |>
50
                   to_list_str "PACKAGE_DECLARATION" in
51
  Format.printf "Preprocessed json:\n";
52
  Format.printf "%s\n\n" (pretty_to_string vhdl1_json);
53
(*  List.iter (Format.printf "%s\n") (print_depth vhdl1_json 7 ""); *)
54

  
55
  to_file (Sys.argv.(1)^".out.json") vhdl1_json;
56

  
57
(*
58
  let typ = {name = "type"; definition = (Some (Range (Some "toto", 7, 0)))} in
59
  Format.printf "\nModel to string\n%s\n\n" (pretty_to_string (vhdl_subtype_indication_t_to_yojson typ));
60

  
61
  let elem = "[\"SUBTYPE_DECLARATION\", {\"name\": \"byte\", \"typ\": { \"name\": \"bit_vector\", \"definition\": [ \"RANGE_WITH_DIRECTION\", \"downto\", 7, 0 ]}}]" in
62
  match vhdl_definition_t_of_yojson (from_string elem) with
63
    Ok x -> Format.printf "\nString to string\n%s\n\n" (pretty_to_string (vhdl_definition_t_to_yojson x));
64
  | Error e -> Format.printf "Error: %s\n" e;
65
*)
24
  (* Create VHDL values *)
25
  let vhdl = vhdl_file_t_of_yojson vhdl_json in
66 26

  
67
  match vhdl_file_t_of_yojson vhdl1_json with
68
    Ok x -> Format.printf "Parsed VHDL: \n%s\n" (pretty_to_string (vhdl_file_t_to_yojson x))
27
  match vhdl with
28
    Ok x ->
29
      Format.printf "Parsed VHDL: \n%s\n" (pretty_to_string (vhdl_file_t_to_yojson x))
69 30
  | Error e -> Format.printf "Error: %s\n" e;
src/tools/importer/vhdl_ast.ml
1
let base_types = ["integer"; "character"; "bit"; "real"; "natural"; "positive"; "std_logic"; "std_logic_vector" ]
2
 
3
(************************************************************************************)		   
4
(*                     Constants                                                    *)
5
(************************************************************************************)		   
6

  
7
(* Std_logic values :
8
    'U': uninitialized. This signal hasn't been set yet.
9
    'X': unknown. Impossible to determine this value/result.
10
    '0': logic 0
11
    '1': logic 1
12
    'Z': High Impedance
13
    'W': Weak signal, can't tell if it should be 0 or 1.
14
    'L': Weak signal that should probably go to 0
15
    'H': Weak signal that should probably go to 1
16
    '-': Don't care. *)			       
17
let std_logic_cst = ["U"; "X"; "0"; "1"; "Z"; "W"; "L"; "H"; "-" ]
18
let literal_base = ["B"; "O"; "X"; "UB"; "UO"; "UX"; "SB"; "SO"; "SX"; "D"] (* Prefix of CstLiteral *)
19

  
20
(* TODO: do we need more constructors ? *)
21
type cst_val_t = 
22
    CstInt of int 
23
  | CstStdLogic of string
24
  | CstLiteral of string [@name "CST_LITERAL"]
25
[@@deriving yojson {strict = false}];;
26

  
27
type vhdl_type_t =
28
  | Base of string
29
  | Range of string option * int * int
30
  | Bit_vector of int * int
31
  | Array of int * int * vhdl_type_t
32
  | Enumerated of string list
33
  | Void
34
and vhdl_subtype_indication_t =
35
  {
36
    name : vhdl_name_t [@default NoName];
37
    functionName : vhdl_name_t [@default NoName];
38
    const: vhdl_constraint_t [@default NoConstraint];
39
  }
40
and vhdl_discrete_range_t =
41
  | SubDiscreteRange of vhdl_subtype_indication_t [@name "SUB_DISCRETE_RANGE"]
42
  | NamedRange of vhdl_name_t [@name "NAMED_RANGE"]
43
  | DirectedRange of { direction: string; from: vhdl_expr_t; _to: vhdl_expr_t } [@name "RANGE_WITH_DIRECTION"]
44
and vhdl_constraint_t =
45
  | RefConstraint of { ref_name: vhdl_name_t; }
46
  | RangeConstraint of { range: vhdl_discrete_range_t } [@name "RANGE_CONSTRAINT"]
47
  | IndexConstraint of { ranges: vhdl_discrete_range_t list; } [@name "INDEX_CONSTRAINT"]
48
  | ArrayConstraint of { ranges: vhdl_discrete_range_t list; sub: vhdl_constraint_t } [@name "ARRAY_CONSTRAINT"]
49
  | RecordConstraint
50
  | NoConstraint
51
and vhdl_definition_t =
52
  | Type of {name : vhdl_name_t ; definition: vhdl_type_t} [@name "TYPE_DECLARATION"]
53
  | Subtype of {name : vhdl_name_t ; typ : vhdl_subtype_indication_t} [@name "SUBTYPE_DECLARATION"]
54
and vhdl_expr_t =
55
  | Call of vhdl_name_t [@name "CALL"]
56
  | Cst of cst_val_t [@name "CONSTANT_VALUE"]
57
  | Op of { id: string [@default ""]; args: vhdl_expr_t list [@default []]} [@name "EXPRESSION"]
58
  | IsNull [@name "IsNull"]
59
  | Time of { value: int; phy_unit: string [@default ""]}
60
  | Sig of { name: vhdl_name_t; att: vhdl_signal_attributes_t option }
61
  | SuffixMod of { expr : vhdl_expr_t; selection : suffix_selection_t }
62
  | Aggregate of { elems : vhdl_element_assoc_t list } [@name "AGGREGATE"]
63
  | Others [@name "OTHERS"]
64
and vhdl_name_t =
65
  | Simple of string [@name "SIMPLE_NAME"]
66
  | Identifier of string [@name "IDENTIFIER"]
67
  | Selected of vhdl_name_t list [@name "SELECTED_NAME"]
68
  | Index of { id: vhdl_name_t; exprs: vhdl_expr_t list } [@name "INDEXED_NAME"]
69
  | Slice of { id: vhdl_name_t; range: vhdl_discrete_range_t } [@name "SLICE_NAME"]
70
  | Attribute of { id: vhdl_name_t; designator: vhdl_name_t; expr: vhdl_expr_t [@default IsNull]} [@name "ATTRIBUTE_NAME"]
71
  | Function of { id: vhdl_name_t; assoc_list: vhdl_assoc_element_t list } [@name "FUNCTION_CALL"]
72
  | NoName
73
and vhdl_assoc_element_t =
74
  {
75
    formal_name: vhdl_name_t option [@default Some NoName];
76
    formal_arg: vhdl_name_t option [@default Some NoName];
77
    actual_name: vhdl_name_t option [@default Some NoName];
78
    actual_designator: vhdl_name_t option [@default Some NoName];
79
    actual_expr: vhdl_expr_t option [@default Some IsNull];
80
  }
81
and vhdl_element_assoc_t =
82
  {
83
    choices: vhdl_expr_t list;
84
    expr: vhdl_expr_t;
85
  }
86
and vhdl_array_attributes_t = 
87
  | AAttInt of { id: string; arg: int; } 
88
  | AAttAscending
89
and vhdl_signal_attributes_t = SigAtt of string
90
and vhdl_string_attributes_t = StringAtt of string
91
and suffix_selection_t = Idx of int | SuffixRange of int * int
92
[@@deriving yojson {strict = false}];;
93

  
94
(************************************************************************************)		   
95
(*            Attributes for types, arrays, signals and strings                     *)
96
(************************************************************************************)		   
97

  
98
type 'basetype vhdl_type_attributes_t =
99
  | TAttNoArg of { id: string }
100
  | TAttIntArg of { id: string; arg: int }
101
  | TAttValArg of { id: string; arg: 'basetype }
102
  | TAttStringArg of { id: string; arg: string }
103
[@@deriving yojson {strict = false}];;
104

  
105
let typ_att_noarg = ["base"; "left"; "right"; "high"; "low"]
106
let typ_att_intarg = ["pos"; "val"; "succ"; "pred"; "leftof"; "rightof"]
107
let typ_att_valarg = ["image"]
108
let typ_att_stringarg = ["value"]
109
  
110
let array_att_intarg = ["left"; "right"; "high"; "low"; "range"; "reverse_range"; "length"]  
111

  
112
type vhdl_parameter_t =
113
  {
114
    names: vhdl_name_t list;
115
    mode: string list [@default []];
116
    typ: vhdl_subtype_indication_t;
117
    init_val: cst_val_t option [@default Some (CstInt (0))];
118
  }
119
[@@deriving yojson {strict = false}];;
120

  
121
type vhdl_subprogram_spec_t =
122
  {
123
    name: string [@default ""];
124
    typeMark: vhdl_name_t [@default NoName];
125
    parameters: vhdl_parameter_t list;
126
    isPure: bool [@default false];
127
  }
128
[@@deriving yojson {strict = false}];;
129

  
130
(************************************************************************************)		   
131
(*                        Expressions  / Statements                                 *)
132
(************************************************************************************)		   
133

  
134
let arith_funs = ["+";"-";"*";"/";"mod"; "rem";"abs";"**";"&"]
135
let bool_funs  = ["and"; "or"; "nand"; "nor"; "xor"; "not"]
136
let rel_funs   = ["<";">";"<=";">=";"/=";"=";"?=";"?/=";"?<";"?<=";"?>";"?>=";"??"]
137
let shift_funs = ["sll";"srl";"sla";"sra";"rol";"ror"]
138

  
139
type vhdl_sequential_stmt_t = 
140
  | VarAssign of { label: vhdl_name_t [@default NoName]; lhs: vhdl_name_t; rhs: vhdl_expr_t } [@name "VARIABLE_ASSIGNMENT_STATEMENT"]
141
  | SigSeqAssign of { label: vhdl_name_t [@default NoName]; lhs: vhdl_name_t; rhs: vhdl_expr_t list} [@name "SIGNAL_ASSIGNMENT_STATEMENT"]
142
  | If of { label: vhdl_name_t [@default NoName]; if_cases: vhdl_if_case_t list;
143
    default: vhdl_sequential_stmt_t list [@default []]; } [@name "IF_STATEMENT"]
144
  | Case of { label: vhdl_name_t [@default NoName]; guard: vhdl_expr_t; branches: vhdl_case_item_t list } [@name "CASE_STATEMENT_TREE"]
145
  | Exit of { label: vhdl_name_t [@default NoName]; loop_label: string option [@default Some ""]; condition: vhdl_expr_t option [@default Some IsNull]} [@name "EXIT_STATEMENT"]
146
  | Assert of { label: vhdl_name_t [@default NoName]; cond: vhdl_expr_t; report: vhdl_expr_t [@default IsNull]; severity: vhdl_expr_t [@default IsNull]} [@name "ASSERTION_STATEMENT"]
147
  | Wait [@name "WAIT_STATEMENT"]
148
  | Null of { label: vhdl_name_t [@default NoName]} [@name "NULL_STATEMENT"]
149
  | Return of { label: vhdl_name_t [@default NoName]} [@name "RETURN_STATEMENT"]
150
and vhdl_if_case_t = 
151
  {
152
    if_cond: vhdl_expr_t;
153
    if_block: vhdl_sequential_stmt_t list;
154
  }
155
and vhdl_case_item_t = 
156
  {
157
    when_cond: vhdl_expr_t list;
158
    when_stmt: vhdl_sequential_stmt_t list;
159
  }
160
[@@deriving yojson {strict = false}];;
161

  
162
type vhdl_declaration_t =
163
  | VarDecl of {
164
      names : vhdl_name_t list; 
165
      typ : vhdl_subtype_indication_t; 
166
      init_val : cst_val_t option [@default Some (CstInt (0))] 
167
    } [@name "VARIABLE_DECLARATION"]
168
  | CstDecl of { 
169
      names : vhdl_name_t list; 
170
      typ : vhdl_subtype_indication_t; 
171
      init_val : cst_val_t 
172
    } [@name "CONSTANT_DECLARATION"]
173
  | SigDecl of { 
174
      names : vhdl_name_t list; 
175
      typ : vhdl_subtype_indication_t; 
176
      init_val : cst_val_t option [@default Some (CstInt (0))] 
177
    } [@name "SIGNAL_DECLARATION"]
178
  | Subprogram of {
179
      name: vhdl_name_t [@default NoName]; 
180
      kind: string [@default ""]; 
181
      spec: vhdl_subprogram_spec_t [@default {name="";typeMark=NoName;parameters=[];isPure=false}]; 
182
      decl_part: vhdl_declaration_t list [@default []]; 
183
      stmts: vhdl_sequential_stmt_t list [@default []]
184
    } [@name "SUBPROGRAM_BODY"]
185
[@@deriving yojson {strict = false}];;
186

  
187
type signal_condition_t =
188
  {                            
189
    expr: vhdl_expr_t list;              (* when expression *)
190
    cond: vhdl_expr_t [@default IsNull];  (* optional else case expression. 
191
                                             If None, could be a latch  *)
192
  }
193
[@@deriving yojson {strict = false}];;
194

  
195
type signal_selection_t =
196
  {
197
    expr : vhdl_expr_t;
198
    when_sel: vhdl_expr_t list [@default []];
199
  }
200
[@@deriving yojson {strict = false}];;
201

  
202
type conditional_signal_t =
203
  {
204
    postponed: bool [@default false];
205
    label: vhdl_name_t [@default NoName];
206
    lhs: vhdl_name_t;        (* assigned signal = target*)
207
    rhs: signal_condition_t list;                   (* expression *)
208
    cond: vhdl_expr_t [@default IsNull];
209
    delay: vhdl_expr_t [@default IsNull];
210
  }
211
[@@deriving yojson {strict = false}];;
212

  
213
type process_t =
214
  { 
215
    id: vhdl_name_t [@default NoName];
216
    declarations: vhdl_declaration_t list option [@key "PROCESS_DECLARATIVE_PART"] [@default Some []];
217
    active_sigs: vhdl_name_t list [@default []];
218
    body: vhdl_sequential_stmt_t list [@key "PROCESS_STATEMENT_PART"] [@default []]
219
  }
220
[@@deriving yojson {strict = false}];;
221

  
222
type selected_signal_t = 
223
  { 
224
    postponed: bool [@default false];
225
    label: vhdl_name_t [@default NoName];
226
    lhs: vhdl_name_t;      (* assigned signal = target *)
227
    sel: vhdl_expr_t;  
228
    branches: signal_selection_t list [@default []];
229
    delay: vhdl_expr_t option;
230
  }
231
[@@deriving yojson {strict = false}];;
232
			   
233
type vhdl_concurrent_stmt_t =
234
  | SigAssign of conditional_signal_t [@name "CONDITIONAL_SIGNAL_ASSIGNMENT"]
235
  | Process of process_t [@name "PROCESS_STATEMENT"]
236
  | SelectedSig of selected_signal_t [@name "SELECTED_SIGNAL_ASSIGNMENT"]
237
[@@deriving yojson {strict = false}];;
238
  (*
239
type vhdl_statement_t =
240
  
241
  (* | DeclarationStmt of declaration_stmt_t *)
242
  | ConcurrentStmt of vhdl_concurrent_stmt_t
243
  | SequentialStmt of vhdl_sequential_stmt_t
244
   *)
245
		     
246
(************************************************************************************)		   
247
(*                     Entities                                                     *)
248
(************************************************************************************)		   
249
			     
250
type vhdl_port_mode_t = 
251
    InPort     [@name "in"]
252
  | OutPort    [@name "out"]
253
  | InoutPort  [@name "inout"]
254
  | BufferPort [@name "buffer"]
255
[@@deriving yojson];;
256
	     
257
type vhdl_port_t =
258
  {
259
    names: vhdl_name_t list [@default []];
260
    mode: vhdl_port_mode_t [@default InPort];
261
    typ: vhdl_subtype_indication_t;
262
    expr: vhdl_expr_t [@default IsNull];
263
  }
264
[@@deriving yojson {strict = false}];;
265

  
266
type vhdl_entity_t =
267
  {
268
    name: vhdl_name_t [@default NoName];
269
    generics: vhdl_port_t list [@default []];
270
    ports: vhdl_port_t list [@default []];
271
    declaration: vhdl_declaration_t list [@key "ENTITY_DECLARATIVE_PART"] [@default []];
272
    stmts: vhdl_concurrent_stmt_t list [@key "ENTITY_STATEMENT_PART"] [@default []]; 
273
  }
274
[@@deriving yojson {strict = false}];;
275

  
276
(************************************************************************************)		   
277
(*                    Packages / Library loading                                    *)
278
(************************************************************************************)		   
279
				
280
(* Optional. Describes shared definitions *)
281
type vhdl_package_t =
282
  {
283
    name: vhdl_name_t [@default NoName];
284
    shared_defs: vhdl_definition_t list [@default []];
285
  }
286
[@@deriving yojson {strict = false}];;
287

  
288
type vhdl_load_t = 
289
    Library of vhdl_name_t list [@name "LIBRARY_CLAUSE"] [@default []]
290
  | Use of vhdl_name_t list [@name "USE_CLAUSE"] [@default []]
291
[@@deriving yojson];;
292

  
293
(************************************************************************************)		   
294
(*                        Architecture / VHDL Design                                *)
295
(************************************************************************************)		   
296
				       
297
type vhdl_architecture_t =
298
  {
299
    name: vhdl_name_t [@default NoName];
300
    entity: vhdl_name_t [@default NoName];
301
    declarations: vhdl_declaration_t list [@key "ARCHITECTURE_DECLARATIVE_PART"] [@default []];
302
    body: vhdl_concurrent_stmt_t list [@key "ARCHITECTURE_STATEMENT_PART"] [@default []]; 
303
  }
304
[@@deriving yojson {strict = false}];;
305
    
306
(* TODO. Configuration is optional *)
307
type vhdl_configuration_t = unit
308
[@@deriving yojson {strict = false}];;
309

  
310
type vhdl_library_unit_t = (* TODO: PACKAGE_BODY *)
311
    Package of vhdl_package_t [@name "PACKAGE_DECLARATION"]
312
  | Entities of vhdl_entity_t [@name "ENTITY_DECLARATION"]
313
  | Architecture of vhdl_architecture_t [@name "ARCHITECTURE_BODY"]
314
  | Configuration of vhdl_configuration_t [@name "CONFIGURATION_DECLARATION"]
315
[@@deriving yojson {strict = false}];;
316

  
317
type vhdl_design_unit_t =
318
  {
319
    contexts: vhdl_load_t list [@default []];
320
    library: vhdl_library_unit_t;
321
  }
322
[@@deriving yojson {strict = false}];;
323

  
324
type vhdl_design_file_t =
325
  {
326
    design_units: vhdl_design_unit_t list [@default []];
327
  }
328
[@@deriving yojson {strict = false}];;
329

  
330
type vhdl_file_t = 
331
  {
332
    design_file: vhdl_design_file_t [@default {design_units=[]}] [@key "DESIGN_FILE"];
333
  }
334
[@@deriving yojson];;
src/tools/importer/vhdl_deriving_yojson.ml
1
let base_types = ["integer"; "character"; "bit"; "real"; "natural"; "positive"; "std_logic"; "std_logic_vector" ]
2

  
3
type vhdl_type_t =
4
  | Base of string
5
  | Range of string option * int * int [@name "RANGE_WITH_DIRECTION"]
6
  | Bit_vector of int * int
7
  | Array of int * int * vhdl_type_t
8
  | Enumerated of string list
9
  | Void
10
[@@deriving yojson];;
11
  
12
(************************************************************************************)		   
13
(*                     Constants                                                    *)
14
(************************************************************************************)		   
15

  
16
(* Std_logic values :
17
    'U': uninitialized. This signal hasn't been set yet.
18
    'X': unknown. Impossible to determine this value/result.
19
    '0': logic 0
20
    '1': logic 1
21
    'Z': High Impedance
22
    'W': Weak signal, can't tell if it should be 0 or 1.
23
    'L': Weak signal that should probably go to 0
24
    'H': Weak signal that should probably go to 1
25
    '-': Don't care. *)			       
26
let std_logic_cst = ["U"; "X"; "0"; "1"; "Z"; "W"; "L"; "H"; "-" ]
27
let literal_base = ["B"; "O"; "X"; "UB"; "UO"; "UX"; "SB"; "SO"; "SX"; "D"] (* Prefix of CstLiteral *)
28

  
29
(* TODO: do we need more constructors ? *)
30
type cst_val_t = 
31
    CstInt of int 
32
  | CstStdLogic of string
33
  | CstLiteral of string [@name "CST_LITERAL"]
34
[@@deriving yojson {strict = false}];;
35

  
36
type vhdl_subtype_indication_t =
37
  {
38
    name : string;
39
    definition: vhdl_type_t option [@default Some (Void)];
40
  }
41
[@@deriving yojson {strict = false}];;
42

  
43
(* TODO ? Shall we merge definition / declaration  *)
44
type vhdl_definition_t =
45
  | Type of {name : string ; definition: vhdl_type_t} [@name "TYPE_DECLARATION"]
46
  | Subtype of {name : string ; typ : vhdl_subtype_indication_t} [@name "SUBTYPE_DECLARATION"]
47
[@@deriving yojson {strict = false}];;
48

  
49
type vhdl_parameter_t =
50
  {
51
    names: string list;
52
    mode: string [@default ""];
53
    typ: vhdl_subtype_indication_t;
54
    init_val: cst_val_t option [@default Some (CstInt (0))];
55
  }
56
[@@deriving yojson {strict = false}];;
57

  
58
type vhdl_subprogram_spec_t =
59
  {
60
    name: string [@default ""];
61
    typeMark: string [@default ""];
62
    parameters: vhdl_parameter_t list;
63
    isPure: bool [@default false];
64
  }
65
[@@deriving yojson {strict = false}];;
66

  
67
(************************************************************************************)		   
68
(*            Attributes for types, arrays, signals and strings                     *)
69
(************************************************************************************)		   
70

  
71
type 'basetype vhdl_type_attributes_t =
72
  | TAttNoArg of { id: string }
73
  | TAttIntArg of { id: string; arg: int }
74
  | TAttValArg of { id: string; arg: 'basetype }
75
  | TAttStringArg of { id: string; arg: string }
76
[@@deriving yojson {strict = false}];;
77

  
78
let typ_att_noarg = ["base"; "left"; "right"; "high"; "low"]
79
let typ_att_intarg = ["pos"; "val"; "succ"; "pred"; "leftof"; "rightof"]
80
let typ_att_valarg = ["image"]
81
let typ_att_stringarg = ["value"]
82
  
83
type vhdl_array_attributes_t = AAttInt of { id: string; arg: int; } | AAttAscending
84
[@@deriving yojson {strict = false}];;
85

  
86
let array_att_intarg = ["left"; "right"; "high"; "low"; "range"; "reverse_range"; "length"]  
87

  
88
type vhdl_signal_attributes_t = SigAtt of string
89
[@@deriving yojson {strict = false}];;
90

  
91
type vhdl_string_attributes_t = StringAtt of string
92
[@@deriving yojson {strict = false}];;
93

  
94
(************************************************************************************)		   
95
(*                        Expressions  / Statements                                 *)
96
(************************************************************************************)		   
97
type suffix_selection_t = Idx of int | Range of int * int
98
[@@deriving yojson {strict = false}];;
99

  
100
type vhdl_expr_t =
101
  | Call of vhdl_name_t [@name "CALL"]
102
  | Cst of cst_val_t [@name "CONSTANT_VALUE"]
103
  | Op of { id: string [@default ""]; args: vhdl_expr_t list [@default []]} [@name "EXPRESSION"]
104
  | IsNull [@name "IsNull"]
105
  | Time of { value: int; phy_unit: string [@default ""]}
106
  | Sig of { name: string; att: vhdl_signal_attributes_t option }
107
  | SuffixMod of { expr : vhdl_expr_t; selection : suffix_selection_t }
108
  | Aggregate of { elems : vhdl_element_assoc_t list } [@name "AGGREGATE"]
109
  | Others [@name "OTHERS"]
110
[@@deriving yojson {strict = false}]
111
and					     
112
vhdl_name_t =
113
  | Simple of string [@name "SIMPLE_NAME"]
114
  | Selected of vhdl_name_t list [@name "SELECTED_NAME"]
115
  | Index of { id: vhdl_name_t; exprs: vhdl_expr_t list } [@name "INDEXED_NAME"]
116
  | Slice of { id: vhdl_name_t; range: vhdl_type_t } [@name "SLICE_NAME"]
117
  | Attribute of { id: vhdl_name_t; designator: vhdl_name_t; expr: vhdl_expr_t [@default IsNull]} [@name "ATTRIBUTE_NAME"]
118
  | Function of { id: vhdl_name_t; assoc_list: vhdl_assoc_element_t list } [@name "FUNCTION_CALL"]
119
  | NoName
120
[@@deriving yojson {strict = false}]
121
and vhdl_assoc_element_t =
122
  {
123
    formal_name: vhdl_name_t option [@default Some NoName];
124
    formal_arg: vhdl_name_t option [@default Some NoName];
125
    actual_name: vhdl_name_t option [@default Some NoName];
126
    actual_designator: vhdl_name_t option [@default Some NoName];
127
    actual_expr: vhdl_expr_t option [@default Some IsNull];
128
  }
129
[@@deriving yojson {strict = false}]
130
and vhdl_element_assoc_t =
131
  {
132
    choices: vhdl_expr_t list;
133
    expr: vhdl_expr_t;
134
  }
135
[@@deriving yojson {strict = false}];;
136

  
137
let arith_funs = ["+";"-";"*";"/";"mod"; "rem";"abs";"**";"&"]
138
let bool_funs  = ["and"; "or"; "nand"; "nor"; "xor"; "not"]
139
let rel_funs   = ["<";">";"<=";">=";"/=";"=";"?=";"?/=";"?<";"?<=";"?>";"?>=";"??"]
140
let shift_funs = ["sll";"srl";"sla";"sra";"rol";"ror"]
141

  
142
type vhdl_sequential_stmt_t = 
143
  | VarAssign of { label: string [@default ""]; lhs: vhdl_name_t; rhs: vhdl_expr_t } [@name "VARIABLE_ASSIGNMENT_STATEMENT"]
144
  | SigSeqAssign of { label: string [@default ""]; lhs: vhdl_name_t; rhs: vhdl_expr_t list} [@name "SIGNAL_ASSIGNMENT_STATEMENT"]
145
  | If of { label: string [@default ""]; if_cases: vhdl_if_case_t list;
146
    default: vhdl_sequential_stmt_t list [@default []]; } [@name "IF_STATEMENT"]
147
  | Case of { guard: vhdl_expr_t; branches: vhdl_case_item_t list } [@name "CASE_STATEMENT_TREE"]
148
  | Exit of { label: string [@default ""]; loop_label: string option [@default Some ""]; condition: vhdl_expr_t option [@default Some IsNull]} [@name "EXIT_STATEMENT"]
149
  | Assert of { label: string [@default ""]; cond: vhdl_expr_t; report: vhdl_expr_t [@default IsNull]; severity: vhdl_expr_t [@default IsNull]} [@name "ASSERTION_STATEMENT"]
150
  | Wait [@name "WAIT_STATEMENT"]
151
  | Null of { label: string [@default ""]} [@name "NULL_STATEMENT"]
152
and vhdl_if_case_t = 
153
  {
154
    if_cond: vhdl_expr_t;
155
    if_block: vhdl_sequential_stmt_t list;
156
  }
157
and vhdl_case_item_t = 
158
  {
159
    when_cond: vhdl_expr_t list;
160
    when_stmt: vhdl_sequential_stmt_t list;
161
  }
162
[@@deriving yojson {strict = false}];;
163

  
164
type vhdl_declaration_t =
165
  | VarDecl of { names : string list; typ : vhdl_subtype_indication_t; init_val : cst_val_t option [@default Some (CstInt (0))] } [@name "VARIABLE_DECLARATION"]
166
  | CstDecl of { names : string list; typ : vhdl_subtype_indication_t; init_val : cst_val_t  } [@name "CONSTANT_DECLARATION"]
167
  | SigDecl of { names : string list; typ : vhdl_subtype_indication_t; init_val : cst_val_t option [@default Some (CstInt (0))] } [@name "SIGNAL_DECLARATION"]
168
  | Subprogram of {name: string; kind: string; spec: vhdl_subprogram_spec_t ; decl_part: vhdl_declaration_t list; stmts: vhdl_sequential_stmt_t list} [@name "SUBPROGRAM_BODY"]
169
[@@deriving yojson {strict = false}];;
170
		    
171
type signal_condition_t =
172
  {                            
173
    expr: vhdl_expr_t list;              (* when expression *)
174
    cond: vhdl_expr_t [@default IsNull];  (* optional else case expression. 
175
                                             If None, could be a latch  *)
176
  }
177
[@@deriving yojson {strict = false}];;
178

  
179
type signal_selection_t =
180
  {
181
    expr : vhdl_expr_t;
182
    when_sel: vhdl_expr_t list [@default []];
183
  }
184
[@@deriving yojson {strict = false}];;
185

  
186
type conditional_signal_t =
187
  {
188
    postponed: bool [@default false];
189
    label: string option [@default Some ""];
190
    lhs: vhdl_name_t;        (* assigned signal = target*)
191
    rhs: signal_condition_t list;                   (* expression *)
192
    cond: vhdl_expr_t [@default IsNull];
193
    delay: vhdl_expr_t [@default IsNull];
194
  }
195
[@@deriving yojson {strict = false}];;
196

  
197
type process_t =
198
  { 
199
    id: string option [@default Some ""];
200
    declarations: vhdl_declaration_t list option [@key "PROCESS_DECLARATIVE_PART"] [@default Some []];
201
    active_sigs: vhdl_name_t list [@default []];
202
    body: vhdl_sequential_stmt_t list [@key "PROCESS_STATEMENT_PART"] [@default []]
203
  }
204
[@@deriving yojson {strict = false}];;
205

  
206
type selected_signal_t = 
207
  { 
208
    postponed: bool [@default false];
209
    label: string option [@default Some ""];
210
    lhs: vhdl_name_t;      (* assigned signal = target *)
211
    sel: vhdl_expr_t;  
212
    branches: signal_selection_t list [@default []];
213
    delay: vhdl_expr_t option;
214
  }
215
[@@deriving yojson {strict = false}];;
216
			   
217
type vhdl_concurrent_stmt_t =
218
  | SigAssign of conditional_signal_t [@name "CONDITIONAL_SIGNAL_ASSIGNMENT"]
219
  | Process of process_t [@name "PROCESS_STATEMENT"]
220
  | SelectedSig of selected_signal_t [@name "SELECTED_SIGNAL_ASSIGNMENT"]
221
[@@deriving yojson {strict = false}];;
222
  (*
223
type vhdl_statement_t =
224
  
225
  (* | DeclarationStmt of declaration_stmt_t *)
226
  | ConcurrentStmt of vhdl_concurrent_stmt_t
227
  | SequentialStmt of vhdl_sequential_stmt_t
228
   *)
229
		     
230
(************************************************************************************)		   
231
(*                     Entities                                                     *)
232
(************************************************************************************)		   
233
			     
234
(* TODO? Seems to appear optionally in entities *)
235
type vhdl_generic_t = unit
236
[@@deriving yojson {strict = false}];;
237
			      
238
type vhdl_port_kind_t = 
239
    InPort     [@name "in"]
240
  | OutPort    [@name "out"]
241
  | InoutPort  [@name "inout"]
242
  | BufferPort [@name "buffer"]
243
[@@deriving yojson];;
244
	     
245
type vhdl_port_t =
246
  {
247
    names: string list [@default []];
248
    kind: vhdl_port_kind_t;
249
    typ : string;
250
(*    typ: vhdl_type_t; *)
251
  }
252
[@@deriving yojson {strict = false}];;
253

  
254
type vhdl_entity_t =
255
  {
256
    name: string [@default ""];
257
    generics: vhdl_generic_t list option [@key "GENERIC_CLAUSE"] [@default Some []];
258
    ports: vhdl_port_t list [@key "PORT_CLAUSE"] [@default []];
259
  }
260
[@@deriving yojson {strict = false}];;
261

  
262
(************************************************************************************)		   
263
(*                    Packages / Library loading                                    *)
264
(************************************************************************************)		   
265
				
266
(* Optional. Describes shared definitions *)
267
type vhdl_package_t =
268
  {
269
    name: string [@default ""];
270
    shared_defs: vhdl_definition_t list [@default []];
271
  }
272
[@@deriving yojson {strict = false}];;
273

  
274
type vhdl_load_t = 
275
    Library of string list [@name "LIBRARY_CLAUSE"] [@default ""]
276
  | Use of string list [@name "USE_CLAUSE"] [@default []]
277
[@@deriving yojson];;
278

  
279
(************************************************************************************)		   
280
(*                        Architecture / VHDL Design                                *)
281
(************************************************************************************)		   
282
				       
283
type vhdl_architecture_t =
284
  {
285
    name: string [@default ""];
286
    entity: string [@default ""];
287
    declarations: vhdl_declaration_t list option [@key "ARCHITECTURE_DECLARATIVE_PART"] [@default Some []];
288
    body: vhdl_concurrent_stmt_t list option [@key "ARCHITECTURE_STATEMENT_PART"] [@default Some []]; 
289
  }
290
[@@deriving yojson {strict = false}];;
291
    
292
(* TODO. Configuration is optional *)
293
type vhdl_configuration_t = unit
294
[@@deriving yojson {strict = false}];;
295

  
296
type vhdl_design_t =
297
  {
298
    packages: vhdl_package_t list [@key "PACKAGE_DECLARATION"] [@default []];
299
    libraries: vhdl_load_t list option [@key "CONTEXT_CLAUSE"] [@default Some []];
300
    entities: vhdl_entity_t list [@key "ENTITY_DECLARATION"] [@default []];
301
    architectures: vhdl_architecture_t list [@key "ARCHITECTURE_BODY"] [@default []];
302
    configuration: vhdl_configuration_t option [@key "CONFIGURATION_DECLARATION"] [@default Some ()];
303
  }
304
[@@deriving yojson {strict = false}];;
305

  
306
type vhdl_design_file_t =
307
  {
308
    design_unit: vhdl_design_t list [@key "DESIGN_UNIT"] [@default []];
309
  }
310
[@@deriving yojson {strict = false}];;
311

  
312
type vhdl_file_t = 
313
  {
314
    design_file: vhdl_design_file_t [@key "DESIGN_FILE"];
315
  }
316
[@@deriving yojson];;

Also available in: Unified diff