Project

General

Profile

Revision 248eb65e src/backends/VHDL/vhdl_ast_deriving.ml

View differences:

src/backends/VHDL/vhdl_ast_deriving.ml
75 75
  | Base of string 
76 76
  | Range of string option * int * int 
77 77
  | Bit_vector of int * int 
78
  | Array of int * int * vhdl_type_t 
79
  | Enumerated of string list 
78
  | Array of
79
  {
80
  indexes: vhdl_name_t list ;
81
  const: vhdl_constraint_t option [@default None];
82
  definition: vhdl_subtype_indication_t } [@name "ARRAY_TYPE_DEFINITION"]
83
  | Record of vhdl_element_declaration_t list
84
  [@name "RECORD_TYPE_DEFINITION"]
85
  | Enumerated of vhdl_name_t list [@name "ENUMERATION_TYPE_DEFINITION"]
80 86
  | Void 
87
and vhdl_element_declaration_t =
88
  {
89
  names: vhdl_name_t list ;
90
  definition: vhdl_subtype_indication_t }
81 91
and vhdl_subtype_indication_t =
82 92
  {
83 93
  name: vhdl_name_t [@default NoName];
......
175 185

  
176 186
let rec pp_vhdl_type_t :
177 187
  Format.formatter -> vhdl_type_t -> Ppx_deriving_runtime.unit =
178
  let __0 () = pp_vhdl_type_t  in
188
  let __4 () = pp_vhdl_name_t
189
  
190
  and __3 () = pp_vhdl_element_declaration_t
191
  
192
  and __2 () = pp_vhdl_subtype_indication_t
193
  
194
  and __1 () = pp_vhdl_constraint_t
195
  
196
  and __0 () = pp_vhdl_name_t
197
in
179 198
  ((let open! Ppx_deriving_runtime in
180 199
      fun fmt  ->
181 200
        function
......
192 211
              (Format.fprintf fmt "%d") a2);
193 212
        | Bit_vector (a0,a1) ->
194 213
             (Format.fprintf fmt "array (%d,%d) of bit") a0 a1;
195
        | Array (a0,a1,a2) ->
196
             (Format.fprintf fmt "array ";
197
             (Format.fprintf fmt "(%d,%d)") a0 a1;
198
             Format.fprintf fmt " of ";
199
             ((__0 ()) fmt) a2)
214
        | Array
215
            { indexes = aindexes; const = aconst; definition = adefinition }
216
            ->
217
            Format.fprintf fmt "array";
218
            (match aindexes with
219
            | [] -> Format.fprintf fmt "";
220
            | _ ->
221
              ((fun x  ->
222
                ignore
223
                (List.fold_left
224
                  (fun sep  ->
225
                    fun x  ->
226
                      if sep then Format.fprintf fmt ",@ ";
227
                      ((__0 ()) fmt) x;
228
                      true) false x)) aindexes));
229
            (function
230
              | None  -> Format.pp_print_string fmt ""
231
              | Some x ->
232
                ((__1 ()) fmt) x) aconst;
233
            Format.fprintf fmt " of ";
234
            ((__2 ()) fmt) adefinition;
235
        | Record a0 ->
236
            Format.fprintf fmt "@[<v 2>record@;";
237
            (fun x  ->
238
              ignore
239
                (List.fold_left
240
                  (fun sep  ->
241
                    fun x  ->
242
                      if sep then Format.fprintf fmt ";@;";
243
                        ((__3 ()) fmt) x;
244
                        true) false x);
245
              Format.fprintf fmt "@]@;end record") a0;
200 246
        | Enumerated a0 ->
201
             ((fun x  ->
202
                 ignore
203
                   (List.fold_left
204
                      (fun sep  ->
205
                         fun x  ->
206
                           if sep then Format.fprintf fmt ",@ ";
207
                           (Format.fprintf fmt "%s") x;
208
                           true) false x))) a0;
247
            (Format.fprintf fmt "(";
248
            ((fun x  ->
249
              ignore
250
              (List.fold_left
251
                (fun sep  ->
252
                  fun x  ->
253
                    if sep then Format.fprintf fmt ",@ ";
254
                      ((__4 ()) fmt) x;
255
                    true) false x))) a0;
256
             Format.fprintf fmt ")");
209 257
        | Void  -> Format.pp_print_string fmt "")
210 258
    [@ocaml.warning "-A"])
211 259

  
212 260
and show_vhdl_type_t : vhdl_type_t -> Ppx_deriving_runtime.string =
213 261
  fun x  -> Format.asprintf "%a" pp_vhdl_type_t x
214 262

  
263
and pp_vhdl_element_declaration_t :
264
  Format.formatter -> vhdl_element_declaration_t -> Ppx_deriving_runtime.unit
265
  =
266
  let __1 () = pp_vhdl_subtype_indication_t
267
  
268
  and __0 () = pp_vhdl_name_t
269
   in
270
  ((let open! Ppx_deriving_runtime in
271
      fun fmt  ->
272
        fun x  ->
273
            (fun x  ->
274
                ignore
275
                  (List.fold_left
276
                     (fun sep  ->
277
                        fun x  ->
278
                          if sep then Format.fprintf fmt ",@ ";
279
                          ((__0 ()) fmt) x;
280
                          true) false x)) x.names;
281
           Format.fprintf fmt ":@ ";
282
           ((__1 ()) fmt) x.definition)
283
    [@ocaml.warning "-A"])
284

  
285
and show_vhdl_element_declaration_t :
286
  vhdl_element_declaration_t -> Ppx_deriving_runtime.string =
287
  fun x  -> Format.asprintf "%a" pp_vhdl_element_declaration_t x
288

  
215 289
and pp_vhdl_subtype_indication_t :
216 290
  Format.formatter -> vhdl_subtype_indication_t -> Ppx_deriving_runtime.unit
217 291
  =
......
738 812
            [`String "Bit_vector";
739 813
            ((fun (x : Ppx_deriving_runtime.int)  -> `Int x)) arg0;
740 814
            ((fun (x : Ppx_deriving_runtime.int)  -> `Int x)) arg1]
741
      | Array (arg0,arg1,arg2) ->
815
      | Array arg0 ->
742 816
          `List
743
            [`String "Array";
744
            ((fun (x : Ppx_deriving_runtime.int)  -> `Int x)) arg0;
745
            ((fun (x : Ppx_deriving_runtime.int)  -> `Int x)) arg1;
746
            ((fun x  -> vhdl_type_t_to_yojson x)) arg2]
747
      | Enumerated arg0 ->
817
            [`String "ARRAY_TYPE_DEFINITION";
818
            (let fields = []  in
819
             let fields =
820
               ("definition",
821
                 ((fun x  -> vhdl_subtype_indication_t_to_yojson x)
822
                    arg0.definition))
823
               :: fields  in
824
             let fields =
825
               if arg0.const = None
826
               then fields
827
               else
828
                 ("const",
829
                   (((function
830
                      | None  -> `Null
831
                      | Some x ->
832
                          ((fun x  -> vhdl_constraint_t_to_yojson x)) x))
833
                      arg0.const))
834
                 :: fields
835
                in
836
             let fields =
837
               ("indexes",
838
                 ((fun x  ->
839
                     `List (List.map (fun x  -> vhdl_name_t_to_yojson x) x))
840
                    arg0.indexes))
841
               :: fields  in
842
             `Assoc fields)]
843
      | Record arg0 ->
748 844
          `List
749
            [`String "Enumerated";
845
            [`String "RECORD_TYPE_DEFINITION";
750 846
            ((fun x  ->
751 847
                `List
752 848
                  (List.map
753
                     (fun (x : Ppx_deriving_runtime.string)  -> `String x) x)))
849
                     (fun x  -> vhdl_element_declaration_t_to_yojson x) x)))
754 850
              arg0]
851
      | Enumerated arg0 ->
852
          `List
853
            [`String "ENUMERATION_TYPE_DEFINITION";
854
            ((fun x  ->
855
                `List (List.map (fun x  -> vhdl_name_t_to_yojson x) x))) arg0]
755 856
      | Void  -> `List [`String "Void"])
756 857
  [@ocaml.warning "-A"])
757 858

  
......
792 893
                  | `Int x -> Result.Ok x
793 894
                  | _ -> Result.Error "Vhdl_ast.vhdl_type_t") arg0) >>=
794 895
                  (fun arg0  -> Result.Ok (Bit_vector (arg0, arg1)))))
795
      | `List ((`String "Array")::arg0::arg1::arg2::[]) ->
796
          ((fun x  -> vhdl_type_t_of_yojson x) arg2) >>=
797
            ((fun arg2  ->
798
                ((function
799
                  | `Int x -> Result.Ok x
800
                  | _ -> Result.Error "Vhdl_ast.vhdl_type_t") arg1) >>=
801
                  (fun arg1  ->
802
                     ((function
803
                       | `Int x -> Result.Ok x
804
                       | _ -> Result.Error "Vhdl_ast.vhdl_type_t") arg0) >>=
805
                       (fun arg0  -> Result.Ok (Array (arg0, arg1, arg2))))))
806
      | `List ((`String "Enumerated")::arg0::[]) ->
896
      | `List ((`String "ARRAY_TYPE_DEFINITION")::arg0::[]) ->
897
          ((function
898
            | `Assoc xs ->
899
                let rec loop xs ((arg0,arg1,arg2) as _state) =
900
                  match xs with
901
                  | ("indexes",x)::xs ->
902
                      loop xs
903
                        (((function
904
                           | `List xs ->
905
                               map_bind (fun x  -> vhdl_name_t_of_yojson x)
906
                                 [] xs
907
                           | _ -> Result.Error "Vhdl_ast.vhdl_type_t.indexes")
908
                            x), arg1, arg2)
909
                  | ("const",x)::xs ->
910
                      loop xs
911
                        (arg0,
912
                          ((function
913
                            | `Null -> Result.Ok None
914
                            | x ->
915
                                ((fun x  -> vhdl_constraint_t_of_yojson x) x)
916
                                  >>= ((fun x  -> Result.Ok (Some x)))) x),
917
                          arg2)
918
                  | ("definition",x)::xs ->
919
                      loop xs
920
                        (arg0, arg1,
921
                          ((fun x  -> vhdl_subtype_indication_t_of_yojson x)
922
                             x))
923
                  | [] ->
924
                      arg2 >>=
925
                        ((fun arg2  ->
926
                            arg1 >>=
927
                              (fun arg1  ->
928
                                 arg0 >>=
929
                                   (fun arg0  ->
930
                                      Result.Ok
931
                                        (Array
932
                                           {
933
                                             indexes = arg0;
934
                                             const = arg1;
935
                                             definition = arg2
936
                                           })))))
937
                  | _::xs -> loop xs _state  in
938
                loop xs
939
                  ((Result.Error "Vhdl_ast.vhdl_type_t.indexes"),
940
                    (Result.Ok None),
941
                    (Result.Error "Vhdl_ast.vhdl_type_t.definition"))
942
            | _ -> Result.Error "Vhdl_ast.vhdl_type_t")) arg0
943
      | `List ((`String "RECORD_TYPE_DEFINITION")::arg0::[]) ->
807 944
          ((function
808 945
            | `List xs ->
809
                map_bind
810
                  (function
811
                   | `String x -> Result.Ok x
812
                   | _ -> Result.Error "Vhdl_ast.vhdl_type_t") [] xs
946
                map_bind (fun x  -> vhdl_element_declaration_t_of_yojson x)
947
                  [] xs
948
            | _ -> Result.Error "Vhdl_ast.vhdl_type_t") arg0) >>=
949
            ((fun arg0  -> Result.Ok (Record arg0)))
950
      | `List ((`String "ENUMERATION_TYPE_DEFINITION")::arg0::[]) ->
951
          ((function
952
            | `List xs -> map_bind (fun x  -> vhdl_name_t_of_yojson x) [] xs
813 953
            | _ -> Result.Error "Vhdl_ast.vhdl_type_t") arg0) >>=
814 954
            ((fun arg0  -> Result.Ok (Enumerated arg0)))
815 955
      | `List ((`String "Void")::[]) -> Result.Ok Void
816 956
      | _ -> Result.Error "Vhdl_ast.vhdl_type_t")
817 957
  [@ocaml.warning "-A"])
818 958

  
959
and (vhdl_element_declaration_t_to_yojson :
960
      vhdl_element_declaration_t -> Yojson.Safe.json)
961
  =
962
  ((let open! Ppx_deriving_yojson_runtime in
963
      fun x  ->
964
        let fields = []  in
965
        let fields =
966
          ("definition",
967
            ((fun x  -> vhdl_subtype_indication_t_to_yojson x) x.definition))
968
          :: fields  in
969
        let fields =
970
          ("names",
971
            ((fun x  ->
972
                `List (List.map (fun x  -> vhdl_name_t_to_yojson x) x))
973
               x.names))
974
          :: fields  in
975
        `Assoc fields)
976
  [@ocaml.warning "-A"])
977

  
978
and (vhdl_element_declaration_t_of_yojson :
979
      Yojson.Safe.json ->
980
        vhdl_element_declaration_t Ppx_deriving_yojson_runtime.error_or)
981
  =
982
  ((let open! Ppx_deriving_yojson_runtime in
983
      function
984
      | `Assoc xs ->
985
          let rec loop xs ((arg0,arg1) as _state) =
986
            match xs with
987
            | ("names",x)::xs ->
988
                loop xs
989
                  (((function
990
                     | `List xs ->
991
                         map_bind (fun x  -> vhdl_name_t_of_yojson x) [] xs
992
                     | _ ->
993
                         Result.Error
994
                           "Vhdl_ast.vhdl_element_declaration_t.names") x),
995
                    arg1)
996
            | ("definition",x)::xs ->
997
                loop xs
998
                  (arg0,
999
                    ((fun x  -> vhdl_subtype_indication_t_of_yojson x) x))
1000
            | [] ->
1001
                arg1 >>=
1002
                  ((fun arg1  ->
1003
                      arg0 >>=
1004
                        (fun arg0  ->
1005
                           Result.Ok { names = arg0; definition = arg1 })))
1006
            | _::xs -> loop xs _state  in
1007
          loop xs
1008
            ((Result.Error "Vhdl_ast.vhdl_element_declaration_t.names"),
1009
              (Result.Error "Vhdl_ast.vhdl_element_declaration_t.definition"))
1010
      | _ -> Result.Error "Vhdl_ast.vhdl_element_declaration_t")
1011
  [@ocaml.warning "-A"])
1012

  
819 1013
and (vhdl_subtype_indication_t_to_yojson :
820 1014
      vhdl_subtype_indication_t -> Yojson.Safe.json)
821 1015
  =
......
5484 5678
type vhdl_package_t =
5485 5679
  {
5486 5680
  name: vhdl_name_t [@default NoName];
5487
  shared_defs: vhdl_definition_t list [@default []]}
5681
  shared_defs: vhdl_definition_t list [@default []];
5682
  shared_decls: vhdl_declaration_t list [@default []]}
5488 5683

  
5489 5684
let rec pp_vhdl_package_t :
5490 5685
  Format.formatter -> vhdl_package_t -> Ppx_deriving_runtime.unit =
5491
  let __1 () = pp_vhdl_definition_t
5686
  let __2 () = pp_vhdl_declaration_t
5687

  
5688
  and __1 () = pp_vhdl_definition_t
5492 5689
  
5493 5690
  and __0 () = pp_vhdl_name_t
5494 5691
   in
......
5505 5702
                       if sep then Format.fprintf fmt "";
5506 5703
                       ((__1 ()) fmt) x;
5507 5704
                       Format.fprintf fmt ";";
5508
                       true) false x))) x.shared_defs;)
5705
                       true) false x))) x.shared_defs;
5706
          ((fun x  ->
5707
               ignore
5708
                 (List.fold_left
5709
                    (fun sep  ->
5710
                       fun x  ->
5711
                         if sep then Format.fprintf fmt "";
5712
                         ((__2 ()) fmt) x;
5713
                         true) false x))) x.shared_decls;)
5509 5714
    [@ocaml.warning "-A"])
5510 5715

  
5511 5716
and show_vhdl_package_t : vhdl_package_t -> Ppx_deriving_runtime.string =
......
5516 5721
      fun x  ->
5517 5722
        let fields = []  in
5518 5723
        let fields =
5724
          if x.shared_decls = []
5725
          then fields
5726
          else
5727
            ("shared_decls",
5728
              (((fun x  ->
5729
                   `List
5730
                     (List.map (fun x  -> vhdl_declaration_t_to_yojson x) x)))
5731
                 x.shared_decls))
5732
            :: fields
5733
           in
5734
        let fields =
5519 5735
          if x.shared_defs = []
5520 5736
          then fields
5521 5737
          else
......
5541 5757
  ((let open! Ppx_deriving_yojson_runtime in
5542 5758
      function
5543 5759
      | `Assoc xs ->
5544
          let rec loop xs ((arg0,arg1) as _state) =
5760
          let rec loop xs ((arg0,arg1,arg2) as _state) =
5545 5761
            match xs with
5546 5762
            | ("name",x)::xs ->
5547
                loop xs (((fun x  -> vhdl_name_t_of_yojson x) x), arg1)
5763
                loop xs (((fun x  -> vhdl_name_t_of_yojson x) x), arg1, arg2)
5548 5764
            | ("shared_defs",x)::xs ->
5549 5765
                loop xs
5550 5766
                  (arg0,
......
5554 5770
                            [] xs
5555 5771
                      | _ ->
5556 5772
                          Result.Error "Vhdl_ast.vhdl_package_t.shared_defs")
5773
                       x), arg2)
5774
            | ("shared_decls",x)::xs ->
5775
                loop xs
5776
                  (arg0, arg1,
5777
                    ((function
5778
                      | `List xs ->
5779
                          map_bind (fun x  -> vhdl_declaration_t_of_yojson x)
5780
                            [] xs
5781
                      | _ ->
5782
                          Result.Error "Vhdl_ast.vhdl_package_t.shared_decls")
5557 5783
                       x))
5558 5784
            | [] ->
5559
                arg1 >>=
5560
                  ((fun arg1  ->
5561
                      arg0 >>=
5562
                        (fun arg0  ->
5563
                           Result.Ok { name = arg0; shared_defs = arg1 })))
5785
                arg2 >>=
5786
                  ((fun arg2  ->
5787
                      arg1 >>=
5788
                        (fun arg1  ->
5789
                           arg0 >>=
5790
                             (fun arg0  ->
5791
                                Result.Ok
5792
                                  {
5793
                                    name = arg0;
5794
                                    shared_defs = arg1;
5795
                                    shared_decls = arg2
5796
                                  }))))
5564 5797
            | _::xs -> loop xs _state  in
5565
          loop xs ((Result.Ok NoName), (Result.Ok []))
5798
          loop xs ((Result.Ok NoName), (Result.Ok []), (Result.Ok []))
5566 5799
      | _ -> Result.Error "Vhdl_ast.vhdl_package_t")
5567 5800
  [@ocaml.warning "-A"])
5568 5801

  

Also available in: Unified diff