Project

General

Profile

« Previous | Next » 

Revision 76f9de64

Added by Arnaud Dieumegard over 3 years ago

mutable object field storing architecture<->entities<->contexts relation, generation of MiniVHDL component instantiation

View differences:

src/backends/VHDL/vhdl_2_mini_vhdl_map.ml
1 1
open Vhdl_ast
2 2
open Mini_vhdl_ast
3 3

  
4
type db_tuple_t =
5
  {
6
    mutable entity: vhdl_entity_t;
7
    mutable architecture: vhdl_architecture_t;
8
    mutable contexts: vhdl_load_t list;
9
  }
10

  
4 11
let _ = fun (_ : vhdl_cst_val_t)  -> () 
5 12
let _ = fun (_ : vhdl_type_t)  -> () 
6 13
let _ = fun (_ : vhdl_element_declaration_t)  -> () 
......
72 79
    method virtual  vhdl_subprogram_spec_t : vhdl_subprogram_spec_t -> vhdl_subprogram_spec_t
73 80
    method virtual  vhdl_discrete_range_t : vhdl_discrete_range_t -> vhdl_discrete_range_t
74 81
    method virtual  vhdl_parameter_t : vhdl_parameter_t -> vhdl_parameter_t
75
    method virtual  vhdl_component_instantiation_t : vhdl_component_instantiation_t -> vhdl_component_instantiation_t
76
    method virtual  vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t
82
    method virtual  vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t -> mini_vhdl_concurrent_stmt_t
77 83
    method virtual  vhdl_declaration_t : vhdl_declaration_t -> vhdl_declaration_t
78 84
    method virtual  vhdl_configuration_t : vhdl_configuration_t -> unit
79 85
    method virtual  vhdl_entity_t : vhdl_entity_t -> unit
......
87 93
                                  (vhdl_load_t list * vhdl_entity_t) list * 
88 94
                                  (vhdl_load_t list * vhdl_configuration_t) list *
89 95
                                  (vhdl_load_t list * vhdl_architecture_t)) -> mini_vhdl_component_t
96
    method virtual  vhdl_component_instantiation_t : vhdl_component_instantiation_t -> mini_vhdl_component_instantiation_t
90 97
    method virtual  declarative_items_declarations : vhdl_declarative_item_t list -> vhdl_declaration_t list
91 98
    method virtual  declarative_items_definitions : vhdl_declarative_item_t list -> vhdl_definition_t list
92 99
    method virtual  declarative_items_uses : vhdl_declarative_item_t list -> vhdl_load_t list
93 100
    method virtual  filter_entity : ((vhdl_load_t list * vhdl_entity_t) list * vhdl_name_t) -> 
94 101
                           (vhdl_load_t list * vhdl_entity_t)
95 102

  
103
    val mutable db : db_tuple_t list = []
104

  
105
    method simplify_name_t : vhdl_name_t -> vhdl_name_t=
106
      fun n ->
107
        match n with
108
        | Selected (NoName::tl) -> self#simplify_name_t (Selected tl)
109
        | Selected ((Simple (s))::tl) ->  if (s = "work" || s= "Work") 
110
                                          then self#simplify_name_t (Selected tl)
111
                                          else n
112
        | Selected (a::[]) -> a
113
        | _ -> n
114
    
115
    method db_add_tuple : db_tuple_t -> unit=
116
      fun x -> db <- x::db
117

  
118
    method db_get : vhdl_architecture_t -> (vhdl_entity_t * vhdl_load_t list)=
119
      fun x ->
120
        let rec find a dbl =
121
          match dbl with
122
          | [] -> failwith "No matching tuple in DB"
123
          | e::tl -> if (e.architecture = a) then (e.entity, e.contexts) else find a tl in find x db
124

  
125
    method get_get_from_archi_entity_name : (vhdl_name_t * vhdl_name_t) -> db_tuple_t=
126
      fun (a_name,e_name) ->
127
        let rec find (a_name,e_name) dbl =
128
          match dbl with
129
          | [] -> failwith "No matching tuple in DB"
130
          | e::tl -> if ((self#simplify_name_t e.architecture.name = self#simplify_name_t a_name) && (self#simplify_name_t e.entity.name = self#simplify_name_t e_name)) 
131
                      then e 
132
                      else find (a_name,e_name) tl in 
133
        find (a_name,e_name) db
134

  
96 135
    method vhdl_cst_val_t : vhdl_cst_val_t -> vhdl_cst_val_t=
97 136
      fun x  ->
98 137
        match x with
......
459 498
      fun x  -> x
460 499

  
461 500
    method vhdl_component_instantiation_t :
462
      vhdl_component_instantiation_t -> vhdl_component_instantiation_t=
501
      vhdl_component_instantiation_t -> mini_vhdl_component_instantiation_t=
463 502
        fun { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }  ->
464 503
        let name = self#vhdl_name_t name  in
465
        let inst_unit = self#vhdl_name_t inst_unit  in
466
        let inst_unit_type = self#string inst_unit_type  in
467 504
        let archi_name = self#option self#vhdl_name_t archi_name  in
505
        let db_tuple = match archi_name with
506
          | None -> failwith "Component is not an entity" 
507
          | Some a -> self#get_get_from_archi_entity_name (a,inst_unit) in (* Get corresponding tuple in db *)
508
        let archi = db_tuple.architecture in
509
        let entity = db_tuple.entity in
468 510
        let generic_map = self#list self#vhdl_assoc_element_t generic_map  in
469 511
        let port_map = self#list self#vhdl_assoc_element_t port_map  in
470
        { name; inst_unit; inst_unit_type; archi_name; generic_map; port_map }
512
        { name; archi; entity; generic_map; port_map }
471 513

  
472 514
    method vhdl_concurrent_stmt_t :
473
      vhdl_concurrent_stmt_t -> vhdl_concurrent_stmt_t=
515
      vhdl_concurrent_stmt_t -> mini_vhdl_concurrent_stmt_t=
474 516
      fun x  ->
475 517
        match x with
476 518
        | SigAssign a -> let a = self#vhdl_conditional_signal_t a  in SigAssign a
477 519
        | Process a -> let a = self#vhdl_process_t a  in Process a
478 520
        | SelectedSig a -> let a = self#vhdl_selected_signal_t a  in SelectedSig a
479
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a 
521
        | ComponentInst a -> let a = self#vhdl_component_instantiation_t a  in ComponentInst a
480 522

  
481 523
    method vhdl_port_t : vhdl_port_t -> vhdl_port_t=
482 524
      fun { names; mode; typ; expr }  ->
......
486 528
        let expr = self#vhdl_expr_t expr  in { names; mode; typ; expr }
487 529

  
488 530
    method vhdl_entity_t : vhdl_entity_t -> unit =
489
      fun { name; generics; ports; declaration; stmts }  ->
490
        let name = self#vhdl_name_t name  in
531
      fun { name; generics; ports; declaration; stmts }  -> ()
532
(*        let name = self#vhdl_name_t name  in
491 533
        let generics = self#list self#vhdl_port_t generics  in
492 534
        let ports = self#list self#vhdl_port_t ports  in
493 535
        let declaration = self#list self#vhdl_declarative_item_t declaration
494 536
           in
495
        let stmts = self#list self#vhdl_concurrent_stmt_t stmts  in ()
537
        let stmts = self#list self#vhdl_concurrent_stmt_t stmts  in () *)
496 538

  
497 539
        
498 540

  
......
517 559
        fun ( packs_pairs, ents_pairs, confs_pairs, (arch_ctx, arch) ) ->
518 560
        let names = arch.name::(arch.entity::[])  in
519 561
        let (ref_ent_ctx,ref_ent) = self#filter_entity (ents_pairs, arch.entity) in
562
        self#db_add_tuple {entity=ref_ent; architecture=arch; contexts=ref_ent_ctx@arch_ctx};
520 563
        let contexts =
521
          arch_ctx @ (* Architecture context elements *)
522 564
          ref_ent_ctx @ (* Referenced entity context elements *)
523
          self#declarative_items_uses arch.declarations @ (* Architecture inner context elements *)
524
          self#declarative_items_uses ref_ent.declaration in (* Referenced entity inner context elements *)
565
          arch_ctx @ (* Architecture context elements *)
566
          self#declarative_items_uses ref_ent.declaration @ (* Referenced entity inner context elements *)
567
          self#declarative_items_uses arch.declarations in (* Architecture inner context elements *)
525 568
        let declarations = 
526
          self#declarative_items_declarations arch.declarations @ (* Architecture inner declarations *)
527
          self#declarative_items_declarations ref_ent.declaration in (* Referenced entity inner declarations *)
569
          self#declarative_items_declarations ref_ent.declaration @ (* Referenced entity inner declarations *)
570
          self#declarative_items_declarations arch.declarations in (* Architecture inner declarations *)
528 571
        let definitions =
529
          self#declarative_items_definitions arch.declarations @ (* Architecture inner definitions *)
530
          self#declarative_items_definitions ref_ent.declaration in (* Referenced entity inner definitions *)
572
          self#declarative_items_definitions ref_ent.declaration @ (* Referenced entity inner definitions *)
573
          self#declarative_items_definitions arch.declarations in (* Architecture inner definitions *)
531 574
        let body = 
532
          arch.body @ (* Architecture concurrent statements *)
533
          ref_ent.stmts in (* Referenced entity concurrent statement *)
575
          List.map self#vhdl_concurrent_stmt_t ref_ent.stmts @ (* Referenced entity concurrent statement *)
576
          List.map self#vhdl_concurrent_stmt_t arch.body in (* Architecture concurrent statements *)
534 577
        let generics = ref_ent.generics in (* Referenced entity generics *)
535 578
        let ports = ref_ent.ports in (* Referenced entity ports *)
536 579
        { names; generics=generics; ports=ports; contexts=contexts; declarations=declarations; definitions=definitions; body=body }
......
571 614
      vhdl_configuration_t -> unit= self#unit
572 615

  
573 616
    method vhdl_library_unit_t : vhdl_library_unit_t -> unit=
574
      fun x  ->
575
        match x with
617
      fun x  -> ()
618
(*        match x with
576 619
        | Package a -> let a = self#vhdl_package_t ([],a)  in ()
577 620
        | Entities a -> let a = self#vhdl_entity_t a  in ()
578 621
        | Architecture a ->
579 622
            let a = self#vhdl_architecture_t ([],[],[],([],a))  in ()
580 623
        | Configuration a ->
581
            let a = self#vhdl_configuration_t a  in ()
624
            let a = self#vhdl_configuration_t a  in () *)
582 625

  
583 626
    method vhdl_design_unit_t : vhdl_design_unit_t -> unit=
584
      fun { contexts; library }  ->
585
        let contexts = self#list self#vhdl_load_t contexts  in
586
        let library = self#vhdl_library_unit_t library  in ()
627
      fun { contexts; library }  -> ()
628
(*        let contexts = self#list self#vhdl_load_t contexts  in
629
        let library = self#vhdl_library_unit_t library  in () *)
587 630

  
588 631
    method vhdl_design_file_t : vhdl_design_file_t -> mini_vhdl_design_file_t=
589 632
      fun { design_units }  ->

Also available in: Unified diff