Project

General

Profile

« Previous | Next » 

Revision 92aface4

Added by Arnaud Dieumegard over 3 years ago

Removed warnings and solved bug for visitors iterators references between vhdl_ast and mini_vhdl_ast

View differences:

src/backends/VHDL/vhdl_2_mini_vhdl_map.ml
286 286
    method mini_vhdl_concurrent_stmt_t_assigned_signals_names : mini_vhdl_concurrent_stmt_t -> vhdl_name_t list=
287 287
      fun x ->
288 288
        match x with
289
        | Process a -> List.sort_uniq compare (
289
        | MiniProcess a -> List.sort_uniq compare (
290 290
            List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names a.p_body)
291 291
          )
292
        | ComponentInst a ->
292
        | MiniComponentInst a ->
293 293
            let out_ports_positions = get_ports_pos a.entity.ports OutPort 0 in
294 294
            let inout_ports_positions = get_ports_pos a.entity.ports InoutPort 0 in
295 295
            let assigned_out_ports_names = List.map (fun x -> x.actual_designator) a.port_map in
......
300 300
      mini_vhdl_sequential_stmt_t -> vhdl_name_t list=
301 301
      fun x  ->
302 302
        match x with
303
        | VarAssign { label; lhs; rhs } -> []
304
        | SigSeqAssign { label; lhs; rhs } -> [lhs]
305
        | SigCondAssign { label; lhs; rhs; delay} -> [lhs]
306
        | SigSelectAssign { label; lhs; sel; branches; delay } -> [lhs]
307
        | If { label; if_cases; default } -> 
303
        | MiniVarAssign { label; lhs; rhs } -> []
304
        | MiniSigSeqAssign { label; lhs; rhs } -> [lhs]
305
        | MiniSigCondAssign { label; lhs; rhs; delay} -> [lhs]
306
        | MiniSigSelectAssign { label; lhs; sel; branches; delay } -> [lhs]
307
        | MiniIf { label; if_cases; default } -> 
308 308
            let if_cases_stmts = List.flatten (List.map (fun x -> x.if_block_mini) if_cases) in
309 309
            List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names (if_cases_stmts@default))
310
        | Case { label; guard; branches } ->
310
        | MiniCase { label; guard; branches } ->
311 311
            let case_branches_stmts = List.flatten (List.map (fun x -> x.when_stmt_mini) branches) in
312 312
            List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names case_branches_stmts)
313
        | ProcedureCall { label; name; assocs } -> [] (* TODO: resolve this *)
313
        | MiniProcedureCall { label; name; assocs } -> [] (* TODO: resolve this *)
314 314
        | _ -> []
315 315

  
316 316
(****************
......
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.p_body)
328
        | ComponentInst a -> [] (* Nothing to be reported here as memories are checked for each component *)
327
        | MiniProcess a -> List.flatten (List.map (self#memories assigned_signals []) a.p_body)
328
        | MiniComponentInst 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=
331 331
      fun assigned_signals -> fun mems -> fun x ->
332 332
        match x with
333
        | If { label; if_cases; default } ->
333
        | MiniIf { label; if_cases; default } ->
334 334
            let if_cases_stmts = List.map (fun x -> x.if_block_mini) if_cases in
335 335
            let if_cases_assigned_signals = 
336 336
              List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names (List.flatten (if_cases_stmts@[default])) in
......
339 339
            (match default with
340 340
              | [] -> (List.flatten if_cases_assigned_signals)@mems
341 341
              | _ -> mems)
342
        | Case { label; guard; branches } ->
342
        | MiniCase { label; guard; branches } ->
343 343
            let case_branches_stmts = List.map (fun x -> x.when_stmt_mini) branches in
344 344
         (*   let case_assigned_signals = List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names (List.flatten (case_branches_stmts)) in *)
345 345
            let cases_memories = List.flatten (List.map (fun x -> List.flatten (List.map (self#memories assigned_signals []) x)) (case_branches_stmts)) in
......
616 616
        | VarAssign { label; seqs_lhs; rhs } ->
617 617
            let label = self#option self#lower_vhdl_name_t label in
618 618
            let lhs = self#lower_vhdl_name_t seqs_lhs  in
619
            let rhs = self#vhdl_expr_t rhs  in VarAssign { label; lhs; rhs }
619
            let rhs = self#vhdl_expr_t rhs  in MiniVarAssign { label; lhs; rhs }
620 620
        | SigSeqAssign { label; seqs_lhs; rhs } ->
621 621
            let label = self#option self#lower_vhdl_name_t label in
622 622
            let lhs = self#lower_vhdl_name_t seqs_lhs  in
623 623
            let rhs = self#list self#vhdl_waveform_element_t rhs in
624
            SigSeqAssign { label; lhs; rhs }
624
            MiniSigSeqAssign { label; lhs; rhs }
625 625
        | If { label; if_cases; default } ->
626 626
            let label = self#option self#lower_vhdl_name_t label in
627 627
            let if_cases = List.map self#vhdl_if_case_t if_cases  in
628 628
            let default = List.map self#vhdl_sequential_stmt_t default  in
629
            If { label; if_cases; default }
629
            MiniIf { label; if_cases; default }
630 630
        | Case { label; guard; branches } ->
631 631
            let label = self#option self#lower_vhdl_name_t label in
632 632
            let guard = self#vhdl_expr_t guard  in
633 633
            let branches = List.map self#vhdl_case_item_t branches  in
634
            Case { label; guard; branches }
634
            MiniCase { label; guard; branches }
635 635
        | Exit { label; loop_label; condition } ->
636 636
            let label = self#option self#lower_vhdl_name_t label in
637 637
            let loop_label = self#option self#string loop_label  in
638 638
            let condition = self#option self#vhdl_expr_t condition  in
639
            Exit { label; loop_label; condition }
639
            MiniExit { label; loop_label; condition }
640 640
        | Assert { label; cond; report; severity } ->
641 641
            let label = self#option self#lower_vhdl_name_t label in
642 642
            let cond = self#vhdl_expr_t cond  in
643 643
            let report = self#vhdl_expr_t report  in
644 644
            let severity = self#vhdl_expr_t severity  in
645
            Assert { label; cond; report; severity }
645
            MiniAssert { label; cond; report; severity }
646 646
        | ProcedureCall { label; name; assocs } ->
647 647
            let label = self#option self#lower_vhdl_name_t label in
648 648
            let name = self#lower_vhdl_name_t name  in
649 649
            let assocs = self#list self#vhdl_assoc_element_t assocs  in
650 650
            (* TODO: get procedure declaration and map assoc_elements *)
651
            ProcedureCall { label; name; assocs }
652
        | Wait  -> Wait
651
            MiniProcedureCall { label; name; assocs }
652
        | Wait  -> MiniWait
653 653
        | Null { label } ->
654 654
            let label = self#option self#lower_vhdl_name_t label in
655
            Null { label }
655
            MiniNull { label }
656 656
        | Return { label; expr } ->
657 657
            let label = self#option self#lower_vhdl_name_t label  in
658 658
            let expr = self#option self#vhdl_expr_t expr in
659
            Return { label; expr }
659
            MiniReturn { label; expr }
660 660

  
661 661
    method vhdl_if_case_t : vhdl_if_case_t -> mini_vhdl_if_case_t=
662 662
      fun { if_cond; if_block }  ->
......
677 677
            let names = self#list self#lower_vhdl_name_t names  in
678 678
            let typ = self#vhdl_subtype_indication_t typ  in
679 679
            let init_val = self#vhdl_expr_t init_val  in
680
            VarDecl { names; typ; init_val }
680
            MiniVarDecl { names; typ; init_val }
681 681
        | CstDecl { names; typ; init_val } ->
682 682
            let names = self#list self#lower_vhdl_name_t names  in
683 683
            let typ = self#vhdl_subtype_indication_t typ  in
684 684
            let init_val = self#vhdl_expr_t init_val  in
685
            CstDecl { names; typ; init_val }
685
            MiniCstDecl { names; typ; init_val }
686 686
        | SigDecl { names; typ; init_val } ->
687 687
            let names = self#list self#lower_vhdl_name_t names  in
688 688
            let typ = self#vhdl_subtype_indication_t typ  in
689 689
            let init_val = self#vhdl_expr_t init_val  in
690
            SigDecl { names; typ; init_val }
690
            MiniSigDecl { names; typ; init_val }
691 691
        | ComponentDecl { name; generics; ports } ->
692 692
            let name = self#lower_vhdl_name_t name  in
693 693
            let generics = self#list self#vhdl_port_t generics  in
694 694
            let ports = self#list self#vhdl_port_t ports  in
695
            ComponentDecl { name; generics; ports }
695
            MiniComponentDecl { name; generics; ports }
696 696
        | Subprogram { spec; decl_part; stmts } ->
697 697
            let spec = self#vhdl_subprogram_spec_t spec  in
698 698
            let decl_part = List.map self#vhdl_declaration_t decl_part  in
699 699
            let stmts = List.map self#vhdl_sequential_stmt_t stmts  in
700 700
            (* TODO: Explicit memories *)
701
            Subprogram { spec; decl_part; stmts }
701
            MiniSubprogram { spec; decl_part; stmts }
702 702

  
703 703
    method vhdl_declarative_item_t :
704 704
      vhdl_declarative_item_t -> mini_vhdl_declarative_item_t=
......
792 792
      fun x  ->
793 793
        match x with
794 794
        | SigAssign a -> 
795
            Process {
795
            MiniProcess {
796 796
              id = self#postfix_flatten_vhdl_name_t a.cs_lhs "__implicit_process";
797 797
              p_declarations = [];
798 798
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x [];
799
              p_body = (SigCondAssign {
799
              p_body = (MiniSigCondAssign {
800 800
                label = None;
801 801
                lhs = a.cs_lhs;
802 802
                rhs = a.rhs;
......
805 805
              postponed = a.cs_postponed;
806 806
              label = match a.cs_label with | NoName -> None | _ -> Some a.cs_label
807 807
            }
808
        | Process a -> let a = self#vhdl_process_t a  in Process a
808
        | Process a -> let a = self#vhdl_process_t a  in MiniProcess a
809 809
        | SelectedSig a -> 
810
            Process {
810
            MiniProcess {
811 811
              id = self#postfix_flatten_vhdl_name_t a.ss_lhs "__implicit_process";
812 812
              p_declarations = [];
813 813
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x [];
814
              p_body = (SigSelectAssign {
814
              p_body = (MiniSigSelectAssign {
815 815
                label = None;
816 816
                lhs = a.ss_lhs;
817 817
                sel = a.sel;
......
821 821
              postponed = a.ss_postponed;
822 822
              label = match a.ss_label with | NoName -> None | _ -> Some a.ss_label
823 823
            }
824
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a
824
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in MiniComponentInst a
825 825

  
826 826
    method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
827 827
      fun { port_names; port_mode; port_typ; port_expr }  ->
......
875 875
          let rec find_decls c_declarations acc_s acc_p = 
876 876
            match c_declarations with
877 877
            | [] -> (acc_s, acc_p)
878
            | (SigDecl (s))::tl -> find_decls tl ((SigDecl (s))::acc_s) (acc_p)
879
            | (Subprogram (s))::tl -> find_decls tl (acc_s) ((Subprogram (s))::acc_p)
878
            | (MiniSigDecl (s))::tl -> find_decls tl ((MiniSigDecl (s))::acc_s) (acc_p)
879
            | (MiniSubprogram (s))::tl -> find_decls tl (acc_s) ((MiniSubprogram (s))::acc_p)
880 880
            | _::tl -> find_decls tl acc_s acc_p in find_decls c_declarations [] [] in
881 881
        let assigned_signals_names = List.flatten (List.map self#mini_vhdl_concurrent_stmt_t_assigned_signals_names c_body) in
882 882
        let functions = List.map (
883
          fun x -> match x with Subprogram (s) -> (Simple s.spec.ss_name, s.spec.parameters, s.spec.typeMark) | _ -> failwith "Unreachable error (map on subprograms)"
883
          fun x -> match x with MiniSubprogram (s) -> (Simple s.spec.ss_name, s.spec.parameters, s.spec.typeMark) | _ -> failwith "Unreachable error (map on subprograms)"
884 884
        ) subprograms in
885 885
        let memories = List.flatten (List.map (self#mini_vhdl_concurrent_stmt_t_memories assigned_signals_names) c_body) in
886 886
        let new_tuple = { entity=ref_ent; 

Also available in: Unified diff