CristalCaveGem » LustreC

open Vhdl_ast

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(*let _ = fun (_ : 'basetype vhdl_type_attributes_t)  -> () *)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

class virtual ['acc] fold_sensitivity =

  object (self)

    method list : 'a. ('a -> 'acc -> 'acc) -> 'a list -> 'acc -> 'acc=

      fun f -> fun l -> fun acc -> List.fold_right f l acc

    method option : 'a. ('a -> 'acc -> 'acc) -> 'a option -> 'acc -> 'acc=

      fun f -> fun e -> fun acc -> match e with None -> acc | Some e -> f e acc

    method string : string -> 'acc -> 'acc=

      fun e -> fun acc -> acc

    method int : int -> 'acc -> 'acc=

      fun e -> fun acc -> acc

    method bool : bool -> 'acc -> 'acc=

      fun e -> fun acc -> acc

    method vhdl_cst_val_t : vhdl_cst_val_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  -> acc

    method vhdl_type_t : vhdl_type_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  -> acc

    method vhdl_element_declaration_t :

      vhdl_element_declaration_t -> 'acc -> 'acc=

      fun { ed_names; definition }  ->

        fun acc  -> acc

    method vhdl_subtype_indication_t :

      vhdl_subtype_indication_t -> 'acc -> 'acc=

      fun { si_name; functionName; const }  ->

        fun acc  ->

          let acc = self#vhdl_name_t si_name acc  in

          let acc = self#vhdl_name_t functionName acc  in

          let acc = self#vhdl_constraint_t const acc  in acc

    method vhdl_discrete_range_t : vhdl_discrete_range_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  ->

          match x with

          | SubDiscreteRange a -> self#vhdl_subtype_indication_t a acc

          | NamedRange a -> self#vhdl_name_t a acc

          | DirectedRange { direction; from; _to } ->

              let acc = self#vhdl_expr_t from acc  in

              let acc = self#vhdl_expr_t _to acc  in acc

    method vhdl_constraint_t : vhdl_constraint_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  ->

          match x with

          | RefConstraint { ref_name } -> self#vhdl_name_t ref_name acc

          | RangeConstraint { range } -> self#vhdl_discrete_range_t range acc

          | IndexConstraint { ranges } ->

              self#list self#vhdl_discrete_range_t ranges acc

          | ArrayConstraint { ranges; sub } ->

              let acc = self#list self#vhdl_discrete_range_t ranges acc  in

              let acc = self#vhdl_constraint_t sub acc  in acc

          | RecordConstraint  -> acc

          | NoConstraint  -> acc

    method vhdl_definition_t : vhdl_definition_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  ->

          match x with

          | Type { name; definition } ->

              let acc = self#vhdl_name_t name acc  in

              let acc = self#vhdl_type_t definition acc  in acc

          | Subtype { name; typ } ->

              let acc = self#vhdl_name_t name acc  in

              let acc = self#vhdl_subtype_indication_t typ acc  in acc

    method vhdl_expr_t : vhdl_expr_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  ->

          match x with

          | Call a -> a::acc

          | Cst { value; unit_name } ->

              let acc = self#vhdl_cst_val_t value acc  in

              let acc = self#option self#vhdl_name_t unit_name acc  in acc

          | Op { id; args } ->

              let acc = self#string id acc  in

              let acc = self#list self#vhdl_expr_t args acc  in acc

          | IsNull  -> acc

          | Time { value; phy_unit } ->

              let acc = self#int value acc  in

              let acc = self#string phy_unit acc  in acc

          | Sig { name; att } ->

              let acc = name::acc  in

              let acc = self#option self#vhdl_signal_attributes_t att acc  in

              acc

          | SuffixMod { expr; selection } ->

              let acc = self#vhdl_expr_t expr acc  in

              let acc = self#vhdl_suffix_selection_t selection acc  in acc

          | Aggregate { elems } ->

              self#list self#vhdl_element_assoc_t elems acc

          | QualifiedExpression { type_mark; aggregate; expression } ->

              let acc = type_mark::acc  in

              let acc = self#list self#vhdl_element_assoc_t aggregate acc  in

              let acc = self#option self#vhdl_expr_t expression acc  in acc

          | Others  -> acc

    method vhdl_name_t : vhdl_name_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  ->

          match x with

          | Simple a -> x::acc

          | Identifier a -> x::acc

          | Selected a -> a@acc

          | Index { id; exprs } -> x::acc

          | Slice { id; range } -> x::acc

          | Attribute { id; designator; expr } ->

              let acc = x::acc in

              let acc = self#vhdl_expr_t expr acc  in acc

          | Function { id; assoc_list } ->

              let acc = x::acc in

              let acc = self#list self#vhdl_assoc_element_t assoc_list acc

                 in

              acc

          | Open -> acc

          | NoName  -> acc

    method vhdl_assoc_element_t : vhdl_assoc_element_t -> 'acc -> 'acc=

      fun

        { formal_name; formal_arg; actual_name; actual_designator;

          actual_expr }

         ->

        fun acc  ->

          let acc = match formal_name with None -> acc | Some a -> a::acc in

          let acc = match formal_arg with None -> acc | Some a -> a::acc in

          let acc = match actual_name with None -> acc | Some a -> a::acc in

          let acc = match actual_designator with None -> acc | Some a -> a::acc in

          let acc = self#option self#vhdl_expr_t actual_expr acc  in acc

    method vhdl_element_assoc_t : vhdl_element_assoc_t -> 'acc -> 'acc=

      fun { choices; expr }  ->

        fun acc  ->

          let acc = self#list self#vhdl_expr_t choices acc  in

          let acc = self#vhdl_expr_t expr acc  in acc

    method vhdl_array_attributes_t : vhdl_array_attributes_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  ->

          match x with

          | AAttInt { id; arg } ->

              let acc = self#string id acc  in

              let acc = self#int arg acc  in acc

          | AAttAscending  -> acc

    method vhdl_signal_attributes_t :

      vhdl_signal_attributes_t -> 'acc -> 'acc=

      fun x  -> fun acc  -> match x with | SigAtt a -> self#string a acc

    method vhdl_string_attributes_t :

      vhdl_string_attributes_t -> 'acc -> 'acc=

      fun x  -> fun acc  -> match x with | StringAtt a -> self#string a acc

    method vhdl_suffix_selection_t : vhdl_suffix_selection_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  ->

          match x with

          | Idx a -> self#int a acc

          | SuffixRange (a,b) ->

              let acc = self#int a acc  in let acc = self#int b acc  in acc

(*    method vhdl_type_attributes_t :

      'a . ('a -> 'acc -> 'acc) -> 'a vhdl_type_attributes_t -> 'acc -> 'acc=

      fun _basetype  ->

        fun x  ->

          fun acc  ->

            match x with

            | TAttNoArg { id } -> self#string id acc

            | TAttIntArg { id; arg } ->

                let acc = self#string id acc  in

                let acc = self#int arg acc  in acc

            | TAttValArg { id; arg } ->

                let acc = self#string id acc  in

                let acc = _basetype arg acc  in acc

            | TAttStringArg { id; arg } ->

                let acc = self#string id acc  in

                let acc = self#string arg acc  in acc *)

    method vhdl_parameter_t : vhdl_parameter_t -> 'acc -> 'acc=

      fun { parameter_names; parameter_mode; parameter_typ; init_val }  ->

        fun acc  ->

          let acc = self#list self#vhdl_name_t parameter_names acc  in

          let acc = self#list self#string parameter_mode acc  in

          let acc = self#vhdl_subtype_indication_t parameter_typ acc  in

          let acc = self#option self#vhdl_cst_val_t init_val acc  in acc

    method vhdl_subprogram_spec_t : vhdl_subprogram_spec_t -> 'acc -> 'acc=

      fun { ss_name; subprogram_type; typeMark; parameters; isPure }  ->

        fun acc  ->

          let acc = self#string ss_name acc  in

          let acc = self#string subprogram_type acc  in

          let acc = self#vhdl_name_t typeMark acc  in

          let acc = self#list self#vhdl_parameter_t parameters acc  in

          let acc = self#bool isPure acc  in acc

    method vhdl_waveform_element_t : vhdl_waveform_element_t -> 'acc -> 'acc=

      fun { value; we_delay }  ->

        fun acc  ->

          let acc = self#option self#vhdl_expr_t value acc  in

          let acc = self#option self#vhdl_expr_t we_delay acc  in acc

    method vhdl_sequential_stmt_t : vhdl_sequential_stmt_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  ->

          match x with

          | VarAssign { label; seqs_lhs; rhs } ->

              let acc = self#vhdl_expr_t rhs acc  in acc

          | SigSeqAssign { label; seqs_lhs; rhs } ->

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

              acc

          | If { label; if_cases; default } ->

              let acc = self#list self#vhdl_if_case_t if_cases acc  in

              let acc = self#list self#vhdl_sequential_stmt_t default acc  in

              acc

          | Case { label; guard; branches } ->

              let acc = self#vhdl_expr_t guard acc  in

              let acc = self#list self#vhdl_case_item_t branches acc  in acc

          | Exit { label; loop_label; condition } ->

              let acc = self#option self#string loop_label acc  in

              let acc = self#option self#vhdl_expr_t condition acc  in acc

          | Assert { label; cond; report; severity } ->

              let acc = self#vhdl_expr_t cond acc  in

              let acc = self#vhdl_expr_t report acc  in

              let acc = self#vhdl_expr_t severity acc  in acc

          | ProcedureCall { label; name; assocs } ->

              let acc = self#vhdl_name_t name acc  in

              let acc = self#list self#vhdl_assoc_element_t assocs acc  in

              acc

          | Wait  -> acc

          | Null { label } -> acc

          | Return { label; expr } ->

              let acc = self#option self#vhdl_expr_t expr acc  in acc

    method vhdl_if_case_t : vhdl_if_case_t -> 'acc -> 'acc=

      fun { if_cond; if_block }  ->

        fun acc  ->

          let acc = self#vhdl_expr_t if_cond acc  in

          let acc = self#list self#vhdl_sequential_stmt_t if_block acc  in

          acc

    method vhdl_case_item_t : vhdl_case_item_t -> 'acc -> 'acc=

      fun { when_cond; when_stmt }  ->

        fun acc  ->

          let acc = self#list self#vhdl_expr_t when_cond acc  in

          let acc = self#list self#vhdl_sequential_stmt_t when_stmt acc  in

          acc

    method vhdl_port_mode_t : vhdl_port_mode_t -> 'acc -> 'acc=

      fun _  -> fun acc  -> acc

    method vhdl_port_t : vhdl_port_t -> 'acc -> 'acc=

      fun { port_names; port_mode; port_typ; port_expr }  ->

        fun acc  ->

          let acc = self#list self#vhdl_name_t port_names acc  in

          let acc = self#vhdl_port_mode_t port_mode acc  in

          let acc = self#vhdl_subtype_indication_t port_typ acc  in

          let acc = self#vhdl_expr_t port_expr acc  in acc

    method vhdl_declaration_t : vhdl_declaration_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  -> acc

    method vhdl_load_t : vhdl_load_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  -> acc

    method vhdl_declarative_item_t : vhdl_declarative_item_t -> 'acc -> 'acc=

      fun { use_clause; di_declaration; di_definition }  ->

        fun acc  -> acc

    method vhdl_signal_condition_t : vhdl_signal_condition_t -> 'acc -> 'acc=

      fun { sc_expr; cond }  ->

        fun acc  ->

          let acc = self#list self#vhdl_waveform_element_t sc_expr acc  in

          let acc = self#option self#vhdl_expr_t cond acc  in acc

    method vhdl_signal_selection_t : vhdl_signal_selection_t -> 'acc -> 'acc=

      fun { ss_expr; when_sel }  ->

        fun acc  ->

          let acc = self#list self#vhdl_waveform_element_t ss_expr acc  in

          let acc = self#list self#vhdl_expr_t when_sel acc  in acc

    method vhdl_conditional_signal_t :

      vhdl_conditional_signal_t -> 'acc -> 'acc=

      fun { cs_postponed; cs_label; cs_lhs; rhs; cs_delay }  ->

        fun acc  ->

          let acc = self#list self#vhdl_signal_condition_t rhs acc  in

          let acc = self#vhdl_expr_t cs_delay acc  in acc

    method vhdl_process_t : vhdl_process_t -> 'acc -> 'acc=

      fun { id; p_declarations; active_sigs; p_body }  ->

        fun acc  ->

          let acc = self#list self#vhdl_sequential_stmt_t p_body acc  in acc

    method vhdl_selected_signal_t : vhdl_selected_signal_t -> 'acc -> 'acc=

      fun { ss_postponed; ss_label; ss_lhs; sel; branches; ss_delay }  ->

        fun acc  ->

          let acc = self#vhdl_expr_t sel acc  in

          let acc = self#list self#vhdl_signal_selection_t branches acc  in

          let acc = self#option self#vhdl_expr_t ss_delay acc  in acc

    method vhdl_component_instantiation_t :

      vhdl_component_instantiation_t -> 'acc -> 'acc=

      fun

        { ci_name; inst_unit; inst_unit_type; archi_name; generic_map; port_map

          }

         ->

        fun acc  -> acc

    method vhdl_concurrent_stmt_t : vhdl_concurrent_stmt_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  ->

          match x with

          | SigAssign a -> self#vhdl_conditional_signal_t a acc

          | Process a -> self#vhdl_process_t a acc

          | SelectedSig a -> self#vhdl_selected_signal_t a acc

          | ComponentInst a -> self#vhdl_component_instantiation_t a acc

    method vhdl_entity_t : vhdl_entity_t -> 'acc -> 'acc=

      fun { e_name; generics; ports; e_declaration; stmts }  ->

        fun acc  -> acc

    method vhdl_package_t : vhdl_package_t -> 'acc -> 'acc=

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

        fun acc  -> acc

    method vhdl_architecture_t : vhdl_architecture_t -> 'acc -> 'acc=

      fun { a_name; entity; a_declarations; a_body }  ->

        fun acc  -> acc

    method vhdl_configuration_t : vhdl_configuration_t -> 'acc -> 'acc=

      fun x -> fun acc -> acc

    method vhdl_library_unit_t : vhdl_library_unit_t -> 'acc -> 'acc=

      fun x  ->

        fun acc  -> acc

    method vhdl_design_unit_t : vhdl_design_unit_t -> 'acc -> 'acc=

      fun { contexts; library }  ->

        fun acc  -> acc

    method vhdl_design_file_t : vhdl_design_file_t -> 'acc -> 'acc=

      fun { design_units }  ->

        fun acc  -> acc

    method vhdl_file_t : vhdl_file_t -> 'acc -> 'acc=

      fun { design_file }  -> 

        fun acc  -> acc

  end