CristalCaveGem » LustreC

open Vhdl_ast

open Vhdl_ast_pp

open Mini_vhdl_ast

open Vhdl_2_mini_vhdl_map

open Lustre_types

open Utils

let _ = fun (_ : mini_vhdl_component_instantiation_t)  -> () 

let _ = fun (_ : mini_vhdl_concurrent_stmt_t)  -> () 

let _ = fun (_ : mini_vhdl_component_t)  -> () 

let _ = fun (_ : mini_vhdl_design_file_t)  -> () 

class virtual mini_vhdl_to_lustre_map =

  object (self)

    inherit vhdl_2_mini_vhdl_map

    method virtual  list : 'a . ('a -> 'a) -> 'a list -> 'a list

    method virtual  mini_vhdl_component_instantiation_t : 

      mini_vhdl_component_instantiation_t -> statement

    method virtual  mini_vhdl_concurrent_stmt_t : 

      mini_vhdl_concurrent_stmt_t -> statement

    method virtual  mini_vhdl_component_t : 

      mini_vhdl_component_t -> top_decl_desc

    method virtual  mini_vhdl_design_file_t : 

      mini_vhdl_design_file_t -> program

    method mini_vhdl_declaration_t : mini_vhdl_declaration_t -> mini_vhdl_declaration_t=

      fun x -> x

    method mini_vhdl_process_t : mini_vhdl_process_t -> mini_vhdl_process_t=

      fun x -> x

    method mini_vhdl_component_instantiation_t :

      mini_vhdl_component_instantiation_t -> statement=

      fun { name; archi; entity; generic_map; port_map }  ->

        let name = self#vhdl_name_t name  in

        let archi = archi  in

        let entity = entity  in

        let generic_map = self#list self#vhdl_assoc_element_t generic_map  in

        let port_map = self#list self#vhdl_assoc_element_t port_map  in

        Eq {eq_lhs=[show_vhdl_name_t name];

            eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";

                    expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};

                    expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};

            eq_loc=Location.dummy_loc}

    method mini_vhdl_concurrent_stmt_t :

      mini_vhdl_concurrent_stmt_t -> statement=

      fun x  ->

        match x with

        | Process a -> let a = self#mini_vhdl_process_t a  in

            Eq {eq_lhs=["Process"];

                eq_rhs={expr_tag=Utils.new_tag (); expr_desc=Expr_ident "toto";

                        expr_type={tdesc=Tconst "cst"; tid=0}; expr_clock={cdesc=Cvar;cscoped=false;cid=0};

                        expr_delay={ddesc=Dundef;did=0}; expr_annot=None; expr_loc=Location.dummy_loc};

                eq_loc=Location.dummy_loc}

        | ComponentInst a ->

            let a = self#mini_vhdl_component_instantiation_t a  in a

    method mini_vhdl_package_t : mini_vhdl_package_t -> top_decl_desc=

      fun { name; shared_defs; shared_decls; shared_uses }  ->

        let name = self#vhdl_name_t name  in

        let shared_defs = self#list self#vhdl_definition_t shared_defs  in

        let shared_decls = List.map self#mini_vhdl_declaration_t shared_decls  in

        let shared_uses = self#list self#vhdl_load_t shared_uses in

        let node_id = show_vhdl_name_t name in

        let node_type = Types.new_var () in

        let node_clock = Clocks.new_ck Cvar false in

        Node { node_id; node_type; node_clock; 

               node_inputs=[]; node_outputs = []; node_locals = [];

               node_gencalls = []; node_checks = []; node_asserts = [];

               node_stmts = []; node_dec_stateless = false; node_stateless = None; 

               node_spec = None; node_annot = [] }

    method mini_vhdl_component_t :

      mini_vhdl_component_t -> top_decl_desc=

      fun

        { names; generics; ports; contexts; declarations; definitions; body }

         ->

        let names = self#list self#vhdl_name_t names  in

        let generics = self#list self#vhdl_port_t generics  in

        let ports = self#list self#vhdl_port_t ports  in

        let contexts = self#list self#vhdl_load_t contexts  in

        let declarations = List.map self#mini_vhdl_declaration_t declarations  in

        let definitions = self#list self#vhdl_definition_t definitions  in

        let body = List.map self#mini_vhdl_concurrent_stmt_t body  in

        let node_id = String.concat "__" (List.map show_vhdl_name_t names) in

        let node_type = Types.new_var () in

        let node_clock = Clocks.new_ck Cvar false in

        Node { node_id; node_type; node_clock; 

               node_inputs=[]; node_outputs = []; node_locals = [];

               node_gencalls = []; node_checks = []; node_asserts = [];

               node_stmts = body; node_dec_stateless = false; node_stateless = None; 

               node_spec = None; node_annot = [] }

    method mini_vhdl_design_file_t :

      mini_vhdl_design_file_t -> program =

      fun { components; packages }  ->

        let components = List.map self#mini_vhdl_component_t components  in

        let packages = List.map self#mini_vhdl_package_t packages  in

        let desc x = { top_decl_desc = x; top_decl_owner = ""; top_decl_itf = false; top_decl_loc = Location.dummy_loc } in

        let desc1 = List.map desc components in

        let desc2 = List.map desc packages in

        desc1 @ desc2

  end