Project

General

Profile

« Previous | Next » 

Revision 27332198

Added by Arnaud Dieumegard over 6 years ago

Added support for component instantiation

View differences:

src/backends/VHDL/vhdl_ast.ml
248 248
    delay: vhdl_expr_t option;
249 249
  }
250 250
[@@deriving show { with_path = false }, yojson {strict = false}];;
251
			   
251

  
252
type vhdl_component_instantiation_t =
253
  {
254
    name: vhdl_name_t;
255
    inst_unit: vhdl_name_t;
256
    generic_map: vhdl_assoc_element_t option [@default None];
257
    port_map: vhdl_assoc_element_t option [@default None];
258
  }
259
[@@deriving show { with_path = false }, yojson {strict = false}];;
260

  
252 261
type vhdl_concurrent_stmt_t =
253 262
  | SigAssign of vhdl_conditional_signal_t [@name "CONDITIONAL_SIGNAL_ASSIGNMENT"]
254 263
  | Process of vhdl_process_t [@name "PROCESS_STATEMENT"]
255 264
  | SelectedSig of vhdl_selected_signal_t [@name "SELECTED_SIGNAL_ASSIGNMENT"]
265
  | ComponentInst of vhdl_component_instantiation_t [@name "COMPONENT_INSTANTIATION_STATEMENT"]
256 266
[@@deriving show { with_path = false }, yojson {strict = false}];;
257 267
  (*
258 268
type vhdl_statement_t =
src/backends/VHDL/vhdl_ast_deriving.ml
4747 4747
      | _ -> Result.Error "Vhdl_ast.vhdl_selected_signal_t")
4748 4748
  [@ocaml.warning "-A"])
4749 4749

  
4750
type vhdl_component_instantiation_t =
4751
  {
4752
  name: vhdl_name_t ;
4753
  inst_unit: vhdl_name_t ;
4754
  generic_map: vhdl_assoc_element_t option [@default None];
4755
  port_map: vhdl_assoc_element_t option [@default None]}[@@deriving
4756
                                                          ((show
4757
                                                              {
4758
                                                                with_path =
4759
                                                                  false
4760
                                                              }),
4761
                                                            (yojson
4762
                                                               {
4763
                                                                 strict =
4764
                                                                   false
4765
                                                               }))]
4766
(* TODO *)
4767
let rec pp_vhdl_component_instantiation_t :
4768
  Format.formatter ->
4769
    vhdl_component_instantiation_t -> Ppx_deriving_runtime.unit
4770
  =
4771
  let __3 () = pp_vhdl_assoc_element_t
4772
  
4773
  and __2 () = pp_vhdl_assoc_element_t
4774
  
4775
  and __1 () = pp_vhdl_name_t
4776
  
4777
  and __0 () = pp_vhdl_name_t
4778
   in
4779
  ((let open! Ppx_deriving_runtime in
4780
      fun fmt  ->
4781
        fun x  ->
4782
          Format.fprintf fmt "@[<2>{ ";
4783
          ((((Format.fprintf fmt "@[%s =@ " "name";
4784
              ((__0 ()) fmt) x.name;
4785
              Format.fprintf fmt "@]");
4786
             Format.fprintf fmt ";@ ";
4787
             Format.fprintf fmt "@[%s =@ " "inst_unit";
4788
             ((__1 ()) fmt) x.inst_unit;
4789
             Format.fprintf fmt "@]");
4790
            Format.fprintf fmt ";@ ";
4791
            Format.fprintf fmt "@[%s =@ " "generic_map";
4792
            ((function
4793
              | None  -> Format.pp_print_string fmt "None"
4794
              | Some x ->
4795
                  (Format.pp_print_string fmt "(Some ";
4796
                   ((__2 ()) fmt) x;
4797
                   Format.pp_print_string fmt ")"))) x.generic_map;
4798
            Format.fprintf fmt "@]");
4799
           Format.fprintf fmt ";@ ";
4800
           Format.fprintf fmt "@[%s =@ " "port_map";
4801
           ((function
4802
             | None  -> Format.pp_print_string fmt "None"
4803
             | Some x ->
4804
                 (Format.pp_print_string fmt "(Some ";
4805
                  ((__3 ()) fmt) x;
4806
                  Format.pp_print_string fmt ")"))) x.port_map;
4807
           Format.fprintf fmt "@]");
4808
          Format.fprintf fmt "@ }@]")
4809
    [@ocaml.warning "-A"])
4810

  
4811
and show_vhdl_component_instantiation_t :
4812
  vhdl_component_instantiation_t -> Ppx_deriving_runtime.string =
4813
  fun x  -> Format.asprintf "%a" pp_vhdl_component_instantiation_t x
4814

  
4815
let rec (vhdl_component_instantiation_t_to_yojson :
4816
          vhdl_component_instantiation_t -> Yojson.Safe.json)
4817
  =
4818
  ((let open! Ppx_deriving_yojson_runtime in
4819
      fun x  ->
4820
        let fields = []  in
4821
        let fields =
4822
          if x.port_map = None
4823
          then fields
4824
          else
4825
            ("port_map",
4826
              (((function
4827
                 | None  -> `Null
4828
                 | Some x -> ((fun x  -> vhdl_assoc_element_t_to_yojson x)) x))
4829
                 x.port_map))
4830
            :: fields
4831
           in
4832
        let fields =
4833
          if x.generic_map = None
4834
          then fields
4835
          else
4836
            ("generic_map",
4837
              (((function
4838
                 | None  -> `Null
4839
                 | Some x -> ((fun x  -> vhdl_assoc_element_t_to_yojson x)) x))
4840
                 x.generic_map))
4841
            :: fields
4842
           in
4843
        let fields =
4844
          ("inst_unit", ((fun x  -> vhdl_name_t_to_yojson x) x.inst_unit)) ::
4845
          fields  in
4846
        let fields = ("name", ((fun x  -> vhdl_name_t_to_yojson x) x.name))
4847
          :: fields  in
4848
        `Assoc fields)
4849
  [@ocaml.warning "-A"])
4850

  
4851
and (vhdl_component_instantiation_t_of_yojson :
4852
      Yojson.Safe.json ->
4853
        vhdl_component_instantiation_t Ppx_deriving_yojson_runtime.error_or)
4854
  =
4855
  ((let open! Ppx_deriving_yojson_runtime in
4856
      function
4857
      | `Assoc xs ->
4858
          let rec loop xs ((arg0,arg1,arg2,arg3) as _state) =
4859
            match xs with
4860
            | ("name",x)::xs ->
4861
                loop xs
4862
                  (((fun x  -> vhdl_name_t_of_yojson x) x), arg1, arg2, arg3)
4863
            | ("inst_unit",x)::xs ->
4864
                loop xs
4865
                  (arg0, ((fun x  -> vhdl_name_t_of_yojson x) x), arg2, arg3)
4866
            | ("generic_map",x)::xs ->
4867
                loop xs
4868
                  (arg0, arg1,
4869
                    ((function
4870
                      | `Null -> Result.Ok None
4871
                      | x ->
4872
                          ((fun x  -> vhdl_assoc_element_t_of_yojson x) x)
4873
                            >>= ((fun x  -> Result.Ok (Some x)))) x), arg3)
4874
            | ("port_map",x)::xs ->
4875
                loop xs
4876
                  (arg0, arg1, arg2,
4877
                    ((function
4878
                      | `Null -> Result.Ok None
4879
                      | x ->
4880
                          ((fun x  -> vhdl_assoc_element_t_of_yojson x) x)
4881
                            >>= ((fun x  -> Result.Ok (Some x)))) x))
4882
            | [] ->
4883
                arg3 >>=
4884
                  ((fun arg3  ->
4885
                      arg2 >>=
4886
                        (fun arg2  ->
4887
                           arg1 >>=
4888
                             (fun arg1  ->
4889
                                arg0 >>=
4890
                                  (fun arg0  ->
4891
                                     Result.Ok
4892
                                       {
4893
                                         name = arg0;
4894
                                         inst_unit = arg1;
4895
                                         generic_map = arg2;
4896
                                         port_map = arg3
4897
                                       })))))
4898
            | _::xs -> loop xs _state  in
4899
          loop xs
4900
            ((Result.Error "Vhdl_ast.vhdl_component_instantiation_t.name"),
4901
              (Result.Error
4902
                 "Vhdl_ast.vhdl_component_instantiation_t.inst_unit"),
4903
              (Result.Ok None), (Result.Ok None))
4904
      | _ -> Result.Error "Vhdl_ast.vhdl_component_instantiation_t")
4905
  [@ocaml.warning "-A"])
4750 4906
type vhdl_concurrent_stmt_t =
4751 4907
  | SigAssign of vhdl_conditional_signal_t
4752 4908
  [@name "CONDITIONAL_SIGNAL_ASSIGNMENT"]
4753 4909
  | Process of vhdl_process_t [@name "PROCESS_STATEMENT"]
4754 4910
  | SelectedSig of vhdl_selected_signal_t
4755 4911
  [@name "SELECTED_SIGNAL_ASSIGNMENT"]
4912
  | ComponentInst of vhdl_component_instantiation_t
4913
  [@name "COMPONENT_INSTANTIATION_STATEMENT"]
4756 4914

  
4757 4915
let rec pp_vhdl_concurrent_stmt_t :
4758 4916
  Format.formatter -> vhdl_concurrent_stmt_t -> Ppx_deriving_runtime.unit =
4759
  let __2 () = pp_vhdl_selected_signal_t
4917
  let __3 () = pp_vhdl_component_instantiation_t
4918
  
4919
  and __2 () = pp_vhdl_selected_signal_t
4760 4920
  
4761 4921
  and __1 () = pp_vhdl_process_t
4762 4922
  
......
4771 4931
             ((__1 ()) fmt) a0;
4772 4932
        | SelectedSig a0 ->
4773 4933
             ((__2 ()) fmt) a0;
4934
        | ComponentInst a0 ->
4935
             ((__3 ()) fmt) a0;
4774 4936
    )
4775 4937
    [@ocaml.warning "-A"])
4776 4938

  
......
4794 4956
      | SelectedSig arg0 ->
4795 4957
          `List
4796 4958
            [`String "SELECTED_SIGNAL_ASSIGNMENT";
4797
            ((fun x  -> vhdl_selected_signal_t_to_yojson x)) arg0])
4959
            ((fun x  -> vhdl_selected_signal_t_to_yojson x)) arg0]
4960
      | ComponentInst arg0 ->
4961
          `List
4962
            [`String "COMPONENT_INSTANTIATION_STATEMENT";
4963
            ((fun x  -> vhdl_component_instantiation_t_to_yojson x)) arg0])
4798 4964
  [@ocaml.warning "-A"])
4799 4965

  
4800 4966
and (vhdl_concurrent_stmt_t_of_yojson :
......
4812 4978
      | `List ((`String "SELECTED_SIGNAL_ASSIGNMENT")::arg0::[]) ->
4813 4979
          ((fun x  -> vhdl_selected_signal_t_of_yojson x) arg0) >>=
4814 4980
            ((fun arg0  -> Result.Ok (SelectedSig arg0)))
4981
      | `List ((`String "COMPONENT_INSTANTIATION_STATEMENT")::arg0::[]) ->
4982
          ((fun x  -> vhdl_component_instantiation_t_of_yojson x) arg0) >>=
4983
            ((fun arg0  -> Result.Ok (ComponentInst arg0)))
4815 4984
      | _ -> Result.Error "Vhdl_ast.vhdl_concurrent_stmt_t")
4816 4985
  [@ocaml.warning "-A"])
4817 4986

  
src/backends/VHDL/vhdl_ast_map.ml
27 27
let _ = fun (_ : vhdl_process_t)  -> () 
28 28
let _ = fun (_ : vhdl_selected_signal_t)  -> () 
29 29
let _ = fun (_ : vhdl_port_mode_t)  -> () 
30
let _ = fun (_ : vhdl_component_instantiation_t)  -> ()
30 31
let _ = fun (_ : vhdl_concurrent_stmt_t)  -> () 
31 32
let _ = fun (_ : vhdl_port_t)  -> () 
32 33
let _ = fun (_ : vhdl_entity_t)  -> () 
......
65 66
    method virtual  vhdl_subprogram_spec_t : vhdl_subprogram_spec_t -> vhdl_subprogram_spec_t
66 67
    method virtual  vhdl_discrete_range_t : vhdl_discrete_range_t -> vhdl_discrete_range_t
67 68
    method virtual  vhdl_parameter_t : vhdl_parameter_t -> vhdl_parameter_t
69
    method virtual  vhdl_component_instantiation_t : vhdl_component_instantiation_t -> vhdl_component_instantiation_t
68 70
    method virtual  vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t
69 71
    method virtual  vhdl_declaration_t : vhdl_declaration_t -> vhdl_declaration_t
70 72
    method virtual  vhdl_architecture_t : vhdl_architecture_t -> vhdl_architecture_t
......
398 400
    method vhdl_port_mode_t : vhdl_port_mode_t -> vhdl_port_mode_t=
399 401
      fun x  -> x
400 402

  
403
    method vhdl_component_instantiation_t :
404
      vhdl_component_instantiation_t -> vhdl_component_instantiation_t=
405
      fun { name; inst_unit; generic_map; port_map }  ->
406
        let name = self#vhdl_name_t name  in
407
        let inst_unit = self#vhdl_name_t inst_unit  in
408
        let generic_map = self#option self#vhdl_assoc_element_t generic_map
409
           in
410
        let port_map = self#option self#vhdl_assoc_element_t port_map  in
411
        { name; inst_unit; generic_map; port_map }
412

  
401 413
    method vhdl_concurrent_stmt_t :
402 414
      vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t=
403 415
      fun x  ->
......
405 417
        | SigAssign a -> let a = self#vhdl_conditional_signal_t a  in SigAssign a
406 418
        | Process a -> let a = self#vhdl_process_t a  in Process a
407 419
        | SelectedSig a -> let a = self#vhdl_selected_signal_t a  in SelectedSig a
420
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a 
408 421

  
409 422
    method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
410 423
      fun { names; mode; typ; expr }  ->
src/tools/importer/vhdl_to_lustre.ml
29 29
let _ = fun (_ : vhdl_process_t)  -> () 
30 30
let _ = fun (_ : vhdl_selected_signal_t)  -> () 
31 31
let _ = fun (_ : vhdl_port_mode_t)  -> () 
32
let _ = fun (_ : vhdl_component_instantiation_t)  -> ()
32 33
let _ = fun (_ : vhdl_concurrent_stmt_t)  -> () 
33 34
let _ = fun (_ : vhdl_port_t)  -> () 
34 35
let _ = fun (_ : vhdl_entity_t)  -> () 
......
67 68
    method virtual  vhdl_subprogram_spec_t : vhdl_subprogram_spec_t -> vhdl_subprogram_spec_t
68 69
    method virtual  vhdl_discrete_range_t : vhdl_discrete_range_t -> vhdl_discrete_range_t
69 70
    method virtual  vhdl_parameter_t : vhdl_parameter_t -> vhdl_parameter_t
71
    method virtual  vhdl_component_instantiation_t : vhdl_component_instantiation_t -> vhdl_component_instantiation_t
70 72
    method virtual  vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t
71 73
    method virtual  vhdl_declaration_t : vhdl_declaration_t -> vhdl_declaration_t
72 74
    method virtual  vhdl_architecture_t : vhdl_architecture_t -> vhdl_architecture_t
......
400 402
    method vhdl_port_mode_t : vhdl_port_mode_t -> vhdl_port_mode_t=
401 403
      fun x  -> x
402 404

  
405
    method vhdl_component_instantiation_t :
406
      vhdl_component_instantiation_t -> vhdl_component_instantiation_t=
407
      fun { name; inst_unit; generic_map; port_map }  ->
408
        let name = self#vhdl_name_t name  in
409
        let inst_unit = self#vhdl_name_t inst_unit  in
410
        let generic_map = self#option self#vhdl_assoc_element_t generic_map
411
           in
412
        let port_map = self#option self#vhdl_assoc_element_t port_map  in
413
        { name; inst_unit; generic_map; port_map }
414

  
403 415
    method vhdl_concurrent_stmt_t :
404 416
      vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t=
405 417
      fun x  ->
......
407 419
        | SigAssign a -> let a = self#vhdl_conditional_signal_t a  in SigAssign a
408 420
        | Process a -> let a = self#vhdl_process_t a  in Process a
409 421
        | SelectedSig a -> let a = self#vhdl_selected_signal_t a  in SelectedSig a
422
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a 
410 423

  
411 424
    method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
412 425
      fun { names; mode; typ; expr }  ->

Also available in: Unified diff