Project

General

Profile

Download (5.6 KB) Statistics
| Branch: | Tag: | Revision:
1
open Vhdl_ast
2
open Vhdl_ast_pp
3
open Mini_vhdl_ast
4
open Vhdl_2_mini_vhdl_map
5
open Lustre_types
6
open Utils
7

    
8
let _ = fun (_ : mini_vhdl_component_instantiation_t)  -> () 
9
let _ = fun (_ : mini_vhdl_concurrent_stmt_t)  -> () 
10
let _ = fun (_ : mini_vhdl_component_t)  -> () 
11
let _ = fun (_ : mini_vhdl_design_file_t)  -> () 
12

    
13
class virtual mini_vhdl_to_lustre_map =
14
  object (self)
15
    inherit vhdl_2_mini_vhdl_map
16
    method virtual  list : 'a . ('a -> 'a) -> 'a list -> 'a list
17
    method virtual  mini_vhdl_component_instantiation_t : 
18
      mini_vhdl_component_instantiation_t -> statement
19
    method virtual  mini_vhdl_concurrent_stmt_t : 
20
      mini_vhdl_concurrent_stmt_t -> statement
21
    method virtual  mini_vhdl_component_t : 
22
      mini_vhdl_component_t -> top_decl_desc
23
    method virtual  mini_vhdl_design_file_t : 
24
      mini_vhdl_design_file_t -> program
25

    
26
    method mini_vhdl_component_instantiation_t :
27
      mini_vhdl_component_instantiation_t -> statement=
28
      fun { name; archi; entity; generic_map; port_map }  ->
29
        let name = self#vhdl_name_t name  in
30
        let archi = archi  in
31
        let entity = entity  in
32
        let generic_map = self#list self#vhdl_assoc_element_t generic_map  in
33
        let port_map = self#list self#vhdl_assoc_element_t port_map  in
34
        Eq {eq_lhs=[show_vhdl_name_t name];
35
            eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";
36
                    expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};
37
                    expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};
38
            eq_loc=Location.dummy_loc}
39

    
40
    method mini_vhdl_concurrent_stmt_t :
41
      mini_vhdl_concurrent_stmt_t -> statement=
42
      fun x  ->
43
        match x with
44
        | SigAssign a ->
45
            let a = self#vhdl_conditional_signal_t a  in
46
            Eq {eq_lhs=["SigAssign"];
47
                eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";
48
                        expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};
49
                        expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};
50
                eq_loc=Location.dummy_loc}
51
        | Process a -> let a = self#vhdl_process_t a  in
52
            Eq {eq_lhs=["Process"];
53
                eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";
54
                        expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};
55
                        expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};
56
                eq_loc=Location.dummy_loc}
57
        | SelectedSig a ->
58
            let a = self#vhdl_selected_signal_t a  in 
59
            Eq {eq_lhs=["SelectedSig"];
60
                eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";
61
                        expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};
62
                        expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};
63
                eq_loc=Location.dummy_loc}
64
        | ComponentInst a ->
65
            let a = self#mini_vhdl_component_instantiation_t a  in a
66

    
67
    method mini_vhdl_package_t : vhdl_package_t -> top_decl_desc=
68
      fun { name; shared_defs; shared_decls; shared_uses }  ->
69
        let name = self#vhdl_name_t name  in
70
        let shared_defs = self#list self#vhdl_definition_t shared_defs  in
71
        let shared_decls = self#list self#vhdl_declaration_t shared_decls  in
72
        let shared_uses = self#list self#vhdl_load_t shared_uses in
73
        let node_id = show_vhdl_name_t name in
74
        let node_type = Types.new_var () in
75
        let node_clock = Clocks.new_ck Cvar false in
76
        Node { node_id; node_type; node_clock; 
77
               node_inputs=[]; node_outputs = []; node_locals = [];
78
               node_gencalls = []; node_checks = []; node_asserts = [];
79
               node_stmts = []; node_dec_stateless = false; node_stateless = None; 
80
               node_spec = None; node_annot = [] }
81

    
82
    method mini_vhdl_component_t :
83
      mini_vhdl_component_t -> top_decl_desc=
84
      fun
85
        { names; generics; ports; contexts; declarations; definitions; body }
86
         ->
87
        let names = self#list self#vhdl_name_t names  in
88
        let generics = self#list self#vhdl_port_t generics  in
89
        let ports = self#list self#vhdl_port_t ports  in
90
        let contexts = self#list self#vhdl_load_t contexts  in
91
        let declarations = self#list self#vhdl_declaration_t declarations  in
92
        let definitions = self#list self#vhdl_definition_t definitions  in
93
        let body = List.map self#mini_vhdl_concurrent_stmt_t body  in
94
        let node_id = String.concat "__" (List.map show_vhdl_name_t names) in
95
        let node_type = Types.new_var () in
96
        let node_clock = Clocks.new_ck Cvar false in
97
        Node { node_id; node_type; node_clock; 
98
               node_inputs=[]; node_outputs = []; node_locals = [];
99
               node_gencalls = []; node_checks = []; node_asserts = [];
100
               node_stmts = body; node_dec_stateless = false; node_stateless = None; 
101
               node_spec = None; node_annot = [] }
102

    
103
    method mini_vhdl_design_file_t :
104
      mini_vhdl_design_file_t -> program =
105
      fun { components; packages }  ->
106
        let components = List.map self#mini_vhdl_component_t components  in
107
        let packages = List.map self#mini_vhdl_package_t packages  in
108
        let desc x = { top_decl_desc = x; top_decl_owner = ""; top_decl_itf = false; top_decl_loc = Location.dummy_loc } in
109
        let desc1 = List.map desc components in
110
        let desc2 = List.map desc packages in
111
        desc1 @ desc2
112
  end
(2-2/2)