Project

General

Profile

Revision 6d3b5007 src/backends/VHDL/vhdl_ast_deriving.ml

View differences:

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

Also available in: Unified diff