Project

General

Profile

Revision 6d3b5007

View differences:

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