Project

General

Profile

« Previous | Next » 

Revision b0c77300

Added by Arnaud Dieumegard over 3 years ago

PP update: component instantiation type, archi format, port & generic decl in components, signal conditions, return statements expression

View differences:

src/backends/VHDL/vhdl_ast_deriving.ml
250 250
                (List.fold_left
251 251
                  (fun sep  ->
252 252
                    fun x  ->
253
                      if sep then Format.fprintf fmt ";@;";
253
                      if sep then ();
254 254
                        ((__3 ()) fmt) x;
255
                        Format.fprintf fmt ";@;";
255 256
                        true) false x);
256
              Format.fprintf fmt "@]@;end record") a0;
257
              Format.fprintf fmt "@]end record") a0;
257 258
        | Enumerated a0 ->
258 259
            (Format.fprintf fmt "(";
259 260
            ((fun x  ->
......
286 287
                  (List.fold_left
287 288
                     (fun sep  ->
288 289
                        fun x  ->
289
                          if sep then Format.fprintf fmt ",@ ";
290
                          if sep then Format.fprintf fmt ", ";
290 291
                          ((__0 ()) fmt) x;
291 292
                          true) false x)) x.names;
292
           Format.fprintf fmt ":@ ";
293
           Format.fprintf fmt ": ";
293 294
           ((__1 ()) fmt) x.definition)
294 295
    [@ocaml.warning "-A"])
295 296

  
......
485 486
            | hd::[] ->
486 487
               (Format.fprintf fmt "%s") aid;
487 488
               ((__3 ()) fmt) hd
488
            | hd::(hd2::[]) -> 
489
            | hd::(hd2::[]) ->
490
               Format.fprintf fmt "(";
489 491
               ((__3 ()) fmt) hd;
490 492
               (Format.fprintf fmt " %s ") aid;
491
               ((__3 ()) fmt) hd2
493
               ((__3 ()) fmt) hd2;
494
               Format.fprintf fmt ")"
492 495
            | _ ->
493 496
            (Format.fprintf fmt "@[<2>Op {@,";
494 497
             ((Format.fprintf fmt "@[%s =@ " "id";
......
580 583
              (match aexpression with
581 584
              | None  -> Format.pp_print_string fmt ""
582 585
              | Some x ->
583
                  ((__11 ()) fmt) x;);
586
                  Format.fprintf fmt "(@[<v>";
587
                  ((__11 ()) fmt) x;
588
                  Format.fprintf fmt ")@]");
584 589
        | Others  -> Format.pp_print_string fmt "others")
585 590
    [@ocaml.warning "-A"])
586 591

  
......
663 668
                (List.fold_left
664 669
                   (fun sep  ->
665 670
                      fun x  ->
666
                        if sep then Format.fprintf fmt ";@ ";
671
                        if sep then Format.fprintf fmt ",@ ";
667 672
                        ((__9 ()) fmt) x;
668 673
                        true) false x);
669 674
            Format.fprintf fmt "@]")) aassoc_list;
......
2669 2674
                     if sep then Format.fprintf fmt ", ";
2670 2675
                       ((__0 ()) fmt) x;
2671 2676
                       true) false x))) x.names;
2677
          Format.fprintf fmt ": ";
2672 2678
          ((fun x  ->
2673 2679
             ignore
2674 2680
               (List.fold_left
2675 2681
                 (fun sep  ->
2676 2682
                   fun x  ->
2677 2683
                     if sep then Format.fprintf fmt "";
2678
                       Format.fprintf fmt ": %s" x;
2684
                       Format.fprintf fmt "%s " x;
2679 2685
                       true) false x))) x.mode;
2680 2686
          ((__1 ()) fmt) x.typ;
2681 2687
          (match x.init_val with
......
2827 2833
                  (List.fold_left
2828 2834
                     (fun sep  ->
2829 2835
                        fun x  ->
2830
                          if sep then Format.fprintf fmt ",@ ";
2836
                          if sep then Format.fprintf fmt ";@ ";
2831 2837
                          ((__1 ()) fmt) x;
2832 2838
                          true) false x))) x.parameters;
2833 2839
            Format.fprintf fmt "@])");
......
3124 3130
  | Wait [@name "WAIT_STATEMENT"]
3125 3131
  | Null of {
3126 3132
  label: vhdl_name_t [@default NoName]} [@name "NULL_STATEMENT"]
3127
  | Return of {
3128
  label: vhdl_name_t [@default NoName]} [@name "RETURN_STATEMENT"]
3133
  | Return of
3134
  {
3135
  label: vhdl_name_t option [@default None];
3136
  expr: vhdl_expr_t option [@default None]} [@name "RETURN_STATEMENT"]
3129 3137
and vhdl_if_case_t =
3130 3138
  {
3131 3139
  if_cond: vhdl_expr_t ;
......
3137 3145

  
3138 3146
let rec pp_vhdl_sequential_stmt_t :
3139 3147
  Format.formatter -> vhdl_sequential_stmt_t -> Ppx_deriving_runtime.unit =
3140
  let __22 () = pp_vhdl_name_t
3148
  let __23 () = pp_vhdl_expr_t
3149
  
3150
  and __22 () = pp_vhdl_name_t
3141 3151
  
3142 3152
  and __21 () = pp_vhdl_name_t
3143 3153
  
......
3182 3192
  and __1 () = pp_vhdl_name_t
3183 3193
  
3184 3194
  and __0 () = pp_vhdl_name_t
3185
   in
3195
  in
3186 3196
  ((let open! Ppx_deriving_runtime in
3187 3197
      fun fmt  ->
3188 3198
        function
......
3224 3234
                 (List.fold_left
3225 3235
                   (fun sep  ->
3226 3236
                     fun x  ->
3227
                       if sep then Format.fprintf fmt "";
3237
                       if sep then Format.fprintf fmt ", ";
3228 3238
                        ((__5 ()) fmt) x;
3229 3239
                        true) false x);
3230 3240
            Format.fprintf fmt "@]@]")) arhs;
......
3346 3356
                     Format.fprintf fmt ":@ ")
3347 3357
            );
3348 3358
            Format.fprintf fmt "null";
3349
        | Return { label = alabel } ->
3359
        | Return { label = alabel; expr = aexpr } ->
3350 3360
            (match alabel with
3351
              | NoName -> Format.fprintf fmt "";
3352
              | _ -> (((__19 ()) fmt) alabel;
3361
              | None -> ();
3362
              | Some a -> (((__19 ()) fmt) a;
3353 3363
                     Format.fprintf fmt ":@ ")
3354 3364
            );
3355
            Format.fprintf fmt "return";)
3365
            Format.fprintf fmt "return";
3366
            (match aexpr with
3367
                | None  -> ()
3368
                | Some a ->
3369
                     ((__23 ()) fmt) a);)
3356 3370
    [@ocaml.warning "-A"])
3357 3371

  
3358 3372
and show_vhdl_sequential_stmt_t :
......
3638 3652
            [`String "RETURN_STATEMENT";
3639 3653
            (let fields = []  in
3640 3654
             let fields =
3641
               if arg0.label = NoName
3655
               if arg0.expr = None
3656
               then fields
3657
               else
3658
                 ("expr",
3659
                   (((function
3660
                      | None  -> `Null
3661
                      | Some x -> ((fun x  -> vhdl_expr_t_to_yojson x)) x))
3662
                      arg0.expr))
3663
                 :: fields
3664
                in
3665
             let fields =
3666
               if arg0.label = None
3642 3667
               then fields
3643 3668
               else
3644 3669
                 ("label",
3645
                   (((fun x  -> vhdl_name_t_to_yojson x)) arg0.label))
3670
                   (((function
3671
                      | None  -> `Null
3672
                      | Some x -> ((fun x  -> vhdl_name_t_to_yojson x)) x))
3673
                      arg0.label))
3646 3674
                 :: fields
3647 3675
                in
3648 3676
             `Assoc fields)])
......
3979 4007
      | `List ((`String "RETURN_STATEMENT")::arg0::[]) ->
3980 4008
          ((function
3981 4009
            | `Assoc xs ->
3982
                let rec loop xs (arg0 as _state) =
4010
                let rec loop xs ((arg0,arg1) as _state) =
3983 4011
                  match xs with
3984 4012
                  | ("label",x)::xs ->
3985
                      loop xs ((fun x  -> vhdl_name_t_of_yojson x) x)
4013
                      loop xs
4014
                        (((function
4015
                           | `Null -> Result.Ok None
4016
                           | x ->
4017
                               ((fun x  -> vhdl_name_t_of_yojson x) x) >>=
4018
                                 ((fun x  -> Result.Ok (Some x)))) x), arg1)
4019
                  | ("expr",x)::xs ->
4020
                      loop xs
4021
                        (arg0,
4022
                          ((function
4023
                            | `Null -> Result.Ok None
4024
                            | x ->
4025
                                ((fun x  -> vhdl_expr_t_of_yojson x) x) >>=
4026
                                  ((fun x  -> Result.Ok (Some x)))) x))
3986 4027
                  | [] ->
3987
                      arg0 >>=
3988
                        ((fun arg0  -> Result.Ok (Return { label = arg0 })))
4028
                      arg1 >>=
4029
                        ((fun arg1  ->
4030
                            arg0 >>=
4031
                              (fun arg0  ->
4032
                                 Result.Ok
4033
                                   (Return { label = arg0; expr = arg1 }))))
3989 4034
                  | _::xs -> loop xs _state  in
3990
                loop xs (Result.Ok NoName)
4035
                loop xs ((Result.Ok None), (Result.Ok None))
3991 4036
            | _ -> Result.Error "Vhdl_ast.vhdl_sequential_stmt_t")) arg0
3992 4037
      | _ -> Result.Error "Vhdl_ast.vhdl_sequential_stmt_t")
3993 4038
  [@ocaml.warning "-A"])
......
4393 4438
            Format.fprintf fmt "@[<v 2>component ";
4394 4439
            ((__9 ()) fmt) aname;
4395 4440
            Format.fprintf fmt " is@;";
4396
            ((fun x  ->
4397
              ignore
4398
                (List.fold_left
4399
                  (fun sep  ->
4400
                    fun x  ->
4401
                      if sep then Format.fprintf fmt "@;";
4402
                        ((__10 ()) fmt) x;
4403
                        true) false x))) agenerics;
4404
            ((fun x  ->
4405
              ignore
4406
                (List.fold_left
4407
                  (fun sep  ->
4408
                    fun x  ->
4409
                      if sep then Format.fprintf fmt "@;";
4410
                        ((__11 ()) fmt) x;
4411
                        true) false x))) aports;
4441
            (match agenerics with
4442
            | [] -> ()
4443
            | _ ->
4444
                Format.fprintf fmt "generic (@[<v>";
4445
                ((fun x  ->
4446
                  ignore
4447
                    (List.fold_left
4448
                      (fun sep  ->
4449
                        fun x  ->
4450
                          if sep then Format.fprintf fmt ";@;";
4451
                            ((__10 ()) fmt) x;
4452
                            true) false x))) agenerics;
4453
                Format.fprintf fmt "@]);");
4454
            (match aports with
4455
            | [] -> ()
4456
            | _ ->
4457
                Format.fprintf fmt "port (@[<v>";
4458
                ((fun x  ->
4459
                  ignore
4460
                    (List.fold_left
4461
                      (fun sep  ->
4462
                        fun x  ->
4463
                          if sep then Format.fprintf fmt ";@;";
4464
                            ((__11 ()) fmt) x;
4465
                            true) false x))) aports;
4466
                Format.fprintf fmt "@]);");
4412 4467
            Format.fprintf fmt "@]@;end component";
4413 4468
        | Subprogram
4414 4469
            { spec = aspec; decl_part = adecl_part; stmts = astmts }
......
4843 4898
                   (List.fold_left
4844 4899
                      (fun sep  ->
4845 4900
                         fun x  ->
4846
                           if sep then Format.fprintf fmt ".";
4901
                           if sep then Format.fprintf fmt ",";
4847 4902
                           ((__0 ()) fmt) x;
4848 4903
                           true) false x))) a0);
4849 4904
        | Use a0 ->
......
5047 5102
                  (List.fold_left
5048 5103
                     (fun sep  ->
5049 5104
                        fun x  ->
5050
                          if sep then Format.fprintf fmt " else ";
5105
                          if sep then Format.fprintf fmt ",@,";
5051 5106
                          ((__0 ()) fmt) x;
5052 5107
                          true) false x))) x.expr;
5053 5108
          (match x.cond with
......
5764 5819
  {
5765 5820
  name: vhdl_name_t ;
5766 5821
  inst_unit: vhdl_name_t ;
5822
  inst_unit_type: string [@default ""];
5767 5823
  archi_name: vhdl_name_t option [@default None];
5768 5824
  generic_map: vhdl_assoc_element_t list [@default []];
5769 5825
  port_map: vhdl_assoc_element_t list [@default []]}[@@deriving
......
5793 5849
          Format.fprintf fmt "@[<v 2>";
5794 5850
          ((__0 ()) fmt) x.name;
5795 5851
          Format.fprintf fmt " : ";
5852
          Format.fprintf fmt "%s " x.inst_unit_type;
5796 5853
          ((__1 ()) fmt) x.inst_unit;
5797 5854
          ((function
5798 5855
             | None  -> Format.pp_print_string fmt ""
......
5803 5860
          (match x.generic_map with
5804 5861
          | [] -> Format.fprintf fmt "";
5805 5862
          | _ ->
5806
            (Format.fprintf fmt "@[<v 2>generic map (";
5863
            (Format.fprintf fmt " generic map (@[<v 2>";
5807 5864
            ((fun x  ->
5808 5865
            ignore
5809 5866
            (List.fold_left
......
5816 5873
          (match x.port_map with
5817 5874
          | [] -> Format.fprintf fmt ";";
5818 5875
          | _ ->
5819
            (Format.fprintf fmt "@[<v 2>port map (";
5876
            (Format.fprintf fmt " port map (@[<v 2>";
5820 5877
            ((fun x  ->
5821 5878
            ignore
5822 5879
            (List.fold_left
......
5872 5929
                 x.archi_name))
5873 5930
            :: fields
5874 5931
           in
5932
        let fields =
5933
          if x.inst_unit_type = ""
5934
          then fields
5935
          else
5936
            ("inst_unit_type",
5937
              (((fun (x : Ppx_deriving_runtime.string)  -> `String x))
5938
                 x.inst_unit_type))
5939
            :: fields
5940
           in
5875 5941
        let fields =
5876 5942
          ("inst_unit", ((fun x  -> vhdl_name_t_to_yojson x) x.inst_unit)) ::
5877 5943
          fields  in
......
5887 5953
  ((let open! Ppx_deriving_yojson_runtime in
5888 5954
      function
5889 5955
      | `Assoc xs ->
5890
          let rec loop xs ((arg0,arg1,arg2,arg3,arg4) as _state) =
5956
          let rec loop xs ((arg0,arg1,arg2,arg3,arg4,arg5) as _state) =
5891 5957
            match xs with
5892 5958
            | ("name",x)::xs ->
5893 5959
                loop xs
5894 5960
                  (((fun x  -> vhdl_name_t_of_yojson x) x), arg1, arg2, arg3,
5895
                    arg4)
5961
                    arg4, arg5)
5896 5962
            | ("inst_unit",x)::xs ->
5897 5963
                loop xs
5898 5964
                  (arg0, ((fun x  -> vhdl_name_t_of_yojson x) x), arg2, arg3,
5899
                    arg4)
5900
            | ("archi_name",x)::xs ->
5965
                    arg4, arg5)
5966
            | ("inst_unit_type",x)::xs ->
5901 5967
                loop xs
5902 5968
                  (arg0, arg1,
5969
                    ((function
5970
                      | `String x -> Result.Ok x
5971
                      | _ ->
5972
                          Result.Error
5973
                            "Vhdl_ast.vhdl_component_instantiation_t.inst_unit_type")
5974
                       x), arg3, arg4, arg5)
5975
            | ("archi_name",x)::xs ->
5976
                loop xs
5977
                  (arg0, arg1, arg2,
5903 5978
                    ((function
5904 5979
                      | `Null -> Result.Ok None
5905 5980
                      | x ->
5906 5981
                          ((fun x  -> vhdl_name_t_of_yojson x) x) >>=
5907
                            ((fun x  -> Result.Ok (Some x)))) x), arg3, arg4)
5982
                            ((fun x  -> Result.Ok (Some x)))) x), arg4, arg5)
5908 5983
            | ("generic_map",x)::xs ->
5909 5984
                loop xs
5910
                  (arg0, arg1, arg2,
5985
                  (arg0, arg1, arg2, arg3,
5911 5986
                    ((function
5912 5987
                      | `List xs ->
5913 5988
                          map_bind
......
5916 5991
                      | _ ->
5917 5992
                          Result.Error
5918 5993
                            "Vhdl_ast.vhdl_component_instantiation_t.generic_map")
5919
                       x), arg4)
5994
                       x), arg5)
5920 5995
            | ("port_map",x)::xs ->
5921 5996
                loop xs
5922
                  (arg0, arg1, arg2, arg3,
5997
                  (arg0, arg1, arg2, arg3, arg4,
5923 5998
                    ((function
5924 5999
                      | `List xs ->
5925 6000
                          map_bind
......
5930 6005
                            "Vhdl_ast.vhdl_component_instantiation_t.port_map")
5931 6006
                       x))
5932 6007
            | [] ->
5933
                arg4 >>=
5934
                  ((fun arg4  ->
5935
                      arg3 >>=
5936
                        (fun arg3  ->
5937
                           arg2 >>=
5938
                             (fun arg2  ->
5939
                                arg1 >>=
5940
                                  (fun arg1  ->
5941
                                     arg0 >>=
5942
                                       (fun arg0  ->
5943
                                          Result.Ok
5944
                                            {
5945
                                              name = arg0;
5946
                                              inst_unit = arg1;
5947
                                              archi_name = arg2;
5948
                                              generic_map = arg3;
5949
                                              port_map = arg4
5950
                                            }))))))
6008
                arg5 >>=
6009
                  ((fun arg5  ->
6010
                      arg4 >>=
6011
                        (fun arg4  ->
6012
                           arg3 >>=
6013
                             (fun arg3  ->
6014
                                arg2 >>=
6015
                                  (fun arg2  ->
6016
                                     arg1 >>=
6017
                                       (fun arg1  ->
6018
                                          arg0 >>=
6019
                                            (fun arg0  ->
6020
                                               Result.Ok
6021
                                                 {
6022
                                                   name = arg0;
6023
                                                   inst_unit = arg1;
6024
                                                   inst_unit_type = arg2;
6025
                                                   archi_name = arg3;
6026
                                                   generic_map = arg4;
6027
                                                   port_map = arg5
6028
                                                 })))))))
5951 6029
            | _::xs -> loop xs _state  in
5952 6030
          loop xs
5953 6031
            ((Result.Error "Vhdl_ast.vhdl_component_instantiation_t.name"),
5954 6032
              (Result.Error
5955 6033
                 "Vhdl_ast.vhdl_component_instantiation_t.inst_unit"),
5956
              (Result.Ok None), (Result.Ok []), (Result.Ok []))
6034
              (Result.Ok ""), (Result.Ok None), (Result.Ok []),
6035
              (Result.Ok []))
5957 6036
      | _ -> Result.Error "Vhdl_ast.vhdl_component_instantiation_t")
5958 6037
  [@ocaml.warning "-A"])
5959 6038

  
......
6455 6534
                       Format.fprintf fmt ";";
6456 6535
                       true) false x))) x.declarations;
6457 6536
          Format.fprintf fmt "@;";
6537
          Format.fprintf fmt "@[<v 2>begin@;";
6458 6538
          (match x.body with
6459 6539
            | [] -> Format.fprintf fmt "";
6460
            | _ -> Format.fprintf fmt "@[<v 2>begin@;";
6540
            | _ ->
6461 6541
               ((fun x  ->
6462 6542
               ignore
6463 6543
                 (List.fold_left
......
6465 6545
                       fun x  ->
6466 6546
                         if sep then Format.fprintf fmt "@;";
6467 6547
                         ((__3 ()) fmt) x;
6468
                         true) false x))) x.body;
6469
           Format.fprintf fmt "@;"))
6548
                         true) false x))) x.body);
6549
          Format.fprintf fmt "@]@;")
6470 6550
    [@ocaml.warning "-A"])
6471 6551

  
6472 6552
and show_vhdl_architecture_t :

Also available in: Unified diff