Project

General

Profile

Revision 12946cbe src/backends/VHDL/mini_vhdl_ast_transform.ml

View differences:

src/backends/VHDL/mini_vhdl_ast_transform.ml
1 1
open Vhdl_ast
2
open Vhdl_ast_utils
3
open Vhdl_ast_transform
2 4
open Mini_vhdl_ast
5
open Mini_vhdl_ast_pp
3 6

  
4
(* From sensible processes to processes with wait on statement *)
7
(* Generate wait on statement in processes and empty sensitivity list *)
8
(* TODO: add support for "all" construct *)
5 9
let generate_wait_stmt_for_sensible_processes = object (self)
6 10
  inherit [_] mini_vhdl_map as super
7 11

  
......
20 24
        }
21 25
end
22 26

  
23
(* Components instantiation *)
24
let instantiate_components = object (self)
27
(* Flatten components instantiation *)
28
let flatten_components_instantiations = object (self)
25 29
  inherit [_] mini_vhdl_map as super
26 30

  
31
  val mutable components = [];
32
  
33
  method! visit_mini_vhdl_design_file_t env df =
34
    components <- df.components;
35
    let flattened_comps =  List.map (self#visit_mini_vhdl_component_t env) components in
36
    { components = flattened_comps;
37
      packages = df.packages }
38
  
27 39
  method mini_vhdl_comp_inst_to_comp inst =
28 40
    { names = [inst.ci_name];
29 41
      generics = [];
......
34 46
      c_body = [];
35 47
      sub_components = [] }
36 48

  
49
  method prefix_mini_vhdl_conc_stmt_t: string -> mini_vhdl_concurrent_stmt_t -> mini_vhdl_concurrent_stmt_t=
50
    fun pre -> fun conc ->
51
    match conc with
52
    | MiniProcess (a) -> MiniProcess (self#prefix_mini_vhdl_process_t pre a)
53
    | MiniComponentInst (a) ->
54
      failwith ("Component instantiation shall have been flattened at this point: " ^ to_string_vhdl_name_t (flatten_vhdl_name_t a.ci_name))
55
    
56
  method prefix_mini_vhdl_process_t: string -> mini_vhdl_process_t -> mini_vhdl_process_t =
57
    fun pre -> fun {id; p_declarations; active_sigs; p_body; postponed; label} ->
58
    let id = prefix_flatten_vhdl_name_t pre id in
59
    {id; p_declarations; active_sigs; p_body; postponed; label}
60
    
37 61
  method! visit_mini_vhdl_component_t env comp =
38
    let get_component_inst x =  match x with | MiniProcess (a) -> [] | MiniComponentInst (a) -> [a] in
39
      let instantiations = List.flatten (List.map get_component_inst comp.c_body) in
40
      let sub_components = List.map self#mini_vhdl_comp_inst_to_comp instantiations in
62
    let is_component_inst x =  match x with | MiniProcess (a) -> false | MiniComponentInst (a) -> true in
63
    let comp_inst_components = List.filter is_component_inst comp.c_body in
64
    List.iter print_string (List.map show_mini_vhdl_concurrent_stmt_t comp_inst_components);
65
    
66
    let get_instantiated_component lst x = match x with
67
      | MiniProcess (a) -> lst
68
      | MiniComponentInst (a) -> (List.filter (fun x -> x.names = [a.archi.a_name; a.entity.e_name]) components)@lst in
69

  
70
    let instantiated_components = List.fold_left get_instantiated_component [] comp_inst_components in
71
    (* Recursive call to inline instantiated components *)
72
    let instantiated_components = List.map (self#visit_mini_vhdl_component_t env) instantiated_components in
73
    (* Get instantiated components body *)
74
    let inner_conc_stmts = List.flatten (
75
        List.map ( fun x -> (
76
              List.map (
77
                (* Prefix concurrent stmt name with instantiated component name *)
78
                self#prefix_mini_vhdl_conc_stmt_t (String.concat "__" (List.map to_string_vhdl_name_t x.names))
79
              ) x.c_body )
80
        ) instantiated_components) in
81

  
82
    (* Copy inst component content to parent component content *)
83
    let contexts = comp.contexts @ (List.flatten (List.map (fun x -> x.contexts) instantiated_components )) in
84
    let uniq_elem x lst = if (List.mem x lst) then lst else x::lst in
85
    let contexts = List.fold_right uniq_elem contexts [] in
86
    let c_declarations = comp.c_declarations @ (List.flatten (List.map (fun x -> x.c_declarations) instantiated_components )) in
87
    let definitions = comp.definitions @ (List.flatten (List.map (fun x -> x.definitions) instantiated_components )) in
88
    let c_body = comp.c_body @ inner_conc_stmts in 
89
    
41 90
    { names = comp.names; generics = comp.generics; ports = comp.ports; 
42
      contexts = comp.contexts; c_declarations = comp.c_declarations; 
43
      definitions = comp.definitions; c_body = comp.c_body; sub_components }
91
      contexts; c_declarations; definitions; c_body; sub_components = comp.sub_components }
44 92
end
45 93

  
46 94
(* Signals lattice *)

Also available in: Unified diff