Revision 6d3b5007
Added by Arnaud Dieumegard about 5 years ago
| src/backends/VHDL/vhdl_ast.ml | ||
|---|---|---|
| 163 | 163 |
| Case of { label: vhdl_name_t [@default NoName]; guard: vhdl_expr_t; branches: vhdl_case_item_t list } [@name "CASE_STATEMENT_TREE"]
|
| 164 | 164 |
| 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"]
|
| 165 | 165 |
| 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"]
|
| 166 |
| ProcedureCall of { label: vhdl_name_t [@default NoName]; name: vhdl_name_t; assocs: vhdl_assoc_element_t list } [@name "PROCEDURE_CALL_STATEMENT"]
|
|
| 166 | 167 |
| Wait [@name "WAIT_STATEMENT"] |
| 167 | 168 |
| Null of { label: vhdl_name_t [@default NoName]} [@name "NULL_STATEMENT"]
|
| 168 | 169 |
| Return of { label: vhdl_name_t [@default NoName]} [@name "RETURN_STATEMENT"]
|
| src/backends/VHDL/vhdl_ast_deriving.ml | ||
|---|---|---|
| 2630 | 2630 |
cond: vhdl_expr_t ; |
| 2631 | 2631 |
report: vhdl_expr_t [@default IsNull]; |
| 2632 | 2632 |
severity: vhdl_expr_t [@default IsNull]} [@name "ASSERTION_STATEMENT"] |
| 2633 |
| ProcedureCall of |
|
| 2634 |
{
|
|
| 2635 |
label: vhdl_name_t [@default NoName]; |
|
| 2636 |
name: vhdl_name_t ; |
|
| 2637 |
assocs: vhdl_assoc_element_t list } [@name "PROCEDURE_CALL_STATEMENT"] |
|
| 2633 | 2638 |
| Wait [@name "WAIT_STATEMENT"] |
| 2634 | 2639 |
| Null of {
|
| 2635 | 2640 |
label: vhdl_name_t [@default NoName]} [@name "NULL_STATEMENT"] |
| ... | ... | |
| 2644 | 2649 |
when_cond: vhdl_expr_t list ; |
| 2645 | 2650 |
when_stmt: vhdl_sequential_stmt_t list } |
| 2646 | 2651 |
|
| 2647 |
(* TODO Adapt for: Assert *) |
|
| 2652 |
(* TODO Adapt for: Assert, ProcedureCall *)
|
|
| 2648 | 2653 |
let rec pp_vhdl_sequential_stmt_t : |
| 2649 | 2654 |
Format.formatter -> vhdl_sequential_stmt_t -> Ppx_deriving_runtime.unit = |
| 2650 |
let __19 () = pp_vhdl_name_t |
|
| 2655 |
let __22 () = pp_vhdl_name_t |
|
| 2656 |
|
|
| 2657 |
and __21 () = pp_vhdl_name_t |
|
| 2658 |
|
|
| 2659 |
and __20 () = pp_vhdl_assoc_element_t |
|
| 2660 |
|
|
| 2661 |
and __19 () = pp_vhdl_name_t |
|
| 2651 | 2662 |
|
| 2652 | 2663 |
and __18 () = pp_vhdl_name_t |
| 2653 | 2664 |
|
| ... | ... | |
| 2820 | 2831 |
((__17 ()) fmt) aseverity; |
| 2821 | 2832 |
Format.fprintf fmt "@]"); |
| 2822 | 2833 |
Format.fprintf fmt "@]}") |
| 2834 |
| ProcedureCall { label = alabel; name = aname; assocs = aassocs } ->
|
|
| 2835 |
(match alabel with |
|
| 2836 |
| NoName -> Format.fprintf fmt ""; |
|
| 2837 |
| _ -> (((__18 ()) fmt) alabel; |
|
| 2838 |
Format.fprintf fmt ":@ ") |
|
| 2839 |
); |
|
| 2840 |
((__19 ()) fmt) aname; |
|
| 2841 |
((fun x -> |
|
| 2842 |
Format.fprintf fmt "(";
|
|
| 2843 |
ignore |
|
| 2844 |
(List.fold_left |
|
| 2845 |
(fun sep -> |
|
| 2846 |
fun x -> |
|
| 2847 |
if sep then Format.fprintf fmt ",@ "; |
|
| 2848 |
((__20 ()) fmt) x; |
|
| 2849 |
true) false x); |
|
| 2850 |
Format.fprintf fmt ")")) aassocs; |
|
| 2823 | 2851 |
| Wait -> Format.pp_print_string fmt "wait" |
| 2824 | 2852 |
| Null { label = alabel } ->
|
| 2825 | 2853 |
(match alabel with |
| ... | ... | |
| 3068 | 3096 |
:: fields |
| 3069 | 3097 |
in |
| 3070 | 3098 |
`Assoc fields)] |
| 3099 |
| ProcedureCall arg0 -> |
|
| 3100 |
`List |
|
| 3101 |
[`String "PROCEDURE_CALL_STATEMENT"; |
|
| 3102 |
(let fields = [] in |
|
| 3103 |
let fields = |
|
| 3104 |
("assocs",
|
|
| 3105 |
((fun x -> |
|
| 3106 |
`List |
|
| 3107 |
(List.map (fun x -> vhdl_assoc_element_t_to_yojson x) |
|
| 3108 |
x)) arg0.assocs)) |
|
| 3109 |
:: fields in |
|
| 3110 |
let fields = |
|
| 3111 |
("name", ((fun x -> vhdl_name_t_to_yojson x) arg0.name)) ::
|
|
| 3112 |
fields in |
|
| 3113 |
let fields = |
|
| 3114 |
if arg0.label = NoName |
|
| 3115 |
then fields |
|
| 3116 |
else |
|
| 3117 |
("label",
|
|
| 3118 |
(((fun x -> vhdl_name_t_to_yojson x)) arg0.label)) |
|
| 3119 |
:: fields |
|
| 3120 |
in |
|
| 3121 |
`Assoc fields)] |
|
| 3071 | 3122 |
| Wait -> `List [`String "WAIT_STATEMENT"] |
| 3072 | 3123 |
| Null arg0 -> |
| 3073 | 3124 |
`List |
| ... | ... | |
| 3367 | 3418 |
(Result.Error "Vhdl_ast.vhdl_sequential_stmt_t.cond"), |
| 3368 | 3419 |
(Result.Ok IsNull), (Result.Ok IsNull)) |
| 3369 | 3420 |
| _ -> Result.Error "Vhdl_ast.vhdl_sequential_stmt_t")) arg0 |
| 3421 |
| `List ((`String "PROCEDURE_CALL_STATEMENT")::arg0::[]) -> |
|
| 3422 |
((function |
|
| 3423 |
| `Assoc xs -> |
|
| 3424 |
let rec loop xs ((arg0,arg1,arg2) as _state) = |
|
| 3425 |
match xs with |
|
| 3426 |
| ("label",x)::xs ->
|
|
| 3427 |
loop xs |
|
| 3428 |
(((fun x -> vhdl_name_t_of_yojson x) x), arg1, arg2) |
|
| 3429 |
| ("name",x)::xs ->
|
|
| 3430 |
loop xs |
|
| 3431 |
(arg0, ((fun x -> vhdl_name_t_of_yojson x) x), arg2) |
|
| 3432 |
| ("assocs",x)::xs ->
|
|
| 3433 |
loop xs |
|
| 3434 |
(arg0, arg1, |
|
| 3435 |
((function |
|
| 3436 |
| `List xs -> |
|
| 3437 |
map_bind |
|
| 3438 |
(fun x -> vhdl_assoc_element_t_of_yojson x) |
|
| 3439 |
[] xs |
|
| 3440 |
| _ -> |
|
| 3441 |
Result.Error |
|
| 3442 |
"Vhdl_ast.vhdl_sequential_stmt_t.assocs") x)) |
|
| 3443 |
| [] -> |
|
| 3444 |
arg2 >>= |
|
| 3445 |
((fun arg2 -> |
|
| 3446 |
arg1 >>= |
|
| 3447 |
(fun arg1 -> |
|
| 3448 |
arg0 >>= |
|
| 3449 |
(fun arg0 -> |
|
| 3450 |
Result.Ok |
|
| 3451 |
(ProcedureCall |
|
| 3452 |
{
|
|
| 3453 |
label = arg0; |
|
| 3454 |
name = arg1; |
|
| 3455 |
assocs = arg2 |
|
| 3456 |
}))))) |
|
| 3457 |
| _::xs -> loop xs _state in |
|
| 3458 |
loop xs |
|
| 3459 |
((Result.Ok NoName), |
|
| 3460 |
(Result.Error "Vhdl_ast.vhdl_sequential_stmt_t.name"), |
|
| 3461 |
(Result.Error "Vhdl_ast.vhdl_sequential_stmt_t.assocs")) |
|
| 3462 |
| _ -> Result.Error "Vhdl_ast.vhdl_sequential_stmt_t")) arg0 |
|
| 3370 | 3463 |
| `List ((`String "WAIT_STATEMENT")::[]) -> Result.Ok Wait |
| 3371 | 3464 |
| `List ((`String "NULL_STATEMENT")::arg0::[]) -> |
| 3372 | 3465 |
((function |
| src/backends/VHDL/vhdl_ast_map.ml | ||
|---|---|---|
| 313 | 313 |
let report = self#vhdl_expr_t report in |
| 314 | 314 |
let severity = self#vhdl_expr_t severity in |
| 315 | 315 |
Assert { label; cond; report; severity }
|
| 316 |
| ProcedureCall { label; name; assocs } ->
|
|
| 317 |
let label = self#vhdl_name_t label in |
|
| 318 |
let name = self#vhdl_name_t name in |
|
| 319 |
let assocs = self#list self#vhdl_assoc_element_t assocs in |
|
| 320 |
ProcedureCall { label; name; assocs }
|
|
| 316 | 321 |
| Wait -> Wait |
| 317 | 322 |
| Null { label } ->
|
| 318 | 323 |
let label = self#vhdl_name_t label in Null { label }
|
| src/tools/importer/main_lustre_importer.ml | ||
|---|---|---|
| 43 | 43 |
(* Printers.pp_prog std_formatter program; *) |
| 44 | 44 |
|
| 45 | 45 |
| Error e -> Format.printf "Error: %s\n" e; |
| 46 |
|
|
| src/tools/importer/vhdl_to_lustre.ml | ||
|---|---|---|
| 315 | 315 |
let report = self#vhdl_expr_t report in |
| 316 | 316 |
let severity = self#vhdl_expr_t severity in |
| 317 | 317 |
Assert { label; cond; report; severity }
|
| 318 |
| ProcedureCall { label; name; assocs } ->
|
|
| 319 |
let label = self#vhdl_name_t label in |
|
| 320 |
let name = self#vhdl_name_t name in |
|
| 321 |
let assocs = self#list self#vhdl_assoc_element_t assocs in |
|
| 322 |
ProcedureCall { label; name; assocs }
|
|
| 318 | 323 |
| Wait -> Wait |
| 319 | 324 |
| Null { label } ->
|
| 320 | 325 |
let label = self#vhdl_name_t label in Null { label }
|
Also available in: Unified diff
Added support for ProcedureCall statements