Project

General

Profile

« Previous | Next » 

Revision d3a35600

Added by Arnaud Dieumegard almost 6 years ago

Conditional signals selection, waveform with delay

View differences:

src/backends/VHDL/vhdl_ast_deriving.ml
2874 2874
  "?>=";
2875 2875
  "??"] 
2876 2876
let shift_funs = ["sll"; "srl"; "sla"; "sra"; "rol"; "ror"] 
2877

  
2878
type vhdl_waveform_element_t =
2879
  {
2880
  value: vhdl_expr_t option [@default None];
2881
  delay: vhdl_expr_t option [@default None]}[@@deriving
2882
                                              ((show { with_path = false }),
2883
                                                (yojson { strict = false }))]
2884

  
2885
let rec pp_vhdl_waveform_element_t :
2886
  Format.formatter -> vhdl_waveform_element_t -> Ppx_deriving_runtime.unit =
2887
  let __1 () = pp_vhdl_expr_t
2888
  
2889
  and __0 () = pp_vhdl_expr_t
2890
   in
2891
  ((let open! Ppx_deriving_runtime in
2892
      fun fmt  ->
2893
        fun x  ->
2894
          (match x.value with
2895
          | None -> Format.fprintf fmt "";
2896
          | Some IsNull -> Format.fprintf fmt "null";
2897
          | Some v -> ((__0 ()) fmt) v);
2898
          (match x.delay with
2899
          | None -> Format.fprintf fmt "";
2900
          | Some v -> 
2901
              Format.fprintf fmt " after ";
2902
              ((__1 ()) fmt) v))
2903
    [@ocaml.warning "-A"])
2904

  
2905
and show_vhdl_waveform_element_t :
2906
  vhdl_waveform_element_t -> Ppx_deriving_runtime.string =
2907
  fun x  -> Format.asprintf "%a" pp_vhdl_waveform_element_t x
2908

  
2909
let rec (vhdl_waveform_element_t_to_yojson :
2910
          vhdl_waveform_element_t -> Yojson.Safe.json)
2911
  =
2912
  ((let open! Ppx_deriving_yojson_runtime in
2913
      fun x  ->
2914
        let fields = []  in
2915
        let fields =
2916
          if x.delay = None
2917
          then fields
2918
          else
2919
            ("delay",
2920
              (((function
2921
                 | None  -> `Null
2922
                 | Some x -> ((fun x  -> vhdl_expr_t_to_yojson x)) x))
2923
                 x.delay))
2924
            :: fields
2925
           in
2926
        let fields =
2927
          if x.value = None
2928
          then fields
2929
          else
2930
            ("value",
2931
              (((function
2932
                 | None  -> `Null
2933
                 | Some x -> ((fun x  -> vhdl_expr_t_to_yojson x)) x))
2934
                 x.value))
2935
            :: fields
2936
           in
2937
        `Assoc fields)
2938
  [@ocaml.warning "-A"])
2939

  
2940
and (vhdl_waveform_element_t_of_yojson :
2941
      Yojson.Safe.json ->
2942
        vhdl_waveform_element_t Ppx_deriving_yojson_runtime.error_or)
2943
  =
2944
  ((let open! Ppx_deriving_yojson_runtime in
2945
      function
2946
      | `Assoc xs ->
2947
          let rec loop xs ((arg0,arg1) as _state) =
2948
            match xs with
2949
            | ("value",x)::xs ->
2950
                loop xs
2951
                  (((function
2952
                     | `Null -> Result.Ok None
2953
                     | x ->
2954
                         ((fun x  -> vhdl_expr_t_of_yojson x) x) >>=
2955
                           ((fun x  -> Result.Ok (Some x)))) x), arg1)
2956
            | ("delay",x)::xs ->
2957
                loop xs
2958
                  (arg0,
2959
                    ((function
2960
                      | `Null -> Result.Ok None
2961
                      | x ->
2962
                          ((fun x  -> vhdl_expr_t_of_yojson x) x) >>=
2963
                            ((fun x  -> Result.Ok (Some x)))) x))
2964
            | [] ->
2965
                arg1 >>=
2966
                  ((fun arg1  ->
2967
                      arg0 >>=
2968
                        (fun arg0  ->
2969
                           Result.Ok { value = arg0; delay = arg1 })))
2970
            | _::xs -> loop xs _state  in
2971
          loop xs ((Result.Ok None), (Result.Ok None))
2972
      | _ -> Result.Error "Vhdl_ast.vhdl_waveform_element_t")
2973
  [@ocaml.warning "-A"])
2974

  
2877 2975
type vhdl_sequential_stmt_t =
2878 2976
  | VarAssign of
2879 2977
  {
......
2884 2982
  {
2885 2983
  label: vhdl_name_t [@default NoName];
2886 2984
  lhs: vhdl_name_t ;
2887
  rhs: vhdl_expr_t list } [@name "SIGNAL_ASSIGNMENT_STATEMENT"]
2985
  rhs: vhdl_waveform_element_t list } [@name "SIGNAL_ASSIGNMENT_STATEMENT"]
2888 2986
  | If of
2889 2987
  {
2890 2988
  label: vhdl_name_t [@default NoName];
......
2962 3060
  
2963 3061
  and __6 () = pp_vhdl_name_t
2964 3062
  
2965
  and __5 () = pp_vhdl_expr_t
3063
  and __5 () = pp_vhdl_waveform_element_t
2966 3064
  
2967 3065
  and __4 () = pp_vhdl_name_t
2968 3066
  
......
3240 3338
             let fields =
3241 3339
               ("rhs",
3242 3340
                 ((fun x  ->
3243
                     `List (List.map (fun x  -> vhdl_expr_t_to_yojson x) x))
3341
                     `List
3342
                       (List.map
3343
                          (fun x  -> vhdl_waveform_element_t_to_yojson x) x))
3244 3344
                    arg0.rhs))
3245 3345
               :: fields  in
3246 3346
             let fields =
......
3491 3591
                        (arg0, arg1,
3492 3592
                          ((function
3493 3593
                            | `List xs ->
3494
                                map_bind (fun x  -> vhdl_expr_t_of_yojson x)
3495
                                  [] xs
3594
                                map_bind
3595
                                  (fun x  ->
3596
                                     vhdl_waveform_element_t_of_yojson x) []
3597
                                  xs
3496 3598
                            | _ ->
3497 3599
                                Result.Error
3498 3600
                                  "Vhdl_ast.vhdl_sequential_stmt_t.rhs") x))
......
4816 4918

  
4817 4919
type vhdl_signal_condition_t =
4818 4920
  {
4819
  expr: vhdl_expr_t list ;
4820
  cond: vhdl_expr_t [@default IsNull]}
4921
  expr: vhdl_waveform_element_t list [@default []];
4922
  cond: vhdl_expr_t [@default IsNull]}[@@deriving
4923
                                        ((show { with_path = false }),
4924
                                          (yojson { strict = false }))]
4821 4925

  
4822 4926
let rec pp_vhdl_signal_condition_t :
4823 4927
  Format.formatter -> vhdl_signal_condition_t -> Ppx_deriving_runtime.unit =
4824 4928
  let __1 () = pp_vhdl_expr_t
4825 4929
  
4826
  and __0 () = pp_vhdl_expr_t
4930
  and __0 () = pp_vhdl_waveform_element_t
4827 4931
   in
4828 4932
  ((let open! Ppx_deriving_runtime in
4829 4933
      fun fmt  ->
......
4859 4963
            fields
4860 4964
           in
4861 4965
        let fields =
4862
          ("expr",
4863
            ((fun x  ->
4864
                `List (List.map (fun x  -> vhdl_expr_t_to_yojson x) x))
4865
               x.expr))
4866
          :: fields  in
4966
          if x.expr = []
4967
          then fields
4968
          else
4969
            ("expr",
4970
              (((fun x  ->
4971
                   `List
4972
                     (List.map
4973
                        (fun x  -> vhdl_waveform_element_t_to_yojson x) x)))
4974
                 x.expr))
4975
            :: fields
4976
           in
4867 4977
        `Assoc fields)
4868 4978
  [@ocaml.warning "-A"])
4869 4979

  
......
4880 4990
                loop xs
4881 4991
                  (((function
4882 4992
                     | `List xs ->
4883
                         map_bind (fun x  -> vhdl_expr_t_of_yojson x) [] xs
4993
                         map_bind
4994
                           (fun x  -> vhdl_waveform_element_t_of_yojson x) []
4995
                           xs
4884 4996
                     | _ ->
4885 4997
                         Result.Error "Vhdl_ast.vhdl_signal_condition_t.expr")
4886 4998
                      x), arg1)
......
4892 5004
                      arg0 >>=
4893 5005
                        (fun arg0  -> Result.Ok { expr = arg0; cond = arg1 })))
4894 5006
            | _::xs -> loop xs _state  in
4895
          loop xs
4896
            ((Result.Error "Vhdl_ast.vhdl_signal_condition_t.expr"),
4897
              (Result.Ok IsNull))
5007
          loop xs ((Result.Ok []), (Result.Ok IsNull))
4898 5008
      | _ -> Result.Error "Vhdl_ast.vhdl_signal_condition_t")
4899 5009
  [@ocaml.warning "-A"])
4900 5010

  
4901 5011
type vhdl_signal_selection_t =
4902 5012
  {
4903
  expr: vhdl_expr_t ;
4904
  when_sel: vhdl_expr_t list [@default []]}
5013
  expr: vhdl_waveform_element_t list [@default []];
5014
  when_sel: vhdl_expr_t list [@default []]}[@@deriving
5015
                                             ((show { with_path = false }),
5016
                                               (yojson { strict = false }))]
4905 5017

  
4906
(* TODO *)
4907 5018
let rec pp_vhdl_signal_selection_t :
4908 5019
  Format.formatter -> vhdl_signal_selection_t -> Ppx_deriving_runtime.unit =
4909 5020
  let __1 () = pp_vhdl_expr_t
4910 5021
  
4911
  and __0 () = pp_vhdl_expr_t
5022
  and __0 () = pp_vhdl_waveform_element_t
4912 5023
   in
4913 5024
  ((let open! Ppx_deriving_runtime in
4914 5025
      fun fmt  ->
4915 5026
        fun x  ->
4916
          Format.fprintf fmt "@[<2>{ ";
4917
          ((Format.fprintf fmt "@[%s =@ " "expr";
4918
            ((__0 ()) fmt) x.expr;
4919
            Format.fprintf fmt "@]");
4920
           Format.fprintf fmt ";@ ";
4921
           Format.fprintf fmt "@[%s =@ " "when_sel";
4922
           ((fun x  ->
4923
               Format.fprintf fmt "@[<2>[";
4924
               ignore
4925
                 (List.fold_left
4926
                    (fun sep  ->
4927
                       fun x  ->
4928
                         if sep then Format.fprintf fmt ";@ ";
4929
                         ((__1 ()) fmt) x;
4930
                         true) false x);
4931
               Format.fprintf fmt "@,]@]")) x.when_sel;
4932
           Format.fprintf fmt "@]");
4933
          Format.fprintf fmt "@ }@]")
5027
          ((fun x  ->
5028
            ignore
5029
              (List.fold_left
5030
                (fun sep  ->
5031
                  fun x  ->
5032
                    if sep then Format.fprintf fmt "@ ";
5033
                      ((__0 ()) fmt) x;
5034
                      true) false x))) x.expr;
5035
          Format.fprintf fmt " when ";
5036
          ((fun x  ->
5037
            ignore
5038
              (List.fold_left
5039
                (fun sep  ->
5040
                  fun x  ->
5041
                    if sep then Format.fprintf fmt "|@ ";
5042
                      ((__1 ()) fmt) x;
5043
                      true) false x))) x.when_sel)
4934 5044
    [@ocaml.warning "-A"])
4935 5045

  
4936 5046
and show_vhdl_signal_selection_t :
......
4953 5063
                 x.when_sel))
4954 5064
            :: fields
4955 5065
           in
4956
        let fields = ("expr", ((fun x  -> vhdl_expr_t_to_yojson x) x.expr))
4957
          :: fields  in
5066
        let fields =
5067
          if x.expr = []
5068
          then fields
5069
          else
5070
            ("expr",
5071
              (((fun x  ->
5072
                   `List
5073
                     (List.map
5074
                        (fun x  -> vhdl_waveform_element_t_to_yojson x) x)))
5075
                 x.expr))
5076
            :: fields
5077
           in
4958 5078
        `Assoc fields)
4959 5079
  [@ocaml.warning "-A"])
4960 5080

  
......
4968 5088
          let rec loop xs ((arg0,arg1) as _state) =
4969 5089
            match xs with
4970 5090
            | ("expr",x)::xs ->
4971
                loop xs (((fun x  -> vhdl_expr_t_of_yojson x) x), arg1)
5091
                loop xs
5092
                  (((function
5093
                     | `List xs ->
5094
                         map_bind
5095
                           (fun x  -> vhdl_waveform_element_t_of_yojson x) []
5096
                           xs
5097
                     | _ ->
5098
                         Result.Error "Vhdl_ast.vhdl_signal_selection_t.expr")
5099
                      x), arg1)
4972 5100
            | ("when_sel",x)::xs ->
4973 5101
                loop xs
4974 5102
                  (arg0,
......
4985 5113
                        (fun arg0  ->
4986 5114
                           Result.Ok { expr = arg0; when_sel = arg1 })))
4987 5115
            | _::xs -> loop xs _state  in
4988
          loop xs
4989
            ((Result.Error "Vhdl_ast.vhdl_signal_selection_t.expr"),
4990
              (Result.Ok []))
5116
          loop xs ((Result.Ok []), (Result.Ok []))
4991 5117
      | _ -> Result.Error "Vhdl_ast.vhdl_signal_selection_t")
4992 5118
  [@ocaml.warning "-A"])
4993 5119

  
......
5354 5480
  lhs: vhdl_name_t ;
5355 5481
  sel: vhdl_expr_t ;
5356 5482
  branches: vhdl_signal_selection_t list [@default []];
5357
  delay: vhdl_expr_t option }
5483
  delay: vhdl_expr_t option [@default None]}[@@deriving
5484
                                              ((show { with_path = false }),
5485
                                                (yojson { strict = false }))]
5358 5486

  
5359
(* TODO *)
5360 5487
let rec pp_vhdl_selected_signal_t :
5361 5488
  Format.formatter -> vhdl_selected_signal_t -> Ppx_deriving_runtime.unit =
5362 5489
  let __4 () = pp_vhdl_expr_t
......
5372 5499
  ((let open! Ppx_deriving_runtime in
5373 5500
      fun fmt  ->
5374 5501
        fun x  ->
5375
          Format.fprintf fmt "@[<2>{ ";
5376
          ((((((Format.fprintf fmt "@[%s =@ " "postponed";
5377
                (Format.fprintf fmt "%B") x.postponed;
5378
                Format.fprintf fmt "@]");
5379
               Format.fprintf fmt ";@ ";
5380
               Format.fprintf fmt "@[%s =@ " "label";
5381
               ((__0 ()) fmt) x.label;
5382
               Format.fprintf fmt "@]");
5383
              Format.fprintf fmt ";@ ";
5384
              Format.fprintf fmt "@[%s =@ " "lhs";
5385
              ((__1 ()) fmt) x.lhs;
5386
              Format.fprintf fmt "@]");
5387
             Format.fprintf fmt ";@ ";
5388
             Format.fprintf fmt "@[%s =@ " "sel";
5389
             ((__2 ()) fmt) x.sel;
5390
             Format.fprintf fmt "@]");
5391
            Format.fprintf fmt ";@ ";
5392
            Format.fprintf fmt "@[%s =@ " "branches";
5393
            ((fun x  ->
5394
                Format.fprintf fmt "@[<2>[";
5395
                ignore
5396
                  (List.fold_left
5397
                     (fun sep  ->
5398
                        fun x  ->
5399
                          if sep then Format.fprintf fmt ";@ ";
5400
                          ((__3 ()) fmt) x;
5401
                          true) false x);
5402
                Format.fprintf fmt "@,]@]")) x.branches;
5403
            Format.fprintf fmt "@]");
5404
           Format.fprintf fmt ";@ ";
5405
           Format.fprintf fmt "@[%s =@ " "delay";
5406
           ((function
5407
             | None  -> Format.pp_print_string fmt "None"
5408
             | Some x ->
5409
                 (Format.pp_print_string fmt "(Some ";
5410
                  ((__4 ()) fmt) x;
5411
                  Format.pp_print_string fmt ")"))) x.delay;
5412
           Format.fprintf fmt "@]");
5413
          Format.fprintf fmt "@ }@]")
5502
          Format.fprintf fmt "@[<v 2>";
5503
          (match x.label with
5504
            | NoName -> Format.fprintf fmt "";
5505
            | _ -> (((__0 ()) fmt) x.label;
5506
                   Format.fprintf fmt ":@ ")
5507
          );
5508
          Format.fprintf fmt "with ";
5509
          ((__2 ()) fmt) x.sel;
5510
          Format.fprintf fmt " select@;";
5511
          ((__1 ()) fmt) x.lhs;
5512
          Format.fprintf fmt " <= ";
5513
          ((function
5514
            | None  -> Format.pp_print_string fmt ""
5515
            | Some x ->
5516
               ((__4 ()) fmt) x)) x.delay;
5517
          ((fun x  ->
5518
            ignore
5519
              (List.fold_left
5520
                (fun sep  ->
5521
                  fun x  ->
5522
                    if sep then Format.fprintf fmt ",@ ";
5523
                      ((__3 ()) fmt) x;
5524
                      true) false x))) x.branches;
5525
          Format.fprintf fmt "@]";)
5414 5526
    [@ocaml.warning "-A"])
5415 5527

  
5416 5528
and show_vhdl_selected_signal_t :
......
5424 5536
      fun x  ->
5425 5537
        let fields = []  in
5426 5538
        let fields =
5427
          ("delay",
5428
            ((function
5429
              | None  -> `Null
5430
              | Some x -> ((fun x  -> vhdl_expr_t_to_yojson x)) x) x.delay))
5431
          :: fields  in
5539
          if x.delay = None
5540
          then fields
5541
          else
5542
            ("delay",
5543
              (((function
5544
                 | None  -> `Null
5545
                 | Some x -> ((fun x  -> vhdl_expr_t_to_yojson x)) x))
5546
                 x.delay))
5547
            :: fields
5548
           in
5432 5549
        let fields =
5433 5550
          if x.branches = []
5434 5551
          then fields
......
5539 5656
            ((Result.Ok false), (Result.Ok NoName),
5540 5657
              (Result.Error "Vhdl_ast.vhdl_selected_signal_t.lhs"),
5541 5658
              (Result.Error "Vhdl_ast.vhdl_selected_signal_t.sel"),
5542
              (Result.Ok []),
5543
              (Result.Error "Vhdl_ast.vhdl_selected_signal_t.delay"))
5659
              (Result.Ok []), (Result.Ok None))
5544 5660
      | _ -> Result.Error "Vhdl_ast.vhdl_selected_signal_t")
5545 5661
  [@ocaml.warning "-A"])
5546 5662

  

Also available in: Unified diff