Project

General

Profile

Revision 010428a7 src/backends/VHDL/vhdl_2_mini_vhdl_map.ml

View differences:

src/backends/VHDL/vhdl_2_mini_vhdl_map.ml
7 7
    mutable entity: vhdl_entity_t;
8 8
    mutable architecture: vhdl_architecture_t;
9 9
    mutable architecture_signals: mini_vhdl_declaration_t list;
10
    mutable architecture_ports: vhdl_port_t list;
11
    mutable architecture_generics: vhdl_port_t list;
12
    mutable assigned_names: vhdl_name_t list;
10 13
    mutable contexts: vhdl_load_t list;
11 14
  }
12 15

  
......
189 192
 *)
190 193
    val mutable db : db_tuple_t list = []
191 194

  
195
    method get_db : db_tuple_t list = db
196

  
192 197
    method db_add_tuple : db_tuple_t -> unit=
193 198
      fun x -> db <- x::db
194 199

  
......
214 219
              then e 
215 220
              else find (a_name,e_name) tl in 
216 221
        find (a_name,e_name) db
222

  
223
    method filter_entity : ((vhdl_load_t list * vhdl_entity_t) list * vhdl_name_t) -> 
224
                           (vhdl_load_t list * vhdl_entity_t) =
225
      fun ( entities_pair, filter_name ) ->
226
      let rec filter ep n = match ep with
227
      | [] -> failwith ("Impossible to find an entity with name [" ^ self#to_string_vhdl_name_t filter_name ^ "]")
228
      | (c,{name; generics; ports; declaration; stmts})::tl -> 
229
          if (name = n) then 
230
            List.hd ep
231
          else filter (List.tl ep) n in
232
      filter entities_pair filter_name
217 233
(*******************
218 234
 * End DB helpers
219 235
 *)
220 236

  
237
(*******************
238
 * Begin declarative_item_t projections
239
 *)
240
    method declarative_items_declarations : vhdl_declarative_item_t list -> vhdl_declaration_t list =
241
      fun x ->
242
        match x with
243
        | {use_clause=_; declaration=Some a;definition=_}::tl -> a::(self#declarative_items_declarations tl)
244
        | _::tl -> self#declarative_items_declarations tl
245
        | [] -> []
246

  
247
    method declarative_items_definitions : vhdl_declarative_item_t list -> vhdl_definition_t list =
248
      fun x ->
249
        match x with
250
        | {use_clause=_; declaration=_;definition=Some a}::tl -> a::(self#declarative_items_definitions tl)
251
        | _::tl -> self#declarative_items_definitions tl
252
        | [] -> []
253

  
254
    method declarative_items_uses : vhdl_declarative_item_t list -> vhdl_load_t list =
255
      fun x ->
256
        match x with
257
        | {use_clause=Some a; declaration=_;definition=_}::tl -> a::(self#declarative_items_uses tl)
258
        | _::tl -> self#declarative_items_uses tl
259
        | [] -> []
260
(******************
261
 * End declarative_item_t projections
262
 *)
263

  
264
(*****************
265
 * Begin names_t extraction
266
 *)
267
    method mini_vhdl_concurrent_stmt_t_assigned_signals_names : mini_vhdl_concurrent_stmt_t -> vhdl_name_t list=
268
      fun x ->
269
        match x with
270
        | Process a -> List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names a.body)
271
        | ComponentInst a -> []
272

  
273
    method mini_vhdl_sequential_stmt_t_assigned_signals_names :
274
      mini_vhdl_sequential_stmt_t -> vhdl_name_t list=
275
      fun x  ->
276
        match x with
277
        | VarAssign { label; lhs; rhs } -> [lhs]
278
        | SigSeqAssign { label; lhs; rhs } -> [lhs]
279
        | SigCondAssign { label; lhs; rhs; delay} -> [lhs]
280
        | SigSelectAssign { label; lhs; sel; branches; delay } -> [lhs]
281
        | If { label; if_cases; default } -> 
282
            let if_cases_stmts = List.flatten (List.map (fun x -> x.if_block) if_cases) in
283
            List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names (if_cases_stmts@default))
284
        | Case { label; guard; branches } ->
285
            let case_branches_stmts = List.flatten (List.map (fun x -> x.when_stmt) branches) in
286
            List.flatten (List.map self#mini_vhdl_sequential_stmt_t_assigned_signals_names case_branches_stmts)
287
        | ProcedureCall { label; name; assocs } -> [] (* TODO: resolve this *)
288
        | _ -> []
289
(****************
290
 *End names_t extraction
291
 *)
292

  
221 293
    method vhdl_cst_val_t : vhdl_cst_val_t -> vhdl_cst_val_t=
222 294
      fun x  ->
223 295
        match x with
......
625 697
            Process {
626 698
              id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process";
627 699
              declarations = [];
628
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x []; (* TODO: Resolve sensitivity list from here *)
700
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x [];
629 701
              body = (SigCondAssign {
630 702
                label = None;
631 703
                lhs = a.lhs;
......
640 712
            Process {
641 713
              id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process";
642 714
              declarations = [];
643
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x []; (* TODO: Resolve sensitivity list from here *)
715
              active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x [];
644 716
              body = (SigSelectAssign {
645 717
                label = None;
646 718
                lhs = a.lhs;
......
651 723
              postponed = a.postponed;
652 724
              label = match a.label with | NoName -> None | _ -> Some a.label
653 725
            }
654
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a (* TODO: instantiate *)
726
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a
655 727

  
656 728
    method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
657 729
      fun { names; mode; typ; expr }  ->
......
681 753
                                  (vhdl_load_t list * vhdl_entity_t) list * 
682 754
                                  (vhdl_load_t list * vhdl_configuration_t) list *
683 755
                                  (vhdl_load_t list * vhdl_architecture_t)) -> mini_vhdl_component_t=
684
        fun ( packs_pairs, ents_pairs, confs_pairs, (arch_ctx, arch) ) ->
756
      fun ( packs_pairs, ents_pairs, confs_pairs, (arch_ctx, arch) ) ->
685 757
        let names = arch.name::(arch.entity::[])  in
686 758
        let (ref_ent_ctx,ref_ent) = self#filter_entity (ents_pairs, arch.entity) in
687 759
        let contexts =
......
707 779
            | [] -> []
708 780
            | (SigDecl (s))::tl -> (SigDecl (s))::find_sig_decls tl
709 781
            | _::tl -> find_sig_decls tl in find_sig_decls declarations in
782
        let assigned_names = List.flatten (List.map self#mini_vhdl_concurrent_stmt_t_assigned_signals_names body) in
783
        (* TODO: Flatten component instantiation from here *)
710 784
        self#db_add_tuple { entity=ref_ent; 
711 785
                            architecture=arch; 
712
                            architecture_signals=signals; 
713
                            contexts=ref_ent_ctx@arch_ctx
786
                            architecture_signals=signals;
787
                            architecture_ports=ports;
788
                            architecture_generics=generics;
789
                            assigned_names=assigned_names;
790
                            contexts=contexts;
714 791
                          };
715 792
        { names; 
716 793
          generics=generics; 
......
718 795
          contexts=contexts; 
719 796
          declarations=declarations; 
720 797
          definitions=definitions; 
721
          body=body (* TODO: Flatten component instantiation from here *)
798
          body=body
722 799
        }
723 800

  
724
    method declarative_items_declarations : vhdl_declarative_item_t list -> vhdl_declaration_t list =
725
      fun x ->
726
        match x with
727
        | {use_clause=_; declaration=Some a;definition=_}::tl -> a::(self#declarative_items_declarations tl)
728
        | _::tl -> self#declarative_items_declarations tl
729
        | [] -> []
730

  
731
    method declarative_items_definitions : vhdl_declarative_item_t list -> vhdl_definition_t list =
732
      fun x ->
733
        match x with
734
        | {use_clause=_; declaration=_;definition=Some a}::tl -> a::(self#declarative_items_definitions tl)
735
        | _::tl -> self#declarative_items_definitions tl
736
        | [] -> []
737

  
738
    method declarative_items_uses : vhdl_declarative_item_t list -> vhdl_load_t list =
739
      fun x ->
740
        match x with
741
        | {use_clause=Some a; declaration=_;definition=_}::tl -> a::(self#declarative_items_uses tl)
742
        | _::tl -> self#declarative_items_uses tl
743
        | [] -> []
744

  
745
    method filter_entity : ((vhdl_load_t list * vhdl_entity_t) list * vhdl_name_t) -> 
746
                           (vhdl_load_t list * vhdl_entity_t) =
747
      fun ( entities_pair, filter_name ) ->
748
      let rec filter ep n = match ep with
749
      | [] -> failwith ("Impossible to find an entity with name [" ^ self#to_string_vhdl_name_t filter_name ^ "]")
750
      | (c,{name; generics; ports; declaration; stmts})::tl -> 
751
          if (name = n) then 
752
            List.hd ep
753
          else filter (List.tl ep) n in
754
      filter entities_pair filter_name
755

  
756 801
    method vhdl_configuration_t :
757 802
      vhdl_configuration_t -> unit= self#unit
758 803

  

Also available in: Unified diff