Revision 23b37f25
Added by Arnaud Dieumegard over 3 years ago
src/backends/VHDL/vhdl_2_mini_vhdl_map.ml  

1  1 
open Vhdl_ast 
2  2 
open Mini_vhdl_ast 
3 
open Vhdl_ast_fold_sensitivity 

3  4  
4  5 
type db_tuple_t = 
5  6 
{ 
...  ...  
9  10 
mutable contexts: vhdl_load_t list; 
10  11 
} 
11  12  
13 
let get_sensitivity_list = object (self) 

14 
inherit ['acc] fold_sensitivity as super 

15 
end 

16  
12  17 
let _ = fun (_ : vhdl_cst_val_t) > () 
13  18 
let _ = fun (_ : vhdl_type_t) > () 
14  19 
let _ = fun (_ : vhdl_element_declaration_t) > () 
...  ...  
449  454 
fun x > 
450  455 
match x with 
451  456 
 VarAssign { label; lhs; rhs } > 
452 
let label = self#lower_vhdl_name_t label in


457 
let label = match label with NoName > None  _ > Some (self#lower_vhdl_name_t label) in


453  458 
let lhs = self#lower_vhdl_name_t lhs in 
454  459 
let rhs = self#vhdl_expr_t rhs in VarAssign { label; lhs; rhs } 
455  460 
 SigSeqAssign { label; lhs; rhs } > 
456 
let label = self#lower_vhdl_name_t label in


461 
let label = match label with NoName > None  _ > Some (self#lower_vhdl_name_t label) in


457  462 
let lhs = self#lower_vhdl_name_t lhs in 
458 
let rhs = { expr = rhs; cond = None }::[] in


463 
let rhs = self#list self#vhdl_waveform_element_t rhs in


459  464 
SigSeqAssign { label; lhs; rhs } 
460  465 
 If { label; if_cases; default } > 
461 
let label = self#lower_vhdl_name_t label in


466 
let label = match label with NoName > None  _ > Some (self#lower_vhdl_name_t label) in


462  467 
let if_cases = List.map self#vhdl_if_case_t if_cases in 
463  468 
let default = List.map self#vhdl_sequential_stmt_t default in 
464  469 
If { label; if_cases; default } 
465  470 
 Case { label; guard; branches } > 
466 
let label = self#lower_vhdl_name_t label in


471 
let label = match label with NoName > None  _ > Some (self#lower_vhdl_name_t label) in


467  472 
let guard = self#vhdl_expr_t guard in 
468  473 
let branches = List.map self#vhdl_case_item_t branches in 
469  474 
Case { label; guard; branches } 
470  475 
 Exit { label; loop_label; condition } > 
471 
let label = self#lower_vhdl_name_t label in


476 
let label = match label with NoName > None  _ > Some (self#lower_vhdl_name_t label) in


472  477 
let loop_label = self#option self#string loop_label in 
473  478 
let condition = self#option self#vhdl_expr_t condition in 
474  479 
Exit { label; loop_label; condition } 
475  480 
 Assert { label; cond; report; severity } > 
476 
let label = self#lower_vhdl_name_t label in


481 
let label = match label with NoName > None  _ > Some (self#lower_vhdl_name_t label) in


477  482 
let cond = self#vhdl_expr_t cond in 
478  483 
let report = self#vhdl_expr_t report in 
479  484 
let severity = self#vhdl_expr_t severity in 
480  485 
Assert { label; cond; report; severity } 
481  486 
 ProcedureCall { label; name; assocs } > 
482 
let label = self#lower_vhdl_name_t label in


487 
let label = match label with NoName > None  _ > Some (self#lower_vhdl_name_t label) in


483  488 
let name = self#lower_vhdl_name_t name in 
484  489 
let assocs = self#list self#vhdl_assoc_element_t assocs in 
485  490 
ProcedureCall { label; name; assocs } 
486  491 
 Wait > Wait 
487  492 
 Null { label } > 
488 
let label = self#lower_vhdl_name_t label in Null { label } 

493 
let label = match label with NoName > None  _ > Some (self#lower_vhdl_name_t label) in 

494 
Null { label } 

489  495 
 Return { label; expr } > 
490  496 
let label = self#option self#lower_vhdl_name_t label in 
491  497 
let expr = self#option self#vhdl_expr_t expr in 
...  ...  
578  584 
let declarations = List.map self#vhdl_declarative_item_t declarations in 
579  585 
let active_sigs = self#list self#lower_vhdl_name_t active_sigs in 
580  586 
let body = List.map self#vhdl_sequential_stmt_t body in 
581 
{ id; declarations; active_sigs; body } 

587 
let postponed = false in 

588 
let label = None in 

589 
{ id; declarations; active_sigs; body; postponed; label } 

582  590  
583  591 
method vhdl_selected_signal_t : 
584  592 
vhdl_selected_signal_t > vhdl_selected_signal_t= 
...  ...  
617  625 
Process { 
618  626 
id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process"; 
619  627 
declarations = []; 
620 
active_sigs = [];


621 
body = (SigSeqAssign {


622 
label = NoName;


628 
active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x []; (* TODO: Resolve sensitivity list from here *)


629 
body = (SigCondAssign {


630 
label = None;


623  631 
lhs = a.lhs; 
624  632 
rhs = a.rhs; 
625 
})::[] 

633 
delay = match a.delay with  IsNull > None  _ > Some a.delay 

634 
})::[]; 

635 
postponed = a.postponed; 

636 
label = match a.label with  NoName > None  _ > Some a.label 

626  637 
} 
627  638 
 Process a > let a = self#vhdl_process_t a in Process a 
628 
 SelectedSig a > let a = self#vhdl_selected_signal_t a in SelectedSig a (* TODO: convert to Process *) 

639 
 SelectedSig a > 

640 
Process { 

641 
id = self#postfix_flatten_vhdl_name_t a.lhs "__implicit_process"; 

642 
declarations = []; 

643 
active_sigs = get_sensitivity_list#vhdl_concurrent_stmt_t x []; (* TODO: Resolve sensitivity list from here *) 

644 
body = (SigSelectAssign { 

645 
label = None; 

646 
lhs = a.lhs; 

647 
sel = a.sel; 

648 
branches = a.branches; 

649 
delay = a.delay 

650 
})::[]; 

651 
postponed = a.postponed; 

652 
label = match a.label with  NoName > None  _ > Some a.label 

653 
} 

629  654 
 ComponentInst a > let a = self#vhdl_component_instantiation_t a in ComponentInst a (* TODO: instantiate *) 
630  655  
631  656 
method vhdl_port_t : vhdl_port_t > vhdl_port_t= 
...  ...  
693  718 
contexts=contexts; 
694  719 
declarations=declarations; 
695  720 
definitions=definitions; 
696 
body=body 

721 
body=body (* TODO: Flatten component instantiation from here *)


697  722 
} 
698  723  
699  724 
method declarative_items_declarations : vhdl_declarative_item_t list > vhdl_declaration_t list = 
Also available in: Unified diff
Concurrent signal assignment statement transformation to concurrent process statement