Project

General

Profile

« Previous | Next » 

Revision 20d354f4

Added by Arnaud Dieumegard over 3 years ago

Update of types fields names

View differences:

src/backends/VHDL/mini_vhdl_ast_pp.ml
551 551
      fun fmt  ->
552 552
        fun x  ->
553 553
          Format.fprintf fmt "@[<v 2>";
554
          ((__0 ()) fmt) x.name;
554
          ((__0 ()) fmt) x.ci_name;
555 555
          Format.fprintf fmt "__";
556
          ((__0 ()) fmt) x.archi.name;
556
          ((__0 ()) fmt) x.archi.a_name;
557 557
          Format.fprintf fmt "__";
558
          ((__0 ()) fmt) x.entity.name;
558
          ((__0 ()) fmt) x.entity.e_name;
559 559
          (match x.generic_map with
560 560
          | [] -> Format.fprintf fmt "";
561 561
          | _ ->
......
622 622
                              true) false x))) x.active_sigs;
623 623
                 Format.fprintf fmt ")");
624 624
          Format.fprintf fmt " is";
625
          (match x.declarations with
625
          (match x.p_declarations with
626 626
          | [] -> Format.fprintf fmt "";
627 627
          | _ -> 
628 628
              (Format.fprintf fmt "@;";
......
634 634
                      if sep then Format.fprintf fmt "@;";
635 635
                        ((__1 ()) fmt) x;
636 636
                        Format.fprintf fmt ";";
637
                        true) false x))) x.declarations));
637
                        true) false x))) x.p_declarations));
638 638
          Format.fprintf fmt "@]@;@[<v 2>begin@;";
639 639
          ((fun x  ->
640 640
               ignore
......
644 644
                         if sep then Format.fprintf fmt "@;";
645 645
                         ((__3 ()) fmt) x;
646 646
                         Format.fprintf fmt ";";
647
                         true) false x);)) x.body;
647
                         true) false x);)) x.p_body;
648 648
          Format.fprintf fmt "@]@;end process;")
649 649
    [@ocaml.warning "-A"])
650 650

  
......
689 689
        fun x  ->
690 690
          Format.fprintf fmt "@[<2>{ ";
691 691
          ((((Format.fprintf fmt "@[%s =@ " "name";
692
              ((__0 ()) fmt) x.name;
692
              ((__0 ()) fmt) x.p_name;
693 693
              Format.fprintf fmt "@]");
694 694
             Format.fprintf fmt ";@ ";
695 695
             Format.fprintf fmt "@[%s =@ " "shared_defs";
......
807 807
                    if sep then Format.fprintf fmt ";@;";
808 808
                      ((__3 ()) fmt) x;
809 809
                      true) false x))) x.contexts);
810
          (match x.declarations with
810
          (match x.c_declarations with
811 811
          | [] -> ()
812 812
          | _ ->
813 813
            Format.fprintf fmt "@;";
......
819 819
                    if sep then Format.fprintf fmt "@;";
820 820
                      ((__4 ()) fmt) x;
821 821
                      Format.fprintf fmt ";";
822
                      true) false x))) x.declarations);
822
                      true) false x))) x.c_declarations);
823 823
          (match x.definitions with
824 824
          | [] -> ()
825 825
          | _ ->
......
834 834
                      Format.fprintf fmt ";";
835 835
                      true) false x))) x.definitions);
836 836
          Format.fprintf fmt "@]@;@[<v 2>begin";
837
          (match x.body with
837
          (match x.c_body with
838 838
          | [] -> ()
839 839
          | _ ->
840 840
            Format.fprintf fmt "@;";
......
845 845
                  fun x  ->
846 846
                    if sep then Format.fprintf fmt "@;";
847 847
                      ((__6 ()) fmt) x;
848
                         true) false x))) x.body);
848
                         true) false x))) x.c_body);
849 849
           Format.fprintf fmt "@]@;end;")
850 850
    [@ocaml.warning "-A"])
851 851

  
src/backends/VHDL/mini_vhdl_utils.ml
15 15
let rec get_ports: vhdl_port_t list -> vhdl_port_mode_t -> vhdl_port_t list= 
16 16
  fun l -> fun m -> match l with 
17 17
    | [] -> [] 
18
    | hd::tl -> if hd.mode = m then hd::(get_ports tl m) else get_ports tl m
18
    | hd::tl -> if hd.port_mode = m then hd::(get_ports tl m) else get_ports tl m
19 19

  
20 20
let rec get_ports_pos: vhdl_port_t list -> vhdl_port_mode_t -> int -> int list= 
21 21
  fun l -> fun m -> fun index -> match l with 
22 22
    | [] -> []
23
    | hd::tl -> if hd.mode = m then index::(get_ports_pos tl m (index+1)) else get_ports_pos tl m (index+1)
23
    | hd::tl -> if hd.port_mode = m then index::(get_ports_pos tl m (index+1)) else get_ports_pos tl m (index+1)
24 24

  
25
let get_names : vhdl_port_t -> vhdl_name_t list= fun x -> x.names
25
let get_names : vhdl_port_t -> vhdl_name_t list= fun x -> x.port_names
26 26

  
27 27
let rec duplicates l1=
28 28
  match l1 with
src/backends/VHDL/vhdl_2_mini_vhdl_map.ml
196 196
 *)
197 197
    val mutable db : db_tuple_t list = []
198 198
    val mutable db_current : db_tuple_t = {
199
      entity = { name = NoName; generics = []; ports = []; declaration = []; stmts = [] };
200
      architecture = { name = NoName; entity = NoName; declarations = []; body = [] };
199
      entity = { e_name = NoName; generics = []; ports = []; e_declaration = []; stmts = [] };
200
      architecture = { a_name = NoName; entity = NoName; a_declarations = []; a_body = [] };
201 201
      architecture_signals = [];
202 202
      architecture_ports = [];
203 203
      architecture_generics = [];
......
220 220
      fun x ->
221 221
        let rec find a dbl =
222 222
          match dbl with
223
          | [] -> failwith ("No matching tuple in DB for architecture [" ^ self#to_string_vhdl_name_t x.name ^ "]")
223
          | [] -> failwith ("No matching tuple in DB for architecture [" ^ self#to_string_vhdl_name_t x.a_name ^ "]")
224 224
          | e::tl -> if (e.architecture = a) then (e.entity, e.contexts) else find a tl in find x db
225 225

  
226 226
    method get_tuple_from_archi_and_entity_name : (vhdl_name_t * vhdl_name_t) -> db_tuple_t=
......
232 232
          | [] -> failwith ("No matching tuple in DB for architecture [" ^ self#to_string_vhdl_name_t a_name ^
233 233
                           "] and entity [" ^ self#to_string_vhdl_name_t e_name ^ "]")
234 234
          | e::tl -> 
235
              let inner_e_arch_name = self#simplify_name_t e.architecture.name in
236
              let inner_e_ent_name = self#simplify_name_t e.entity.name in
235
              let inner_e_arch_name = self#simplify_name_t e.architecture.a_name in
236
              let inner_e_ent_name = self#simplify_name_t e.entity.e_name in
237 237
              if ((inner_e_arch_name = a_name) && (inner_e_ent_name = e_name)) 
238 238
              then e 
239 239
              else find (a_name,e_name) tl in 
......
244 244
      fun ( entities_pair, filter_name ) ->
245 245
      let rec filter ep n = match ep with
246 246
      | [] -> failwith ("Impossible to find an entity with name [" ^ self#to_string_vhdl_name_t filter_name ^ "]")
247
      | (c,{name; generics; ports; declaration; stmts})::tl -> 
248
          if (name = n) then 
247
      | (c,{e_name; generics; ports; e_declaration; stmts})::tl -> 
248
          if (e_name = n) then 
249 249
            List.hd ep
250 250
          else filter (List.tl ep) n in
251 251
      filter entities_pair filter_name
......
259 259
    method declarative_items_declarations : vhdl_declarative_item_t list -> vhdl_declaration_t list =
260 260
      fun x ->
261 261
        match x with
262
        | {use_clause=_; declaration=Some a;definition=_}::tl -> a::(self#declarative_items_declarations tl)
262
        | {use_clause=_; di_declaration=Some a; di_definition=_}::tl -> a::(self#declarative_items_declarations tl)
263 263
        | _::tl -> self#declarative_items_declarations tl
264 264
        | [] -> []
265 265

  
266 266
    method declarative_items_definitions : vhdl_declarative_item_t list -> vhdl_definition_t list =
267 267
      fun x ->
268 268
        match x with
269
        | {use_clause=_; declaration=_;definition=Some a}::tl -> a::(self#declarative_items_definitions tl)
269
        | {use_clause=_; di_declaration=_; di_definition=Some a}::tl -> a::(self#declarative_items_definitions tl)
270 270
        | _::tl -> self#declarative_items_definitions tl
271 271
        | [] -> []
272 272

  
273 273
    method declarative_items_uses : vhdl_declarative_item_t list -> vhdl_load_t list =
274 274
      fun x ->
275 275
        match x with
276
        | {use_clause=Some a; declaration=_;definition=_}::tl -> a::(self#declarative_items_uses tl)
276
        | {use_clause=Some a; di_declaration=_; di_definition=_}::tl -> a::(self#declarative_items_uses tl)
277 277
        | _::tl -> self#declarative_items_uses tl
278 278
        | [] -> []
279 279
(******************
......
287 287
      fun x ->
288 288
        match x with
289 289
        | Process a -> List.sort_uniq compare (
290
            List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names a.body)
290
            List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names a.p_body)
291 291
          )
292 292
        | ComponentInst a ->
293 293
            let out_ports_positions = get_ports_pos a.entity.ports OutPort 0 in
......
324 324
    method mini_vhdl_concurrent_stmt_t_memories : vhdl_name_t list -> mini_vhdl_concurrent_stmt_t -> vhdl_name_t list=
325 325
      fun assigned_signals -> fun x ->
326 326
        match x with
327
        | Process a -> List.flatten (List.map (self#memories assigned_signals []) a.body)
327
        | Process a -> List.flatten (List.map (self#memories assigned_signals []) a.p_body)
328 328
        | ComponentInst a -> [] (* Nothing to be reported here as memories are checked for each component *)
329 329

  
330 330
    method memories: vhdl_name_t list -> vhdl_name_t list -> mini_vhdl_sequential_stmt_t -> vhdl_name_t list=
......
443 443

  
444 444
    method vhdl_element_declaration_t :
445 445
      vhdl_element_declaration_t -> vhdl_element_declaration_t=
446
      fun { names; definition }  ->
447
        let names = self#list self#lower_vhdl_name_t names  in
446
      fun { ed_names; definition }  ->
447
        let ed_names = self#list self#lower_vhdl_name_t ed_names  in
448 448
        let definition = self#vhdl_subtype_indication_t definition  in
449
        { names; definition }
449
        { ed_names; definition }
450 450

  
451 451
    method vhdl_subtype_indication_t :
452 452
      vhdl_subtype_indication_t -> vhdl_subtype_indication_t=
453
      fun { name; functionName; const }  ->
454
        let name = self#lower_vhdl_name_t name  in
453
      fun { si_name; functionName; const }  ->
454
        let si_name = self#lower_vhdl_name_t si_name  in
455 455
        let functionName = self#lower_vhdl_name_t functionName  in
456 456
        let const = self#vhdl_constraint_t const  in
457
        { name; functionName; const }
457
        { si_name; functionName; const }
458 458

  
459 459
    method vhdl_discrete_range_t :
460 460
      vhdl_discrete_range_t -> vhdl_discrete_range_t=
......
593 593
            let a = self#int a  in let b = self#int b  in SuffixRange (a, b)
594 594

  
595 595
    method vhdl_parameter_t : vhdl_parameter_t -> vhdl_parameter_t=
596
      fun { names; mode; typ; init_val }  ->
597
        let names = self#list self#lower_vhdl_name_t names  in
598
        let mode = self#list self#string mode  in
599
        let typ = self#vhdl_subtype_indication_t typ  in
596
      fun { parameter_names; parameter_mode; parameter_typ; init_val }  ->
597
        let parameter_names = self#list self#lower_vhdl_name_t parameter_names  in
598
        let parameter_mode = self#list self#string parameter_mode  in
599
        let parameter_typ = self#vhdl_subtype_indication_t parameter_typ  in
600 600
        let init_val = self#option self#vhdl_cst_val_t init_val  in
601
        { names; mode; typ; init_val }
601
        { parameter_names; parameter_mode; parameter_typ; init_val }
602 602

  
603 603
    method vhdl_subprogram_spec_t :
604 604
      vhdl_subprogram_spec_t -> vhdl_subprogram_spec_t=
605
      fun { name; subprogram_type; typeMark; parameters; isPure }  ->
606
        let name = self#string name  in
605
      fun { ss_name; subprogram_type; typeMark; parameters; isPure }  ->
606
        let ss_name = self#string ss_name  in
607 607
        let subprogram_type = self#string subprogram_type  in
608 608
        let typeMark = self#lower_vhdl_name_t typeMark  in
609 609
        let parameters = self#list self#vhdl_parameter_t parameters  in
610 610
        let isPure = self#bool isPure  in
611
        { name; subprogram_type; typeMark; parameters; isPure }
611
        { ss_name; subprogram_type; typeMark; parameters; isPure }
612 612

  
613 613
    method vhdl_sequential_stmt_t :
614 614
      vhdl_sequential_stmt_t -> mini_vhdl_sequential_stmt_t=
615 615
      fun x  ->
616 616
        match x with
617
        | VarAssign { label; lhs; rhs } ->
617
        | VarAssign { label; seqs_lhs; rhs } ->
618 618
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
619
            let lhs = self#lower_vhdl_name_t lhs  in
619
            let lhs = self#lower_vhdl_name_t seqs_lhs  in
620 620
            let rhs = self#vhdl_expr_t rhs  in VarAssign { label; lhs; rhs }
621
        | SigSeqAssign { label; lhs; rhs } ->
621
        | SigSeqAssign { label; seqs_lhs; rhs } ->
622 622
            let label = match label with NoName -> None | _ -> Some (self#lower_vhdl_name_t label) in
623
            let lhs = self#lower_vhdl_name_t lhs  in
623
            let lhs = self#lower_vhdl_name_t seqs_lhs  in
624 624
            let rhs = self#list self#vhdl_waveform_element_t rhs in
625 625
            SigSeqAssign { label; lhs; rhs }
626 626
        | If { label; if_cases; default } ->
......
703 703

  
704 704
    method vhdl_declarative_item_t :
705 705
      vhdl_declarative_item_t -> mini_vhdl_declarative_item_t=
706
      fun { use_clause; declaration; definition }  ->
706
      fun { use_clause; di_declaration; di_definition }  ->
707 707
        let use_clause = self#option self#vhdl_load_t use_clause  in
708 708
        let declaration = 
709
          match declaration with
709
          match di_declaration with
710 710
          | None -> None
711 711
          | Some a -> Some (self#vhdl_declaration_t a) in
712
        let definition = self#option self#vhdl_definition_t definition  in
712
        let definition = self#option self#vhdl_definition_t di_definition  in
713 713
        { use_clause; declaration; definition }
714 714

  
715 715
    method vhdl_waveform_element_t :
716 716
      vhdl_waveform_element_t -> vhdl_waveform_element_t=
717
      fun { value; delay }  ->
717
      fun { value; we_delay }  ->
718 718
        let value = self#option self#vhdl_expr_t value  in
719
        let delay = self#option self#vhdl_expr_t delay  in { value; delay }
719
        let we_delay = self#option self#vhdl_expr_t we_delay  in { value; we_delay }
720 720

  
721 721
    method vhdl_signal_condition_t :
722 722
      vhdl_signal_condition_t -> vhdl_signal_condition_t=
723
      fun { expr; cond }  ->
724
        let expr = self#list self#vhdl_waveform_element_t expr  in
725
        let cond = self#option self#vhdl_expr_t cond  in { expr; cond }
723
      fun { sc_expr; cond }  ->
724
        let sc_expr = self#list self#vhdl_waveform_element_t sc_expr  in
725
        let cond = self#option self#vhdl_expr_t cond  in { sc_expr; cond }
726 726

  
727 727
    method vhdl_signal_selection_t :
728 728
      vhdl_signal_selection_t -> vhdl_signal_selection_t=
729
      fun { expr; when_sel }  ->
730
        let expr = self#list self#vhdl_waveform_element_t expr  in
729
      fun { ss_expr; when_sel }  ->
730
        let ss_expr = self#list self#vhdl_waveform_element_t ss_expr  in
731 731
        let when_sel = self#list self#vhdl_expr_t when_sel  in
732
        { expr; when_sel }
732
        { ss_expr; when_sel }
733 733

  
734 734
    method vhdl_conditional_signal_t :
735 735
      vhdl_conditional_signal_t -> vhdl_conditional_signal_t=
736
      fun { postponed; label; lhs; rhs; delay }  ->
737
        let postponed = self#bool postponed  in
738
        let label = self#lower_vhdl_name_t label  in
739
        let lhs = self#lower_vhdl_name_t lhs  in
736
      fun { cs_postponed; cs_label; cs_lhs; rhs; cs_delay }  ->
737
        let cs_postponed = self#bool cs_postponed  in
738
        let cs_label = self#lower_vhdl_name_t cs_label  in
739
        let cs_lhs = self#lower_vhdl_name_t cs_lhs  in
740 740
        let rhs = self#list self#vhdl_signal_condition_t rhs  in
741
        let delay = self#vhdl_expr_t delay  in
742
        { postponed; label; lhs; rhs; delay }
741
        let cs_delay = self#vhdl_expr_t cs_delay  in
742
        { cs_postponed; cs_label; cs_lhs; rhs; cs_delay }
743 743

  
744 744
    method vhdl_process_t : vhdl_process_t -> mini_vhdl_process_t=
745
      fun { id; declarations; active_sigs; body }  ->
745
      fun { id; p_declarations; active_sigs; p_body }  ->
746 746
        let id = self#lower_vhdl_name_t id  in
747
        let declarations = List.map self#vhdl_declarative_item_t declarations  in
747
        let p_declarations = List.map self#vhdl_declarative_item_t p_declarations  in
748 748
        let active_sigs = self#list self#lower_vhdl_name_t active_sigs  in
749
        let body = List.map self#vhdl_sequential_stmt_t body  in
749
        let p_body = List.map self#vhdl_sequential_stmt_t p_body  in
750 750
        (* TODO: Explicit memories *)
751 751
        let postponed = false in
752 752
        let label = None in
753
        { id; declarations; active_sigs; body; postponed; label }
753
        { id; p_declarations; active_sigs; p_body; postponed; label }
754 754

  
755 755
    method vhdl_selected_signal_t :
756 756
      vhdl_selected_signal_t -> vhdl_selected_signal_t=
757
      fun { postponed; label; lhs; sel; branches; delay }  ->
758
        let postponed = self#bool postponed  in
759
        let label = self#lower_vhdl_name_t label  in
760
        let lhs = self#lower_vhdl_name_t lhs  in
757
      fun { ss_postponed; ss_label; ss_lhs; sel; branches; ss_delay }  ->
758
        let ss_postponed = self#bool ss_postponed  in
759
        let ss_label = self#lower_vhdl_name_t ss_label  in
760
        let ss_lhs = self#lower_vhdl_name_t ss_lhs  in
761 761
        let sel = self#vhdl_expr_t sel  in
762 762
        let branches = self#list self#vhdl_signal_selection_t branches  in
763
        let delay = self#option self#vhdl_expr_t delay  in
764
        { postponed; label; lhs; sel; branches; delay }
763
        let ss_delay = self#option self#vhdl_expr_t ss_delay  in
764
        { ss_postponed; ss_label; ss_lhs; sel; branches; ss_delay }
765 765

  
766 766
    method vhdl_port_mode_t : vhdl_port_mode_t -> vhdl_port_mode_t=
767 767
      fun x  -> x
768 768

  
769 769
    method vhdl_component_instantiation_t :
770 770
      vhdl_component_instantiation_t -> mini_vhdl_component_instantiation_t=
771
        fun { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }  ->
772
        let name = self#lower_vhdl_name_t name  in
771
        fun { ci_name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }  ->
772
        let ci_name = self#lower_vhdl_name_t ci_name  in
773 773
        let archi_name = self#option self#lower_vhdl_name_t archi_name  in
774 774
        let inst_unit = self#lower_vhdl_name_t inst_unit in
775 775
        let db_tuple = match archi_name with
776
          | None -> failwith ("Component [" ^ self#to_string_vhdl_name_t name ^ "] is not an entity")
776
          | None -> failwith ("Component [" ^ self#to_string_vhdl_name_t ci_name ^ "] is not an entity")
777 777
          | Some a -> self#get_tuple_from_archi_and_entity_name (a, inst_unit) in (* Get corresponding tuple in db *)
778 778
        let archi = db_tuple.architecture in
779 779
        let entity = db_tuple.entity in
780 780
        let generic_map = self#list self#vhdl_assoc_element_t generic_map  in
781 781
        let port_map = self#list self#vhdl_assoc_element_t port_map  in
782
        let port_t_names_proj : vhdl_port_t -> vhdl_name_t list= fun x -> x.names in
782
        let port_t_names_proj : vhdl_port_t -> vhdl_name_t list= fun x -> x.port_names in
783 783
        (* port_map resolution *)
784 784
        let entity_ports_names = List.flatten (List.map port_t_names_proj entity.ports) in
785 785
        let port_map = self#vhdl_assoc_element_t_resolve port_map entity_ports_names in
786 786
        (* generic_map resolution *)
787 787
        let entity_generics_names = List.flatten (List.map port_t_names_proj entity.generics) in
788 788
        let generic_map = self#vhdl_assoc_element_t_resolve generic_map entity_generics_names in
789
        { name; archi; entity; generic_map; port_map }
789
        { ci_name; archi; entity; generic_map; port_map }
790 790

  
791 791
    method vhdl_concurrent_stmt_t :
792 792
      vhdl_concurrent_stmt_t -> mini_vhdl_concurrent_stmt_t=
......
794 794
        match x with
795 795
        | SigAssign a -> 
796 796
            Process {
797
              id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process";
798
              declarations = [];
797
              id = self#postfix_flatten_vhdl_name_t a.cs_lhs "__implicit_process";
798
              p_declarations = [];
799 799
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x [];
800
              body = (SigCondAssign {
800
              p_body = (SigCondAssign {
801 801
                label = None;
802
                lhs = a.lhs;
802
                lhs = a.cs_lhs;
803 803
                rhs = a.rhs;
804
                delay = match a.delay with | IsNull -> None | _ -> Some a.delay
804
                delay = match a.cs_delay with | IsNull -> None | _ -> Some a.cs_delay
805 805
              })::[];
806
              postponed = a.postponed;
807
              label = match a.label with | NoName -> None | _ -> Some a.label
806
              postponed = a.cs_postponed;
807
              label = match a.cs_label with | NoName -> None | _ -> Some a.cs_label
808 808
            }
809 809
        | Process a -> let a = self#vhdl_process_t a  in Process a
810 810
        | SelectedSig a -> 
811 811
            Process {
812
              id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process";
813
              declarations = [];
812
              id = self#postfix_flatten_vhdl_name_t a.ss_lhs "__implicit_process";
813
              p_declarations = [];
814 814
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x [];
815
              body = (SigSelectAssign {
815
              p_body = (SigSelectAssign {
816 816
                label = None;
817
                lhs = a.lhs;
817
                lhs = a.ss_lhs;
818 818
                sel = a.sel;
819 819
                branches = a.branches;
820
                delay = a.delay
820
                delay = a.ss_delay
821 821
              })::[];
822
              postponed = a.postponed;
823
              label = match a.label with | NoName -> None | _ -> Some a.label
822
              postponed = a.ss_postponed;
823
              label = match a.ss_label with | NoName -> None | _ -> Some a.ss_label
824 824
            }
825 825
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a
826 826

  
827 827
    method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
828
      fun { names; mode; typ; expr }  ->
829
        let names = self#list self#lower_vhdl_name_t names  in
830
        let mode = self#vhdl_port_mode_t mode  in
831
        let typ = self#vhdl_subtype_indication_t typ  in
832
        let expr = self#vhdl_expr_t expr  in { names; mode; typ; expr }
828
      fun { port_names; port_mode; port_typ; port_expr }  ->
829
        let port_names = self#list self#lower_vhdl_name_t port_names  in
830
        let port_mode = self#vhdl_port_mode_t port_mode  in
831
        let port_typ = self#vhdl_subtype_indication_t port_typ  in
832
        let port_expr = self#vhdl_expr_t port_expr  in { port_names; port_mode; port_typ; port_expr }
833 833

  
834 834
    method vhdl_entity_t : vhdl_entity_t -> unit =
835
      fun { name; generics; ports; declaration; stmts }  -> ()
835
      fun { e_name; generics; ports; e_declaration; stmts }  -> ()
836 836

  
837 837
    method vhdl_package_t : (vhdl_load_t list * vhdl_package_t) -> mini_vhdl_package_t=
838
      fun ( ctxs, {name; shared_defs; shared_decls; shared_uses })  ->
839
        let name = self#lower_vhdl_name_t name  in
838
      fun ( ctxs, {p_name; shared_defs; shared_decls; shared_uses })  ->
839
        let p_name = self#lower_vhdl_name_t p_name  in
840 840
        let shared_defs = self#list self#vhdl_definition_t shared_defs  in
841 841
        let shared_decls = List.map self#vhdl_declaration_t shared_decls  in
842 842
        let shared_uses = self#list self#vhdl_load_t shared_uses @ ctxs in
843
        { name; shared_defs; shared_decls; shared_uses }
843
        { p_name; shared_defs; shared_decls; shared_uses }
844 844

  
845 845
    method vhdl_load_t : vhdl_load_t -> vhdl_load_t=
846 846
      fun x  ->
......
853 853
                                  (vhdl_load_t list * vhdl_configuration_t) list *
854 854
                                  (vhdl_load_t list * vhdl_architecture_t)) -> mini_vhdl_component_t=
855 855
      fun ( packs_pairs, ents_pairs, confs_pairs, (arch_ctx, arch) ) ->
856
        let names = arch.name::(arch.entity::[])  in
856
        let names = arch.a_name::(arch.entity::[])  in
857 857
        let (ref_ent_ctx,ref_ent) = self#filter_entity (ents_pairs, arch.entity) in
858 858
        let contexts =
859 859
          ref_ent_ctx @ (* Referenced entity context elements *)
860 860
          arch_ctx @ (* Architecture context elements *)
861
          self#declarative_items_uses ref_ent.declaration @ (* Referenced entity inner context elements *)
862
          self#declarative_items_uses arch.declarations in (* Architecture inner context elements *)
861
          self#declarative_items_uses ref_ent.e_declaration @ (* Referenced entity inner context elements *)
862
          self#declarative_items_uses arch.a_declarations in (* Architecture inner context elements *)
863 863
        let declarations = 
864
          self#declarative_items_declarations ref_ent.declaration @ (* Referenced entity inner declarations *)
865
          self#declarative_items_declarations arch.declarations in (* Architecture inner declarations *)
864
          self#declarative_items_declarations ref_ent.e_declaration @ (* Referenced entity inner declarations *)
865
          self#declarative_items_declarations arch.a_declarations in (* Architecture inner declarations *)
866 866
        let definitions =
867
          self#declarative_items_definitions ref_ent.declaration @ (* Referenced entity inner definitions *)
868
          self#declarative_items_definitions arch.declarations in (* Architecture inner definitions *)
869
        let body = 
867
          self#declarative_items_definitions ref_ent.e_declaration @ (* Referenced entity inner definitions *)
868
          self#declarative_items_definitions arch.a_declarations in (* Architecture inner definitions *)
869
        let c_body = 
870 870
          List.map self#vhdl_concurrent_stmt_t ref_ent.stmts @ (* Referenced entity concurrent statement *)
871
          List.map self#vhdl_concurrent_stmt_t arch.body in (* Architecture concurrent statements *)
871
          List.map self#vhdl_concurrent_stmt_t arch.a_body in (* Architecture concurrent statements *)
872 872
        let generics = ref_ent.generics in (* Referenced entity generics *)
873 873
        let ports = ref_ent.ports in (* Referenced entity ports *)
874
        let declarations = List.map self#vhdl_declaration_t declarations in
874
        let c_declarations = List.map self#vhdl_declaration_t declarations in
875 875
        let (signals, subprograms) = 
876
          let rec find_decls declarations acc_s acc_p = 
877
            match declarations with
876
          let rec find_decls c_declarations acc_s acc_p = 
877
            match c_declarations with
878 878
            | [] -> (acc_s, acc_p)
879 879
            | (SigDecl (s))::tl -> find_decls tl ((SigDecl (s))::acc_s) (acc_p)
880 880
            | (Subprogram (s))::tl -> find_decls tl (acc_s) ((Subprogram (s))::acc_p)
881
            | _::tl -> find_decls tl acc_s acc_p in find_decls declarations [] [] in
882
        let assigned_signals_names = List.flatten (List.map self#mini_vhdl_concurrent_stmt_t_assigned_signals_names body) in
881
            | _::tl -> find_decls tl acc_s acc_p in find_decls c_declarations [] [] in
882
        let assigned_signals_names = List.flatten (List.map self#mini_vhdl_concurrent_stmt_t_assigned_signals_names c_body) in
883 883
        let functions = List.map (
884
          fun x -> match x with Subprogram (s) -> (Simple s.spec.name, s.spec.parameters, s.spec.typeMark) | _ -> failwith "Unreachable error (map on subprograms)"
884
          fun x -> match x with Subprogram (s) -> (Simple s.spec.ss_name, s.spec.parameters, s.spec.typeMark) | _ -> failwith "Unreachable error (map on subprograms)"
885 885
        ) subprograms in
886
        let memories = List.flatten (List.map (self#mini_vhdl_concurrent_stmt_t_memories assigned_signals_names) body) in
886
        let memories = List.flatten (List.map (self#mini_vhdl_concurrent_stmt_t_memories assigned_signals_names) c_body) in
887 887
        let new_tuple = { entity=ref_ent; 
888 888
                          architecture=arch; 
889 889
                          architecture_signals=signals;
......
895 895
                          contexts=contexts } in
896 896
        self#db_add_tuple new_tuple;
897 897
        self#db_set_current new_tuple;
898
        { names; generics=generics; ports=ports; contexts=contexts; declarations=declarations; definitions=definitions; body=body }
898
        { names; generics=generics; ports=ports; contexts=contexts; c_declarations=c_declarations; definitions=definitions; c_body=c_body }
899 899

  
900 900
    method vhdl_configuration_t :
901 901
      vhdl_configuration_t -> unit= self#unit
......
928 928
*)
929 929

  
930 930
    method sndpass_mini_vhdl_component_t : mini_vhdl_component_t -> mini_vhdl_component_t=
931
      fun { names; generics; ports; contexts; declarations; definitions; body } ->
931
      fun { names; generics; ports; contexts; c_declarations; definitions; c_body } ->
932 932
        (* TODO: resolve association list for function/procedures calls *)
933
      { names; generics; ports; contexts; declarations; definitions; body }
933
      { names; generics; ports; contexts; c_declarations; definitions; c_body }
934 934

  
935 935
    method sndpass_mini_vhdl_design_file_t : mini_vhdl_design_file_t -> mini_vhdl_design_file_t=
936 936
      fun { components; packages } ->
src/backends/VHDL/vhdl_ast_fold_sensitivity.ml
15 15
let _ = fun (_ : vhdl_signal_attributes_t)  -> () 
16 16
let _ = fun (_ : vhdl_string_attributes_t)  -> () 
17 17
let _ = fun (_ : vhdl_suffix_selection_t)  -> () 
18
let _ = fun (_ : 'basetype vhdl_type_attributes_t)  -> () 
18
(*let _ = fun (_ : 'basetype vhdl_type_attributes_t)  -> () *)
19 19
let _ = fun (_ : vhdl_parameter_t)  -> () 
20 20
let _ = fun (_ : vhdl_subprogram_spec_t)  -> () 
21 21
let _ = fun (_ : vhdl_waveform_element_t)  -> () 
......
71 71

  
72 72
    method vhdl_element_declaration_t :
73 73
      vhdl_element_declaration_t -> 'acc -> 'acc=
74
      fun { names; definition }  ->
74
      fun { ed_names; definition }  ->
75 75
        fun acc  -> acc
76 76

  
77 77
    method vhdl_subtype_indication_t :
78 78
      vhdl_subtype_indication_t -> 'acc -> 'acc=
79
      fun { name; functionName; const }  ->
79
      fun { si_name; functionName; const }  ->
80 80
        fun acc  ->
81
          let acc = self#vhdl_name_t name acc  in
81
          let acc = self#vhdl_name_t si_name acc  in
82 82
          let acc = self#vhdl_name_t functionName acc  in
83 83
          let acc = self#vhdl_constraint_t const acc  in acc
84 84

  
......
210 210
          | SuffixRange (a,b) ->
211 211
              let acc = self#int a acc  in let acc = self#int b acc  in acc
212 212

  
213
    method vhdl_type_attributes_t :
213
(*    method vhdl_type_attributes_t :
214 214
      'a . ('a -> 'acc -> 'acc) -> 'a vhdl_type_attributes_t -> 'acc -> 'acc=
215 215
      fun _basetype  ->
216 216
        fun x  ->
......
225 225
                let acc = _basetype arg acc  in acc
226 226
            | TAttStringArg { id; arg } ->
227 227
                let acc = self#string id acc  in
228
                let acc = self#string arg acc  in acc
228
                let acc = self#string arg acc  in acc *)
229 229

  
230 230
    method vhdl_parameter_t : vhdl_parameter_t -> 'acc -> 'acc=
231
      fun { names; mode; typ; init_val }  ->
231
      fun { parameter_names; parameter_mode; parameter_typ; init_val }  ->
232 232
        fun acc  ->
233
          let acc = self#list self#vhdl_name_t names acc  in
234
          let acc = self#list self#string mode acc  in
235
          let acc = self#vhdl_subtype_indication_t typ acc  in
233
          let acc = self#list self#vhdl_name_t parameter_names acc  in
234
          let acc = self#list self#string parameter_mode acc  in
235
          let acc = self#vhdl_subtype_indication_t parameter_typ acc  in
236 236
          let acc = self#option self#vhdl_cst_val_t init_val acc  in acc
237 237

  
238 238
    method vhdl_subprogram_spec_t : vhdl_subprogram_spec_t -> 'acc -> 'acc=
239
      fun { name; subprogram_type; typeMark; parameters; isPure }  ->
239
      fun { ss_name; subprogram_type; typeMark; parameters; isPure }  ->
240 240
        fun acc  ->
241
          let acc = self#string name acc  in
241
          let acc = self#string ss_name acc  in
242 242
          let acc = self#string subprogram_type acc  in
243 243
          let acc = self#vhdl_name_t typeMark acc  in
244 244
          let acc = self#list self#vhdl_parameter_t parameters acc  in
245 245
          let acc = self#bool isPure acc  in acc
246 246

  
247 247
    method vhdl_waveform_element_t : vhdl_waveform_element_t -> 'acc -> 'acc=
248
      fun { value; delay }  ->
248
      fun { value; we_delay }  ->
249 249
        fun acc  ->
250 250
          let acc = self#option self#vhdl_expr_t value acc  in
251
          let acc = self#option self#vhdl_expr_t delay acc  in acc
251
          let acc = self#option self#vhdl_expr_t we_delay acc  in acc
252 252

  
253 253
    method vhdl_sequential_stmt_t : vhdl_sequential_stmt_t -> 'acc -> 'acc=
254 254
      fun x  ->
255 255
        fun acc  ->
256 256
          match x with
257
          | VarAssign { label; lhs; rhs } ->
257
          | VarAssign { label; seqs_lhs; rhs } ->
258 258
              let acc = self#vhdl_expr_t rhs acc  in acc
259
          | SigSeqAssign { label; lhs; rhs } ->
259
          | SigSeqAssign { label; seqs_lhs; rhs } ->
260 260
              let acc = self#list self#vhdl_waveform_element_t rhs acc  in
261 261
              acc
262 262
          | If { label; if_cases; default } ->
......
300 300
      fun _  -> fun acc  -> acc
301 301

  
302 302
    method vhdl_port_t : vhdl_port_t -> 'acc -> 'acc=
303
      fun { names; mode; typ; expr }  ->
303
      fun { port_names; port_mode; port_typ; port_expr }  ->
304 304
        fun acc  ->
305
          let acc = self#list self#vhdl_name_t names acc  in
306
          let acc = self#vhdl_port_mode_t mode acc  in
307
          let acc = self#vhdl_subtype_indication_t typ acc  in
308
          let acc = self#vhdl_expr_t expr acc  in acc
305
          let acc = self#list self#vhdl_name_t port_names acc  in
306
          let acc = self#vhdl_port_mode_t port_mode acc  in
307
          let acc = self#vhdl_subtype_indication_t port_typ acc  in
308
          let acc = self#vhdl_expr_t port_expr acc  in acc
309 309

  
310 310
    method vhdl_declaration_t : vhdl_declaration_t -> 'acc -> 'acc=
311 311
      fun x  ->
......
316 316
        fun acc  -> acc
317 317

  
318 318
    method vhdl_declarative_item_t : vhdl_declarative_item_t -> 'acc -> 'acc=
319
      fun { use_clause; declaration; definition }  ->
319
      fun { use_clause; di_declaration; di_definition }  ->
320 320
        fun acc  -> acc
321 321

  
322 322
    method vhdl_signal_condition_t : vhdl_signal_condition_t -> 'acc -> 'acc=
323
      fun { expr; cond }  ->
323
      fun { sc_expr; cond }  ->
324 324
        fun acc  ->
325
          let acc = self#list self#vhdl_waveform_element_t expr acc  in
325
          let acc = self#list self#vhdl_waveform_element_t sc_expr acc  in
326 326
          let acc = self#option self#vhdl_expr_t cond acc  in acc
327 327

  
328 328
    method vhdl_signal_selection_t : vhdl_signal_selection_t -> 'acc -> 'acc=
329
      fun { expr; when_sel }  ->
329
      fun { ss_expr; when_sel }  ->
330 330
        fun acc  ->
331
          let acc = self#list self#vhdl_waveform_element_t expr acc  in
331
          let acc = self#list self#vhdl_waveform_element_t ss_expr acc  in
332 332
          let acc = self#list self#vhdl_expr_t when_sel acc  in acc
333 333
    
334 334
    method vhdl_conditional_signal_t :
335 335
      vhdl_conditional_signal_t -> 'acc -> 'acc=
336
      fun { postponed; label; lhs; rhs; delay }  ->
336
      fun { cs_postponed; cs_label; cs_lhs; rhs; cs_delay }  ->
337 337
        fun acc  ->
338 338
          let acc = self#list self#vhdl_signal_condition_t rhs acc  in
339
          let acc = self#vhdl_expr_t delay acc  in acc
339
          let acc = self#vhdl_expr_t cs_delay acc  in acc
340 340

  
341 341
    method vhdl_process_t : vhdl_process_t -> 'acc -> 'acc=
342
      fun { id; declarations; active_sigs; body }  ->
342
      fun { id; p_declarations; active_sigs; p_body }  ->
343 343
        fun acc  ->
344
          let acc = self#list self#vhdl_sequential_stmt_t body acc  in acc
344
          let acc = self#list self#vhdl_sequential_stmt_t p_body acc  in acc
345 345

  
346 346
    method vhdl_selected_signal_t : vhdl_selected_signal_t -> 'acc -> 'acc=
347
      fun { postponed; label; lhs; sel; branches; delay }  ->
347
      fun { ss_postponed; ss_label; ss_lhs; sel; branches; ss_delay }  ->
348 348
        fun acc  ->
349 349
          let acc = self#vhdl_expr_t sel acc  in
350 350
          let acc = self#list self#vhdl_signal_selection_t branches acc  in
351
          let acc = self#option self#vhdl_expr_t delay acc  in acc
351
          let acc = self#option self#vhdl_expr_t ss_delay acc  in acc
352 352

  
353 353
    method vhdl_component_instantiation_t :
354 354
      vhdl_component_instantiation_t -> 'acc -> 'acc=
355 355
      fun
356
        { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map
356
        { ci_name; inst_unit; inst_unit_type; archi_name; generic_map; port_map
357 357
          }
358 358
         ->
359 359
        fun acc  -> acc
......
368 368
          | ComponentInst a -> self#vhdl_component_instantiation_t a acc
369 369

  
370 370
    method vhdl_entity_t : vhdl_entity_t -> 'acc -> 'acc=
371
      fun { name; generics; ports; declaration; stmts }  ->
371
      fun { e_name; generics; ports; e_declaration; stmts }  ->
372 372
        fun acc  -> acc
373 373

  
374 374
    method vhdl_package_t : vhdl_package_t -> 'acc -> 'acc=
375
      fun { name; shared_defs; shared_decls; shared_uses }  ->
375
      fun { p_name; shared_defs; shared_decls; shared_uses }  ->
376 376
        fun acc  -> acc
377 377

  
378 378
    method vhdl_architecture_t : vhdl_architecture_t -> 'acc -> 'acc=
379
      fun { name; entity; declarations; body }  ->
379
      fun { a_name; entity; a_declarations; a_body }  ->
380 380
        fun acc  -> acc
381 381

  
382 382
    method vhdl_configuration_t : vhdl_configuration_t -> 'acc -> 'acc=
src/backends/VHDL/vhdl_ast_map.ml
15 15
let _ = fun (_ : vhdl_signal_attributes_t)  -> () 
16 16
let _ = fun (_ : vhdl_string_attributes_t)  -> () 
17 17
let _ = fun (_ : vhdl_suffix_selection_t)  -> () 
18
let _ = fun (_ : 'basetype vhdl_type_attributes_t)  -> () 
18
(*let _ = fun (_ : 'basetype vhdl_type_attributes_t)  -> ()  *)
19 19
let _ = fun (_ : vhdl_parameter_t)  -> () 
20 20
let _ = fun (_ : vhdl_subprogram_spec_t)  -> () 
21 21
let _ = fun (_ : vhdl_sequential_stmt_t)  -> () 
......
112 112
        | Void  -> Void
113 113
    method vhdl_element_declaration_t :
114 114
      vhdl_element_declaration_t -> vhdl_element_declaration_t=
115
      fun { names; definition }  ->
116
        let names = self#list self#vhdl_name_t names  in
115
      fun { ed_names; definition }  ->
116
        let ed_names = self#list self#vhdl_name_t ed_names  in
117 117
        let definition = self#vhdl_subtype_indication_t definition  in
118
        { names; definition }
118
        { ed_names; definition }
119 119
    method vhdl_subtype_indication_t :
120 120
      vhdl_subtype_indication_t -> vhdl_subtype_indication_t=
121
      fun { name; functionName; const }  ->
122
        let name = self#vhdl_name_t name  in
121
      fun { si_name; functionName; const }  ->
122
        let si_name = self#vhdl_name_t si_name  in
123 123
        let functionName = self#vhdl_name_t functionName  in
124 124
        let const = self#vhdl_constraint_t const  in
125
        { name; functionName; const }
125
        { si_name; functionName; const }
126 126
    method vhdl_discrete_range_t :
127 127
      vhdl_discrete_range_t -> vhdl_discrete_range_t=
128 128
      fun x  ->
......
270 270
        | SuffixRange (a,b) ->
271 271
            let a = self#int a  in let b = self#int b  in SuffixRange (a, b)
272 272

  
273
    method vhdl_type_attributes_t :
273
(*    method vhdl_type_attributes_t :
274 274
      'a .
275 275
        ('a -> 'a) -> 'a vhdl_type_attributes_t -> 'a vhdl_type_attributes_t=
276 276
      fun _basetype  ->
......
285 285
              let arg = _basetype arg  in TAttValArg { id; arg }
286 286
          | TAttStringArg { id; arg } ->
287 287
              let id = self#string id  in
288
              let arg = self#string arg  in TAttStringArg { id; arg }
288
              let arg = self#string arg  in TAttStringArg { id; arg } *)
289 289

  
290 290
    method vhdl_parameter_t : vhdl_parameter_t -> vhdl_parameter_t=
291
      fun { names; mode; typ; init_val }  ->
292
        let names = self#list self#vhdl_name_t names  in
293
        let mode = self#list self#string mode  in
294
        let typ = self#vhdl_subtype_indication_t typ  in
291
      fun { parameter_names; parameter_mode; parameter_typ; init_val }  ->
292
        let parameter_names = self#list self#vhdl_name_t parameter_names  in
293
        let parameter_mode = self#list self#string parameter_mode  in
294
        let parameter_typ = self#vhdl_subtype_indication_t parameter_typ  in
295 295
        let init_val = self#option self#vhdl_cst_val_t init_val  in
296
        { names; mode; typ; init_val }
296
        { parameter_names; parameter_mode; parameter_typ; init_val }
297 297

  
298 298
    method vhdl_subprogram_spec_t :
299 299
      vhdl_subprogram_spec_t -> vhdl_subprogram_spec_t=
300
      fun { name; subprogram_type; typeMark; parameters; isPure }  ->
301
        let name = self#string name  in
300
      fun { ss_name; subprogram_type; typeMark; parameters; isPure }  ->
301
        let ss_name = self#string ss_name  in
302 302
        let subprogram_type = self#string subprogram_type  in
303 303
        let typeMark = self#vhdl_name_t typeMark  in
304 304
        let parameters = self#list self#vhdl_parameter_t parameters  in
305 305
        let isPure = self#bool isPure  in
306
        { name; subprogram_type; typeMark; parameters; isPure }
306
        { ss_name; subprogram_type; typeMark; parameters; isPure }
307 307

  
308 308
    method vhdl_sequential_stmt_t :
309 309
      vhdl_sequential_stmt_t -> vhdl_sequential_stmt_t=
310 310
      fun x  ->
311 311
        match x with
312
        | VarAssign { label; lhs; rhs } ->
312
        | VarAssign { label; seqs_lhs; rhs } ->
313 313
            let label = self#vhdl_name_t label  in
314
            let lhs = self#vhdl_name_t lhs  in
315
            let rhs = self#vhdl_expr_t rhs  in VarAssign { label; lhs; rhs }
316
        | SigSeqAssign { label; lhs; rhs } ->
314
            let seqs_lhs = self#vhdl_name_t seqs_lhs  in
315
            let rhs = self#vhdl_expr_t rhs  in VarAssign { label; seqs_lhs; rhs }
316
        | SigSeqAssign { label; seqs_lhs; rhs } ->
317 317
            let label = self#vhdl_name_t label  in
318
            let lhs = self#vhdl_name_t lhs  in
318
            let seqs_lhs = self#vhdl_name_t seqs_lhs  in
319 319
            let rhs = self#list self#vhdl_waveform_element_t rhs  in
320
            SigSeqAssign { label; lhs; rhs }
320
            SigSeqAssign { label; seqs_lhs; rhs }
321 321
        | If { label; if_cases; default } ->
322 322
            let label = self#vhdl_name_t label  in
323 323
            let if_cases = self#list self#vhdl_if_case_t if_cases  in
......
393 393

  
394 394
    method vhdl_declarative_item_t :
395 395
      vhdl_declarative_item_t -> vhdl_declarative_item_t=
396
      fun { use_clause; declaration; definition }  ->
396
      fun { use_clause; di_declaration; di_definition }  ->
397 397
        let use_clause = self#option self#vhdl_load_t use_clause  in
398
        let declaration = self#option self#vhdl_declaration_t declaration  in
399
        let definition = self#option self#vhdl_definition_t definition  in
400
        { use_clause; declaration; definition }
398
        let di_declaration = self#option self#vhdl_declaration_t di_declaration  in
399
        let di_definition = self#option self#vhdl_definition_t di_definition  in
400
        { use_clause; di_declaration; di_definition }
401 401

  
402 402
    method vhdl_waveform_element_t :
403 403
      vhdl_waveform_element_t -> vhdl_waveform_element_t=
404
      fun { value; delay }  ->
404
      fun { value; we_delay }  ->
405 405
        let value = self#option self#vhdl_expr_t value  in
406
        let delay = self#option self#vhdl_expr_t delay  in { value; delay }
406
        let we_delay = self#option self#vhdl_expr_t we_delay  in { value; we_delay }
407 407

  
408 408
    method vhdl_signal_condition_t :
409 409
      vhdl_signal_condition_t -> vhdl_signal_condition_t=
410
      fun { expr; cond }  ->
411
        let expr = self#list self#vhdl_waveform_element_t expr  in
412
        let cond = self#option self#vhdl_expr_t cond  in { expr; cond }
410
      fun { sc_expr; cond }  ->
411
        let sc_expr = self#list self#vhdl_waveform_element_t sc_expr  in
412
        let cond = self#option self#vhdl_expr_t cond  in { sc_expr; cond }
413 413

  
414 414
    method vhdl_signal_selection_t :
415 415
      vhdl_signal_selection_t -> vhdl_signal_selection_t=
416
      fun { expr; when_sel }  ->
417
        let expr = self#list self#vhdl_waveform_element_t expr  in
416
      fun { ss_expr; when_sel }  ->
417
        let ss_expr = self#list self#vhdl_waveform_element_t ss_expr  in
418 418
        let when_sel = self#list self#vhdl_expr_t when_sel  in
419
        { expr; when_sel }
419
        { ss_expr; when_sel }
420 420

  
421 421
    method vhdl_conditional_signal_t :
422 422
      vhdl_conditional_signal_t -> vhdl_conditional_signal_t=
423
      fun { postponed; label; lhs; rhs; delay }  ->
424
        let postponed = self#bool postponed  in
425
        let label = self#vhdl_name_t label  in
426
        let lhs = self#vhdl_name_t lhs  in
423
      fun { cs_postponed; cs_label; cs_lhs; rhs; cs_delay }  ->
424
        let cs_postponed = self#bool cs_postponed  in
425
        let cs_label = self#vhdl_name_t cs_label  in
426
        let cs_lhs = self#vhdl_name_t cs_lhs  in
427 427
        let rhs = self#list self#vhdl_signal_condition_t rhs  in
428
        let delay = self#vhdl_expr_t delay  in
429
        { postponed; label; lhs; rhs; delay }
428
        let cs_delay = self#vhdl_expr_t cs_delay  in
429
        { cs_postponed; cs_label; cs_lhs; rhs; cs_delay }
430 430

  
431 431
    method vhdl_process_t : vhdl_process_t -> vhdl_process_t=
432
      fun { id; declarations; active_sigs; body }  ->
432
      fun { id; p_declarations; active_sigs; p_body }  ->
433 433
        let id = self#vhdl_name_t id  in
434
        let declarations = self#list self#vhdl_declarative_item_t declarations  in
434
        let p_declarations = self#list self#vhdl_declarative_item_t p_declarations  in
435 435
        let active_sigs = self#list self#vhdl_name_t active_sigs  in
436
        let body = self#list self#vhdl_sequential_stmt_t body  in
437
        { id; declarations; active_sigs; body }
436
        let p_body = self#list self#vhdl_sequential_stmt_t p_body  in
437
        { id; p_declarations; active_sigs; p_body }
438 438

  
439 439
    method vhdl_selected_signal_t :
440 440
      vhdl_selected_signal_t -> vhdl_selected_signal_t=
441
      fun { postponed; label; lhs; sel; branches; delay }  ->
442
        let postponed = self#bool postponed  in
443
        let label = self#vhdl_name_t label  in
444
        let lhs = self#vhdl_name_t lhs  in
441
      fun { ss_postponed; ss_label; ss_lhs; sel; branches; ss_delay }  ->
442
        let ss_postponed = self#bool ss_postponed  in
443
        let ss_label = self#vhdl_name_t ss_label  in
444
        let ss_lhs = self#vhdl_name_t ss_lhs  in
445 445
        let sel = self#vhdl_expr_t sel  in
446 446
        let branches = self#list self#vhdl_signal_selection_t branches  in
447
        let delay = self#option self#vhdl_expr_t delay  in
448
        { postponed; label; lhs; sel; branches; delay }
447
        let ss_delay = self#option self#vhdl_expr_t ss_delay  in
448
        { ss_postponed; ss_label; ss_lhs; sel; branches; ss_delay }
449 449

  
450 450
    method vhdl_port_mode_t : vhdl_port_mode_t -> vhdl_port_mode_t=
451 451
      fun x  -> x
452 452

  
453 453
    method vhdl_component_instantiation_t :
454 454
      vhdl_component_instantiation_t -> vhdl_component_instantiation_t=
455
        fun { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }  ->
456
        let name = self#vhdl_name_t name  in
455
        fun { ci_name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }  ->
456
        let ci_name = self#vhdl_name_t ci_name  in
457 457
        let inst_unit = self#vhdl_name_t inst_unit  in
458 458
        let inst_unit_type = self#string inst_unit_type  in
459 459
        let archi_name = self#option self#vhdl_name_t archi_name  in
460 460
        let generic_map = self#list self#vhdl_assoc_element_t generic_map  in
461 461
        let port_map = self#list self#vhdl_assoc_element_t port_map  in
462
        { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }
462
        { ci_name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }
463 463

  
464 464
    method vhdl_concurrent_stmt_t :
465 465
      vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t=
......
471 471
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a 
472 472

  
473 473
    method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
474
      fun { names; mode; typ; expr }  ->
475
        let names = self#list self#vhdl_name_t names  in
476
        let mode = self#vhdl_port_mode_t mode  in
477
        let typ = self#vhdl_subtype_indication_t typ  in
478
        let expr = self#vhdl_expr_t expr  in { names; mode; typ; expr }
474
      fun { port_names; port_mode; port_typ; port_expr }  ->
475
        let port_names = self#list self#vhdl_name_t port_names  in
476
        let port_mode = self#vhdl_port_mode_t port_mode  in
477
        let port_typ = self#vhdl_subtype_indication_t port_typ  in
478
        let port_expr = self#vhdl_expr_t port_expr  in { port_names; port_mode; port_typ; port_expr }
479 479

  
480 480
    method vhdl_entity_t : vhdl_entity_t -> vhdl_entity_t=
481
      fun { name; generics; ports; declaration; stmts }  ->
482
        let name = self#vhdl_name_t name  in
481
      fun { e_name; generics; ports; e_declaration; stmts }  ->
482
        let e_name = self#vhdl_name_t e_name  in
483 483
        let generics = self#list self#vhdl_port_t generics  in
484 484
        let ports = self#list self#vhdl_port_t ports  in
485
        let declaration = self#list self#vhdl_declarative_item_t declaration
485
        let e_declaration = self#list self#vhdl_declarative_item_t e_declaration
486 486
           in
487 487
        let stmts = self#list self#vhdl_concurrent_stmt_t stmts  in
488
        { name; generics; ports; declaration; stmts }
488
        { e_name; generics; ports; e_declaration; stmts }
489 489

  
490 490
    method vhdl_package_t : vhdl_package_t -> vhdl_package_t=
491
      fun { name; shared_defs; shared_decls; shared_uses }  ->
492
        let name = self#vhdl_name_t name  in
491
      fun { p_name; shared_defs; shared_decls; shared_uses }  ->
492
        let p_name = self#vhdl_name_t p_name  in
493 493
        let shared_defs = self#list self#vhdl_definition_t shared_defs  in
494 494
        let shared_decls = self#list self#vhdl_declaration_t shared_decls  in
495 495
        let shared_uses = self#list self#vhdl_load_t shared_uses  in
496
        { name; shared_defs; shared_decls; shared_uses }
496
        { p_name; shared_defs; shared_decls; shared_uses }
497 497

  
498 498
    method vhdl_load_t : vhdl_load_t -> vhdl_load_t=
499 499
      fun x  ->
......
502 502
        | Use a -> let a = self#list self#vhdl_name_t a  in Use a
503 503

  
504 504
    method vhdl_architecture_t : vhdl_architecture_t -> vhdl_architecture_t=
505
      fun { name; entity; declarations; body }  ->
506
        let name = self#vhdl_name_t name  in
505
      fun { a_name; entity; a_declarations; a_body }  ->
506
        let a_name = self#vhdl_name_t a_name  in
507 507
        let entity = self#vhdl_name_t entity  in
508
        let declarations = self#list self#vhdl_declarative_item_t declarations  in
509
        let body = self#list self#vhdl_concurrent_stmt_t body  in
510
        { name; entity; declarations; body }
508
        let a_declarations = self#list self#vhdl_declarative_item_t a_declarations  in
509
        let a_body = self#list self#vhdl_concurrent_stmt_t a_body  in
510
        { a_name; entity; a_declarations; a_body }
511 511

  
512 512
    method vhdl_configuration_t :
513 513
      vhdl_configuration_t -> vhdl_configuration_t= self#unit
src/backends/VHDL/vhdl_ast_pp.ml
115 115
                        fun x  ->
116 116
                          if sep then Format.fprintf fmt ", ";
117 117
                          ((__0 ()) fmt) x;
118
                          true) false x)) x.names;
118
                          true) false x)) x.ed_names;
119 119
           Format.fprintf fmt ": ";
120 120
           ((__1 ()) fmt) x.definition)
121 121
    [@ocaml.warning "-A"])
......
136 136
  ((let open! Ppx_deriving_runtime in
137 137
      fun fmt  ->
138 138
        fun x  ->
139
          ((__0 ()) fmt) x.name;
139
          ((__0 ()) fmt) x.si_name;
140 140
          ((__1 ()) fmt) x.functionName;
141 141
          (match x.const with
142 142
            | NoConstraint -> Format.fprintf fmt "";
......
674 674
  vhdl_suffix_selection_t -> Ppx_deriving_runtime.string =
675 675
  fun x  -> Format.asprintf "%a" pp_vhdl_suffix_selection_t x
676 676

  
677
(*
677 678
(* TODO *)
678 679
let rec pp_vhdl_type_attributes_t
679 680
  =
......
723 724
  fun poly_basetype  ->
724 725
    fun x  ->
725 726
      Format.asprintf "%a" (pp_vhdl_type_attributes_t poly_basetype) x
727
*)
726 728

  
727 729
let rec pp_vhdl_parameter_t :
728 730
  Format.formatter -> vhdl_parameter_t -> Ppx_deriving_runtime.unit =
......
742 744
                   fun x  ->
743 745
                     if sep then Format.fprintf fmt ", ";
744 746
                       ((__0 ()) fmt) x;
745
                       true) false x))) x.names;
747
                       true) false x))) x.parameter_names;
746 748
          Format.fprintf fmt ": ";
747 749
          ((fun x  ->
748 750
             ignore
......
751 753
                   fun x  ->
752 754
                     if sep then Format.fprintf fmt "";
753 755
                       Format.fprintf fmt "%s " x;
754
                       true) false x))) x.mode;
755
          ((__1 ()) fmt) x.typ;
756
                       true) false x))) x.parameter_mode;
757
          ((__1 ()) fmt) x.parameter_typ;
756 758
          (match x.init_val with
757 759
           | None  -> Format.pp_print_string fmt ""
758 760
           | Some x ->
......
775 777
          (match x.subprogram_type with
776 778
          | "function" -> 
777 779
              if (x.isPure) then
778
                Format.fprintf fmt "pure %s %s" x.subprogram_type x.name
780
                Format.fprintf fmt "pure %s %s" x.subprogram_type x.ss_name
779 781
              else
780
                Format.fprintf fmt "impure %s %s" x.subprogram_type x.name
782
                Format.fprintf fmt "impure %s %s" x.subprogram_type x.ss_name
781 783
          | "procedure" ->
782
              Format.fprintf fmt "%s %s" x.subprogram_type x.name);
784
              Format.fprintf fmt "%s %s" x.subprogram_type x.ss_name);
783 785
          (match x.parameters with
784 786
          | [] -> Format.fprintf fmt "";
785 787
          | _ -> 
......
817 819
          | None -> Format.fprintf fmt "";
818 820
          | Some IsNull -> Format.fprintf fmt "null";
819 821
          | Some v -> ((__0 ()) fmt) v);
820
          (match x.delay with
822
          (match x.we_delay with
821 823
          | None -> Format.fprintf fmt "";
822 824
          | Some v -> 
823 825
              Format.fprintf fmt " after ";
......
881 883
  ((let open! Ppx_deriving_runtime in
882 884
      fun fmt  ->
883 885
        function
884
        | VarAssign { label = alabel; lhs = alhs; rhs = arhs } ->
886
        | VarAssign { label = alabel; seqs_lhs = alhs; rhs = arhs } ->
885 887
            (match alabel with
886 888
              | NoName -> Format.fprintf fmt "";
887 889
              | _ -> (((__0 ()) fmt) alabel;
......
904 906
              ((__2 ()) fmt) arhs;
905 907
              Format.fprintf fmt "@]");
906 908
             Format.fprintf fmt "@]}") *)
907
        | SigSeqAssign { label = alabel; lhs = alhs; rhs = arhs } ->
909
        | SigSeqAssign { label = alabel; seqs_lhs = alhs; rhs = arhs } ->
908 910
            (match alabel with
909 911
              | NoName -> Format.fprintf fmt "";
910 912
              | _ -> (((__3 ()) fmt) alabel;
......
1159 1161
                            if sep then Format.fprintf fmt ",@ ";
1160 1162
                            ((__0 ()) fmt) x;
1161 1163
                            true) false x);
1162
                  Format.fprintf fmt "@,@]")) x.names;
1164
                  Format.fprintf fmt "@,@]")) x.port_names;
1163 1165
              );
1164 1166
             Format.fprintf fmt ": ";
1165
             ((__1 ()) fmt) x.mode;
1167
             ((__1 ()) fmt) x.port_mode;
1166 1168
             );
1167 1169
             Format.fprintf fmt " ";
1168
            ((__2 ()) fmt) x.typ;
1170
            ((__2 ()) fmt) x.port_typ;
1169 1171
            );
1170
          (match x.expr with
1172
          (match x.port_expr with
1171 1173
           | IsNull -> Format.fprintf fmt "";
1172 1174
           | _ -> (Format.fprintf fmt "@[:= ";
1173
                   ((__3 ()) fmt) x.expr;
1175
                   ((__3 ()) fmt) x.port_expr;
1174 1176
                   Format.fprintf fmt "@]"));
1175 1177
          Format.fprintf fmt "@]"))
1176 1178
    [@ocaml.warning "-A"])
......
1379 1381
          (match x.use_clause with
1380 1382
          | None -> Format.fprintf fmt "";
1381 1383
          | Some e -> ((__0 ()) fmt) e);
1382
          (match x.declaration with
1384
          (match x.di_declaration with
1383 1385
          | None -> Format.fprintf fmt "";
1384 1386
          | Some e -> ((__1 ()) fmt) e);
1385
          (match x.definition with
1387
          (match x.di_definition with
1386 1388
          | None -> Format.fprintf fmt "";
1387 1389
          | Some e -> ((__2 ()) fmt) e);)
1388 1390
    [@ocaml.warning "-A"])
......
1407 1409
                        fun x  ->
1408 1410
                          if sep then Format.fprintf fmt ",@,";
1409 1411
                          ((__0 ()) fmt) x;
1410
                          true) false x))) x.expr;
1412
                          true) false x))) x.sc_expr;
1411 1413
          (match x.cond with
1412 1414
          | None -> Format.fprintf fmt "";
1413 1415
          | Some e -> Format.fprintf fmt " when ";
......
1434 1436
                  fun x  ->
1435 1437
                    if sep then Format.fprintf fmt "@ ";
1436 1438
                      ((__0 ()) fmt) x;
1437
                      true) false x))) x.expr;
1439
                      true) false x))) x.ss_expr;
1438 1440
          Format.fprintf fmt " when ";
1439 1441
          ((fun x  ->
1440 1442
            ignore
......
1464 1466
  ((let open! Ppx_deriving_runtime in
1465 1467
      fun fmt  ->
1466 1468
        fun x  ->
1467
          (match x.label with
1469
          (match x.cs_label with
1468 1470
            | NoName -> Format.fprintf fmt "";
1469
            | _ -> (((__0 ()) fmt) x.label;
1471
            | _ -> (((__0 ()) fmt) x.cs_label;
1470 1472
                   Format.fprintf fmt ":@ ")
1471 1473
          );
1472
          if (x.postponed) then Format.fprintf fmt "postponed@ ";
1473
          ((__1 ()) fmt) x.lhs;
1474
          if (x.cs_postponed) then Format.fprintf fmt "postponed@ ";
1475
          ((__1 ()) fmt) x.cs_lhs;
1474 1476
          Format.fprintf fmt " <= ";
1475
          (match x.delay with
1477
          (match x.cs_delay with
1476 1478
            | IsNull -> Format.fprintf fmt "";
1477
            | _ -> ((__3 ()) fmt) x.delay;
1479
            | _ -> ((__3 ()) fmt) x.cs_delay;
1478 1480
                   Format.fprintf fmt " ");
1479 1481
          ((fun x  ->
1480 1482
             Format.fprintf fmt "@[";
......
1526 1528
                              true) false x))) x.active_sigs;
1527 1529
                 Format.fprintf fmt ")");
1528 1530
          Format.fprintf fmt " is";
1529
          (match x.declarations with
1531
          (match x.p_declarations with
1530 1532
          | [] -> Format.fprintf fmt "";
1531 1533
          | _ -> 
1532 1534
              (Format.fprintf fmt "@;";
......
1538 1540
                      if sep then Format.fprintf fmt "@;";
1539 1541
                        ((__1 ()) fmt) x;
1540 1542
                        Format.fprintf fmt ";";
1541
                        true) false x))) x.declarations));
1543
                        true) false x))) x.p_declarations));
1542 1544
          Format.fprintf fmt "@]@;@[<v 2>begin@;";
1543 1545
          ((fun x  ->
1544 1546
               ignore
......
1548 1550
                         if sep then Format.fprintf fmt "@;";
1549 1551
                         ((__3 ()) fmt) x;
1550 1552
                         Format.fprintf fmt ";";
1551
                         true) false x);)) x.body;
1553
                         true) false x);)) x.p_body;
1552 1554
          Format.fprintf fmt "@]@;end process;")
1553 1555
    [@ocaml.warning "-A"])
1554 1556

  
1555 1557
and show_vhdl_process_t : vhdl_process_t -> Ppx_deriving_runtime.string =
1556 1558
  fun x  -> Format.asprintf "%a" pp_vhdl_process_t x
1557 1559

  
1558
let rec pp_vhdl_selected_signal_t :
1560
let rec pp_vhdl_selected_signal_t : (* FIXME Missing ss_postponed attribute *)
1559 1561
  Format.formatter -> vhdl_selected_signal_t -> Ppx_deriving_runtime.unit =
1560 1562
  let __4 () = pp_vhdl_expr_t
1561 1563
  
......
1571 1573
      fun fmt  ->
1572 1574
        fun x  ->
1573 1575
          Format.fprintf fmt "@[<v 2>";
1574
          (match x.label with
1576
          (match x.ss_label with
1575 1577
            | NoName -> Format.fprintf fmt "";
1576
            | _ -> (((__0 ()) fmt) x.label;
1578
            | _ -> (((__0 ()) fmt) x.ss_label;
1577 1579
                   Format.fprintf fmt ":@ ")
1578 1580
          );
1579 1581
          Format.fprintf fmt "with ";
1580 1582
          ((__2 ()) fmt) x.sel;
1581 1583
          Format.fprintf fmt " select@;";
1582
          ((__1 ()) fmt) x.lhs;
1584
          ((__1 ()) fmt) x.ss_lhs;
1583 1585
          Format.fprintf fmt " <= ";
1584 1586
          ((function
1585 1587
            | None  -> Format.pp_print_string fmt ""
1586 1588
            | Some x ->
1587
               ((__4 ()) fmt) x)) x.delay;
1589
               ((__4 ()) fmt) x)) x.ss_delay;
1588 1590
          ((fun x  ->
1589 1591
            ignore
1590 1592
              (List.fold_left
......
1618 1620
      fun fmt  ->
1619 1621
        fun x  ->
1620 1622
          Format.fprintf fmt "@[<v 2>";
1621
          ((__0 ()) fmt) x.name;
1623
          ((__0 ()) fmt) x.ci_name;
1622 1624
          Format.fprintf fmt " : ";
1623 1625
          Format.fprintf fmt "%s " x.inst_unit_type;
1624 1626
          ((__1 ()) fmt) x.inst_unit;
......
1704 1706
  ((let open! Ppx_deriving_runtime in
1705 1707
      fun fmt  ->
1706 1708
        fun x  ->
1707
          ((__0 ()) fmt) x.name;
1709
          ((__0 ()) fmt) x.e_name;
1708 1710
          Format.fprintf fmt " is@;";
1709 1711
          (match x.generics with
1710 1712
          | [] -> Format.fprintf fmt "";
......
1732 1734
                           ((__2 ()) fmt) x;
1733 1735
                           true) false x))) x.ports;
1734 1736
              Format.fprintf fmt "@]);");
1735
          (match x.declaration with
1737
          (match x.e_declaration with
1736 1738
          | [] -> Format.fprintf fmt "";
1737 1739
          | _ ->
1738 1740
              Format.fprintf fmt "@;";
......
1743 1745
                        fun x  ->
1744 1746
                          if sep then Format.fprintf fmt ";@;";
1745 1747
                          ((__3 ()) fmt) x;
1746
                          true) false x))) x.declaration;
1748
                          true) false x))) x.e_declaration;
1747 1749
              Format.fprintf fmt ";");
1748 1750
          (match x.stmts with
1749 1751
          | [] -> Format.fprintf fmt "";
......
1776 1778
  ((let open! Ppx_deriving_runtime in
1777 1779
      fun fmt  ->
1778 1780
        fun x  ->
1779
          ((__0 ()) fmt) x.name;
1781
          ((__0 ()) fmt) x.p_name;
1780 1782
          Format.fprintf fmt " is";
1781 1783
          ((fun x  ->
1782 1784
             ignore
......
1826 1828
  ((let open! Ppx_deriving_runtime in
1827 1829
      fun fmt  ->
1828 1830
        fun x  ->
1829
          ((__0 ()) fmt) x.name;
1831
          ((__0 ()) fmt) x.a_name;
1830 1832
          Format.fprintf fmt " of ";
1831 1833
          ((__1 ()) fmt) x.entity;
1832 1834
          Format.fprintf fmt " is@;";
......
1838 1840
                       if sep then Format.fprintf fmt "@;";
1839 1841
                       ((__2 ()) fmt) x;
1840 1842
                       Format.fprintf fmt ";";
1841
                       true) false x))) x.declarations;
1843
                       true) false x))) x.a_declarations;
1842 1844
          Format.fprintf fmt "@.";
1843 1845
          Format.fprintf fmt "@[<v 2>begin@;";
1844
          (match x.body with
1846
          (match x.a_body with
1845 1847
            | [] -> Format.fprintf fmt "";
1846 1848
            | _ ->
1847 1849
               ((fun x  ->
......
1851 1853
                       fun x  ->
1852 1854
                         if sep then Format.fprintf fmt "@;";
1853 1855
                         ((__3 ()) fmt) x;
1854
                         true) false x))) x.body);
1856
                         true) false x))) x.a_body);
1855 1857
          Format.fprintf fmt "@]")
1856 1858
    [@ocaml.warning "-A"])
1857 1859

  

Also available in: Unified diff