%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 2000-2007, 2009-2011 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %-----------------------------------------------------------------------------% % % File: rtti.m. % Authors: zs, fjh. % % Definitions of data structures for representing run-time type information % within the compiler. When output by rtti_out.m, values of most these types % will correspond to the types defined in runtime/mercury_type_info.h; the % documentation of those types can be found there. % The code to generate the structures is in type_ctor_info.m. % See also pseudo_type_info.m. % % This module is independent of whether we are compiling to LLDS or MLDS. It % is used as an intermediate data structure that we generate from the HLDS, % and which we can then convert to either LLDS or MLDS. The LLDS actually % incorporates this data structure unchanged. % %-----------------------------------------------------------------------------% :- module backend_libs.rtti. :- interface. :- import_module hlds. :- import_module hlds.hlds_data. :- import_module hlds.hlds_pred. :- import_module hlds.hlds_rtti. :- import_module libs. :- import_module libs.globals. :- import_module mdbcomp. :- import_module mdbcomp.prim_data. :- import_module parse_tree. :- import_module parse_tree.prog_data. :- import_module bool. :- import_module list. :- import_module set. :- import_module map. :- import_module maybe. :- import_module univ. %-----------------------------------------------------------------------------% % % The data structures representing types, both ground (typeinfos) and % nonground (pseudo-typeinfos). % An rtti_type_info identifies a ground type. % :- type rtti_type_info ---> plain_arity_zero_type_info( rtti_type_ctor ) ; plain_type_info( rtti_type_ctor, % This list should not be empty; if it is, one should % use plain_arity_zero_type_info instead. list(rtti_type_info) ) ; var_arity_type_info( var_arity_ctor_id, list(rtti_type_info) ). % An rtti_pseudo_type_info identifies a possibly non-ground type. % :- type rtti_pseudo_type_info ---> plain_arity_zero_pseudo_type_info( rtti_type_ctor ) ; plain_pseudo_type_info( rtti_type_ctor, % This list should not be empty; if it is, one should % use plain_arity_zero_pseudo_type_info instead. list(rtti_maybe_pseudo_type_info) ) ; var_arity_pseudo_type_info( var_arity_ctor_id, list(rtti_maybe_pseudo_type_info) ) ; type_var(int). % An rtti_maybe_pseudo_type_info identifies a type. If the type is % ground, it should be bound to plain; if it is non-ground, it should % be bound to pseudo. % :- type rtti_maybe_pseudo_type_info ---> pseudo(rtti_pseudo_type_info) ; plain(rtti_type_info). % An rtti_type_ctor uniquely identifies a fixed arity type constructor. % :- type rtti_type_ctor ---> rtti_type_ctor( module_name, % module name string, % type ctor's name arity % type ctor's arity ). % A var_arity_ctor_id uniquely identifies a variable arity type % constructor. :- type var_arity_ctor_id ---> pred_type_info ; func_type_info ; tuple_type_info. %-----------------------------------------------------------------------------% % % The data structures representing type constructors % % A type_ctor_data structure contains all the information that the % runtime system needs to know about a type constructor. % :- type type_ctor_data ---> type_ctor_data( tcr_version :: int, tcr_module_name :: module_name, tcr_type_name :: string, tcr_arity :: int, tcr_unify_pred :: univ, tcr_compare_pred :: univ, tcr_flags :: set(type_ctor_flag), tcr_rep_details :: type_ctor_details ). % Each of the following values corresponds to one of the % MR_TYPE_CTOR_FLAG_* macros in runtime/mercury_type_info.h. % Their meanings are documented there. % :- type type_ctor_flag ---> reserve_tag_flag ; variable_arity_flag ; kind_of_du_flag. % A type_ctor_details structure contains all the information that the % runtime system needs to know about the data representation scheme % used by a type constructor. % % There are four alternatives that correspond to discriminated union: % enum, du, reserved and notag. Enum is for types that define only % constants. Notag is for types that define only one unary functor. % Reserved is for types in which at least one functor is represented % using a reserved value, which may be the address of an object or a % small integer (including zero). Du is for all other types. % % All four alternatives have four kinds of information. % % First, an indication of whether the type has user-defined equality or % not. % % Second, a list of descriptors containing all the function symbols % defined by the type, in declaration order. % % Third, a table that allows the runtime system to map a value in % memory to a printable representation (i.e. to implement the % deconstruct operation). % % Fourth, a table that allows the runtime system to map a printable % representation to a value in memory (i.e. to implement the % construct operation). % % For types in which some function symbols are represented by reserved % addresses, the third component is in two parts: a list of function % symbols so represented, and a table indexed by the primary tag for % all the other function symbols. The runtime system must check every % element on the list before looking at the primary tag. % % For notag types, the single functor descriptor fills the roles of % the second, third and fourth components. % :- type type_ctor_details ---> tcd_enum( enum_axioms :: equality_axioms, enum_functors :: list(enum_functor), enum_value_table :: map(int, enum_functor), enum_name_table :: map(string, enum_functor), enum_is_dummy :: bool, enum_functor_number_mapping :: list(int) ) ; tcd_foreign_enum( foreign_enum_language :: foreign_language, foreign_enum_axioms :: equality_axioms, foreign_enum_functors :: list(foreign_enum_functor), foreign_enum_ordinal_table :: map(int, foreign_enum_functor), foreign_enum_name_table :: map(string, foreign_enum_functor), foreign_enum_functor_number_mapping :: list(int) ) ; tcd_du( du_axioms :: equality_axioms, du_functors :: list(du_functor), du_value_table :: ptag_map, du_name_table :: map(string, map(int, du_functor)), du_functor_number_mapping :: list(int) ) ; tcd_reserved( res_axioms :: equality_axioms, res_functors :: list(maybe_reserved_functor), res_value_table_res :: list(reserved_functor), res_value_table_du :: ptag_map, res_name_table :: map(string, map(int, maybe_reserved_functor)), res_functor_number_mapping :: list(int) ) ; tcd_notag( notag_axioms :: equality_axioms, notag_functor :: notag_functor ) ; tcd_eqv( eqv_type :: rtti_maybe_pseudo_type_info ) ; tcd_builtin( builtin_ctor :: builtin_ctor ) ; tcd_impl_artifact( impl_ctor :: impl_ctor ) ; tcd_foreign( is_stable :: is_stable ). % For a given du family type, this says whether the user has defined % their own unification predicate for the type. % :- type equality_axioms ---> standard ; user_defined. % Descriptor for a functor in an enum type. % % This type corresponds to the C type MR_EnumFunctorDesc. % :- type enum_functor ---> enum_functor( enum_name :: string, enum_ordinal :: int ). % Descriptor for a functor in a foreign enum type. % % This type corresponds to the C Type MR_ForeignEnumFunctorDesc. % :- type foreign_enum_functor ---> foreign_enum_functor( foreign_enum_name :: string, foreign_enum_ordinal :: int, foreign_enum_value :: string ). % Descriptor for a functor in a notag type. % % This type corresponds to the C type MR_NotagFunctorDesc. % :- type notag_functor ---> notag_functor( nt_name :: string, nt_arg_type :: rtti_maybe_pseudo_type_info, nt_arg_name :: maybe(string) ). % Descriptor for a functor in a du type. Also used for functors in % reserved address types which are not represented by a reserved % address. % % This type mostly corresponds to the C type MR_DuFunctorDesc. % :- type du_functor ---> du_functor( du_name :: string, du_orig_arity :: int, du_ordinal :: int, du_rep :: du_rep, du_arg_infos :: list(du_arg_info), du_exist_info :: maybe(exist_info) ). % Descriptor for a functor represented by a reserved address. % % This type corresponds to the C type MR_ReservedAddrFunctorDesc. % :- type reserved_functor ---> reserved_functor( res_name :: string, res_ordinal :: int, res_rep :: reserved_address ). % Descriptor for a functor in reserved address type. % % This type corresponds to the C type MR_MaybeResAddrFunctorDesc, % although their structure is slightly different in order to make % searches on an array of the C structures as convenient as searches % on a list of values of this Mercury type. % :- type maybe_reserved_functor ---> res_func( mrf_res :: reserved_functor ) ; du_func( mrf_du :: du_functor ). % Describes the representation of a functor in a general % discriminated union type. % % Will probably need modification for the Java and IL back ends. % :- type du_rep ---> du_ll_rep( du_ll_ptag :: int, du_ll_sec_tag :: sectag_and_locn ) ; du_hl_rep( remote_sec_tag :: int ). % Describes the types of the existentially typed arguments of a % discriminated union functor. % % This type corresponds to the C type MR_DuExistInfo. % :- type exist_info ---> exist_info( exist_num_plain_typeinfos :: int, exist_num_typeinfos_in_tcis :: int, exist_typeclass_constraints :: list(tc_constraint), exist_typeinfo_locns :: list(exist_typeinfo_locn) ). % Describes the location at which one can find the typeinfo for the % type bound to an existentially quantified type variable in a % discriminated union functor. % % This type corresponds to the C type MR_DuExistLocn. % :- type exist_typeinfo_locn ---> plain_typeinfo( int % The typeinfo is stored directly in the cell, % at this offset. ) ; typeinfo_in_tci( int, % The typeinfo is stored indirectly in the % typeclass info stored at this offset in the cell. int % To find the typeinfo inside the typeclass info % structure, give this integer to the % MR_typeclass_info_type_info macro. ). % These tables let the runtime system interpret values in memory % of general discriminated union types. % % The runtime system should first use the primary tag to index into % the type's ptag_map. It can then find the location (if any) of the % secondary tag, and use the secondary tag (or zero if there isn't one) % to index into the stag_map to find the functor descriptor. % % The type sectag_table corresponds to the C type MR_DuPtagLayout. % The two maps are implemented in C as simple arrays. % :- type ptag_map == map(int, sectag_table). % key is primary tag :- type stag_map == map(int, du_functor). % key is secondary tag :- type sectag_table ---> sectag_table( sectag_locn :: sectag_locn, sectag_num_sharers :: int, sectag_map :: stag_map ). % Describes the location of the secondary tag for a given primary tag % value in a given type. % :- type sectag_locn ---> sectag_none ; sectag_local ; sectag_remote. % Describes the location of the secondary tag and its value for a % given functor in a given type. % :- type sectag_and_locn ---> sectag_locn_none ; sectag_locn_local(int) ; sectag_locn_remote(int). % Information about an argument of a functor in a discriminated union % type. % :- type du_arg_info ---> du_arg_info( du_arg_name :: maybe(string), du_arg_type :: rtti_maybe_pseudo_type_info_or_self ). % An rtti_maybe_pseudo_type_info identifies the type of a function % symbol's argument. If the type of the argument is the same as the % type of the whole term, it should be bound to self. Otherwise, if % the argument's type is ground, it should be bound to plain; if it % is non-ground, it should be bound to pseudo. % :- type rtti_maybe_pseudo_type_info_or_self ---> pseudo(rtti_pseudo_type_info) ; plain(rtti_type_info) ; self. % The list of type constructors for types that are built into the % Mercury language or the Mercury standard library. % :- type builtin_ctor ---> builtin_ctor_int ; builtin_ctor_float ; builtin_ctor_char ; builtin_ctor_string ; builtin_ctor_void ; builtin_ctor_c_pointer(is_stable) ; builtin_ctor_pred_ctor ; builtin_ctor_func_ctor ; builtin_ctor_tuple ; builtin_ctor_ref ; builtin_ctor_type_desc ; builtin_ctor_pseudo_type_desc ; builtin_ctor_type_ctor_desc. % The list of type constructors that are used behind the scenes by % the Mercury implementation. % :- type impl_ctor ---> impl_ctor_hp ; impl_ctor_succip ; impl_ctor_maxfr ; impl_ctor_curfr ; impl_ctor_redofr ; impl_ctor_redoip ; impl_ctor_ticket ; impl_ctor_trail_ptr ; impl_ctor_type_info ; impl_ctor_type_ctor_info ; impl_ctor_typeclass_info ; impl_ctor_base_typeclass_info ; impl_ctor_subgoal. :- type is_stable ---> is_stable ; is_not_stable. %-----------------------------------------------------------------------------% % % The data structures representing type class dictionaries. % % A base_typeclass_info holds information about a typeclass instance. % See notes/type_class_transformation.html for details. % :- type base_typeclass_info ---> base_typeclass_info( % Num_extra = num_unconstrained + num_constraints, % where num_unconstrained is the number of unconstrained % type variables from the head of the instance declaration. num_extra :: int, % Num_constraints is the number of constraints % on the instance declaration. num_constraints :: int, % Num_superclasses is the number of constraints % on the typeclass declaration. num_superclasses :: int, % Class_arity is the number of type variables in the head % of the class declaration. class_arity :: int, % Num_methods is the number of procedures in the typeclass % declaration. num_methods :: int, % Methods is a list of length num_methods containing the % addresses of the methods for this instance declaration. methods :: list(rtti_proc_label) ). %-----------------------------------------------------------------------------% % % The types in this block (until the next horizontal line) will eventually % replace base_typeclass_infos. For now, the C data structures they describe % are generated only on request, and used only by the debugger. % This type corresponds to the C type MR_TypeClassMethod. % :- type tc_method_id ---> tc_method_id( tcm_name :: string, tcm_arity :: int, tcm_pred_or_func :: pred_or_func ). % Uniquely identifies a type class. % :- type tc_name ---> tc_name( tcn_module :: module_name, tcn_name :: string, tcn_arity :: int ). % Values of the tc_id and tc_decl types contain the information about % a type class declaration that we need to interpret other data % structures related to the type class. % % The tc_id type corresponds to the C type MR_TypeClassId, while % the tc_decl type corresponds to the C type MR_TypeClassDecl. % % The reason for splitting the information between two C structures % is to make it easier to allow us to maintain binary compatibility % even if the amount of information we want to record about type class % declarations changes. % :- type tc_id ---> tc_id( tc_id_name :: tc_name, tc_id_type_var_names :: list(string), tc_id_methods :: list(tc_method_id) ). :- type tc_decl ---> tc_decl( tc_decl_id :: tc_id, tc_decl_version_number :: int, tc_decl_supers :: list(tc_constraint) ). :- type tc_type == rtti_maybe_pseudo_type_info. % This type corresponds to the C type MR_TypeClassConstraint_NStruct, % where N is the length of the list in the tcc_types field. % :- type tc_constraint ---> tc_constraint( tcc_class_name :: tc_name, tcc_types :: list(tc_type) ). % Uniquely identifies an instance declaration, and gives information % about the declaration that we need to interpret other data % structures related to the type class. % % This type corresponds to the C type MR_Instance. % :- type tc_instance ---> tc_instance( tci_type_class :: tc_name, tci_types :: list(tc_type), tci_num_type_vars :: int, tci_constraints :: list(tc_constraint), tci_methods :: list(rtti_proc_label) ). % This type corresponds to the C type MR_ClassDict. % % XXX We don't yet use this type. :- type tc_dict ---> tc_dict( tcd_class :: tc_name, tcd_types :: list(rtti_type_info), tcd_methods :: list(rtti_proc_label) ). %-----------------------------------------------------------------------------% % % The data structures representing the top-level global data structures % generated by the Mercury compiler. Usually readonly, with one exception: % data containing code addresses must be initialized at runtime in grades % that don't support static code initializers. :- type rtti_data ---> rtti_data_type_ctor_info( type_ctor_data ) ; rtti_data_type_info( rtti_type_info ) ; rtti_data_pseudo_type_info( rtti_pseudo_type_info ) ; rtti_data_base_typeclass_info( tc_name, % identifies the type class module_name, % module containing instance decl. string, % encodes the names and arities of the % types in the instance declaration base_typeclass_info ) ; rtti_data_type_class_decl( tc_decl ) ; rtti_data_type_class_instance( tc_instance ). % All rtti_data data structures and all their components are identified % by an rtti_id. For data structures that are part of the description % of a single type constructor, we use the ctor_rtti_id functor, and make the % id of that type constructor part of the id of the data structure. % For data structures that are not necessarily associated with a single type, % which for the foreseeable future are all associated with typeclasses, % we use the tc_rtti_id functor. :- type rtti_id ---> ctor_rtti_id(rtti_type_ctor, ctor_rtti_name) ; tc_rtti_id(tc_name, tc_rtti_name). :- type ctor_rtti_name ---> type_ctor_exist_locns(int) % functor ordinal ; type_ctor_exist_locn ; type_ctor_exist_tc_constr(int, int, int) % functor ordinal, % constraint ordinal, % constraint arity ; type_ctor_exist_tc_constrs(int) % functor ordinal ; type_ctor_exist_info(int) % functor ordinal ; type_ctor_field_names(int) % functor ordinal ; type_ctor_field_types(int) % functor ordinal ; type_ctor_res_addrs ; type_ctor_res_addr_functors ; type_ctor_enum_functor_desc(int) % functor ordinal ; type_ctor_foreign_enum_functor_desc(int) % functor ordinal ; type_ctor_notag_functor_desc ; type_ctor_du_functor_desc(int) % functor ordinal ; type_ctor_res_functor_desc(int) % functor ordinal ; type_ctor_enum_name_ordered_table ; type_ctor_enum_value_ordered_table ; type_ctor_foreign_enum_name_ordered_table ; type_ctor_foreign_enum_ordinal_ordered_table ; type_ctor_du_name_ordered_table ; type_ctor_du_stag_ordered_table(int) % primary tag ; type_ctor_du_ptag_ordered_table ; type_ctor_du_ptag_layout(int) % primary tag ; type_ctor_res_value_ordered_table ; type_ctor_res_name_ordered_table ; type_ctor_maybe_res_addr_functor_desc ; type_ctor_functor_number_map ; type_ctor_type_functors ; type_ctor_type_layout ; type_ctor_type_ctor_info ; type_ctor_type_info(rtti_type_info) ; type_ctor_pseudo_type_info(rtti_pseudo_type_info) ; type_ctor_type_hashcons_pointer. :- type tc_rtti_name ---> type_class_base_typeclass_info( module_name, % Module containing instance decl. string % Encodes the names and arities of the % types in the instance declaration. ) ; type_class_id ; type_class_id_var_names ; type_class_id_method_ids ; type_class_decl ; type_class_decl_super(int, int) % superclass ordinal, constraint arity ; type_class_decl_supers ; type_class_instance(list(tc_type)) ; type_class_instance_tc_type_vector(list(tc_type)) ; type_class_instance_constraint(list(tc_type), int, int) % constraint ordinal, constraint arity ; type_class_instance_constraints(list(tc_type)) ; type_class_instance_methods(list(tc_type)). %-----------------------------------------------------------------------------% % % Functions operating on RTTI data % :- func encode_type_ctor_flags(set(type_ctor_flag)) = int. % Return the id of the type constructor. % :- func tcd_get_rtti_type_ctor(type_ctor_data) = rtti_type_ctor. % Convert a rtti_data to an rtti_id. % This calls error/1 if the argument is a type_var/1 rtti_data, % since there is no rtti_id to return in that case. % :- pred rtti_data_to_id(rtti_data::in, rtti_id::out) is det. % Convert an id that specifies a kind of variable arity type_info % or pseudo_type_info into the type_ctor of the canonical (arity-zero) % type of that kind. % :- func var_arity_id_to_rtti_type_ctor(var_arity_ctor_id) = rtti_type_ctor. :- type rtti_id_maybe_element ---> item_type(rtti_id) % The type is the type of the data structure identified by the % rtti_id. ; element_type(rtti_id). % The type is the type of the elements of the data structure % identified by the rtti_id, which must be an array. :- type is_array ---> is_array ; not_array. % Return is_array iff the specified entity is an array. % :- func rtti_id_maybe_element_has_array_type(rtti_id_maybe_element) = is_array. :- func rtti_id_has_array_type(rtti_id) = is_array. :- func ctor_rtti_name_has_array_type(ctor_rtti_name) = is_array. :- func tc_rtti_name_has_array_type(tc_rtti_name) = is_array. % Return yes iff the specified entity should be exported % for use by other modules. % :- func rtti_id_is_exported(rtti_id) = bool. :- func ctor_rtti_name_is_exported(ctor_rtti_name) = bool. :- func tc_rtti_name_is_exported(tc_rtti_name) = bool. % Return the C variable name of the RTTI data structure identified % by the input argument. % :- pred id_to_c_identifier(rtti_id::in, string::out) is det. % Return the C representation of a pred_or_func indication. % :- pred pred_or_func_to_string(pred_or_func::in, string::out) is det. % Return the C representation of a secondary tag location. % :- pred sectag_locn_to_string(sectag_locn::in, string::out) is det. % Return the C representation of a secondary tag location. % :- pred sectag_and_locn_to_locn_string(sectag_and_locn::in, string::out) is det. % Return the C representation of the type_ctor_rep value of the given % type_ctor. % :- pred type_ctor_rep_to_string(type_ctor_data::in, string::out) is det. % Return a name which identifies the rtti_type_info % :- func type_info_to_string(rtti_type_info) = string. % Return a name which identifies the pseudo_type_info % :- func pseudo_type_info_to_string(rtti_pseudo_type_info) = string. % Return the rtti_data containing the given type_info. % :- func type_info_to_rtti_data(rtti_type_info) = rtti_data. % Return the rtti_data containing the given type_info or % pseudo_type_info. % :- func maybe_pseudo_type_info_to_rtti_data(rtti_maybe_pseudo_type_info) = rtti_data. % Return the rtti_data containing the given type_info or % pseudo_type_info or self. % :- func maybe_pseudo_type_info_or_self_to_rtti_data( rtti_maybe_pseudo_type_info_or_self) = rtti_data. % Given a type constructor with the given details, return the number % of primary tag values used by the type. The return value will be % negative if the type constructor doesn't reserve primary tags. % :- func type_ctor_details_num_ptags(type_ctor_details) = int. % Given a type constructor with the given details, return the number % of function symbols defined by the type. The return value will be % negative if the type constructor doesn't define any function symbols. % :- func type_ctor_details_num_functors(type_ctor_details) = int. % Extract the argument name (if any) from a du_arg_info. % :- func du_arg_info_name(du_arg_info) = maybe(string). % Extract the argument type from a du_arg_info. % :- func du_arg_info_type(du_arg_info) = rtti_maybe_pseudo_type_info_or_self. % If the given value is bound to yes, return its argument. % :- func project_yes(maybe(T)) = T is semidet. % Return the symbolic representation of the address of the given % functor descriptor. % :- func enum_functor_rtti_name(enum_functor) = ctor_rtti_name. :- func foreign_enum_functor_rtti_name(foreign_enum_functor) = ctor_rtti_name. :- func du_functor_rtti_name(du_functor) = ctor_rtti_name. :- func res_functor_rtti_name(reserved_functor) = ctor_rtti_name. :- func maybe_res_functor_rtti_name(maybe_reserved_functor) = ctor_rtti_name. % Extract the reserved address from a reserved address functor descriptor. % :- func res_addr_rep(reserved_functor) = reserved_address. % Reserved addresses can be numeric or symbolic. Succeed if the % one passed is numeric. % :- pred res_addr_is_numeric(reserved_address::in) is semidet. % Return true iff the given type of RTTI data structure includes % code addresses. % :- func rtti_id_would_include_code_addr(rtti_id) = bool. :- func ctor_rtti_name_would_include_code_addr(ctor_rtti_name) = bool. :- func tc_rtti_name_would_include_code_addr(tc_rtti_name) = bool. % Return true iff the given type_info's or pseudo_type_info's RTTI % data structure includes code addresses. % :- func type_info_would_incl_code_addr(rtti_type_info) = bool. :- func pseudo_type_info_would_incl_code_addr(rtti_pseudo_type_info) = bool. % rtti_id_c_type(RttiId, Type, IsArray): % % To declare a variable of the type specified by RttiId, put Type % before the name of the variable; if IsArray is true, also put "[]" % after the name. % :- pred rtti_id_maybe_element_c_type(rtti_id_maybe_element::in, string::out, is_array::out) is det. :- pred rtti_id_c_type(rtti_id::in, string::out, is_array::out) is det. :- pred ctor_rtti_name_c_type(ctor_rtti_name::in, string::out, is_array::out) is det. :- pred tc_rtti_name_c_type(tc_rtti_name::in, string::out, is_array::out) is det. % Analogous to rtti_id_c_type. % :- pred rtti_id_maybe_element_java_type(rtti_id_maybe_element::in, string::out, is_array::out) is det. :- pred rtti_id_java_type(rtti_id::in, string::out, is_array::out) is det. :- pred ctor_rtti_name_java_type(ctor_rtti_name::in, string::out, is_array::out) is det. :- pred tc_rtti_name_java_type(tc_rtti_name::in, string::out, is_array::out) is det. % Analogous to rtti_id_c_type. % :- pred rtti_id_maybe_element_csharp_type(rtti_id_maybe_element::in, string::out, is_array::out) is det. :- pred rtti_id_csharp_type(rtti_id::in, string::out, is_array::out) is det. :- pred ctor_rtti_name_csharp_type(ctor_rtti_name::in, string::out, is_array::out) is det. :- pred tc_rtti_name_csharp_type(tc_rtti_name::in, string::out, is_array::out) is det. % Given a type in a type vector in a type class instance declaration, % return its string encoding for use in RTTI data structures, e.g. as % part of C identifiers. % :- func encode_tc_instance_type(tc_type) = string. % Return yes iff the name of the given data structure should be module % qualified. % :- func module_qualify_name_of_rtti_id(rtti_id) = bool. :- func module_qualify_name_of_ctor_rtti_name(ctor_rtti_name) = bool. :- func module_qualify_name_of_tc_rtti_name(tc_rtti_name) = bool. % If the given rtti_id is implemented as a single MR_TypeCtorInfo, % return the identity of the type constructor. % :- pred rtti_id_emits_type_ctor_info(rtti_id::in, rtti_type_ctor::out) is semidet. %----------------------------------------------------------------------------% :- type call_or_answer_table ---> call_table ; answer_table. :- type curr_or_prev_table ---> curr_table ; prev_table. :- type proc_tabling_struct_id ---> tabling_info % A reference to the main structure containing the call table % used to implement memoization, loop checking or minimal model % semantics for the given procedure. ; tabling_ptis % A reference to the part of the tabling structure for the given % procedure that contains pointers to the pseudotypeinfos % describing the procedure's arguments. ; tabling_type_param_locns % A reference to the part of the tabling structure for the given % procedure that contains pointers to the locations of the % typeinfos that give the parameters of the pseudotypeinfos % in the tabling_ptis array. ; tabling_root_node % A reference to the part of the tabling structure for the given % procedure that contains the root of the call table. ; tabling_steps_desc(call_or_answer_table) % A reference to the part of the tabling structure for the given % procedure that gives the nature of each step in the call or % answer table. ; tabling_stats(call_or_answer_table, curr_or_prev_table) % A reference to the part of the tabling structure for the given % procedure that refers to the either the current or the previous % versions of the statistics about overall operations on the % call or answer table. ; tabling_stat_steps(call_or_answer_table, curr_or_prev_table) % A reference to the part of the tabling structure for the given % procedure that refers to the either the current or the previous % versions of the statistics about operations on the steps of the % call or answer table. ; tabling_tips. % A reference to the part of the tabling structure for the given % procedure that contains pointers to the current set of call table % tips, for use as a pool of replacements with limited size tables. :- func tabling_info_id_str(proc_tabling_struct_id) = string. % tabling_id_c_type(TablingId, Type, IsArray): % % To declare a variable of the type specified by TablingId, put Type % before the name of the variable; if IsArray = is_array, also put "[]" % after the name. % :- pred tabling_id_c_type(proc_tabling_struct_id::in, string::out, is_array::out) is det. :- pred tabling_id_java_type(proc_tabling_struct_id::in, string::out, is_array::out) is det. :- func tabling_id_has_array_type(proc_tabling_struct_id) = is_array. :- pred table_trie_step_to_c(table_trie_step::in, string::out, maybe(int)::out) is det. %----------------------------------------------------------------------------% %----------------------------------------------------------------------------% :- implementation. :- import_module backend_libs.name_mangle. :- import_module hlds.hlds_data. :- import_module parse_tree.prog_foreign. :- import_module parse_tree.prog_type. :- import_module int. :- import_module require. :- import_module string. :- import_module table_builtin. %----------------------------------------------------------------------------% encode_type_ctor_flags(FlagSet) = Encoding :- set.to_sorted_list(FlagSet, FlagList), Encoding = list.foldl(encode_type_ctor_flag, FlagList, 0). :- func encode_type_ctor_flag(type_ctor_flag, int) = int. % NOTE: the encoding here must match the one in % runtime/mercury_type_info.h. % encode_type_ctor_flag(reserve_tag_flag, N) = N + 1. encode_type_ctor_flag(variable_arity_flag, N) = N + 2. encode_type_ctor_flag(kind_of_du_flag, N) = N + 4. rtti_data_to_id(RttiData, RttiId) :- ( RttiData = rtti_data_type_ctor_info(TypeCtorData), RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData), RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info) ; RttiData = rtti_data_type_info(TypeInfo), RttiTypeCtor = ti_get_rtti_type_ctor(TypeInfo), RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_info(TypeInfo)) ; RttiData = rtti_data_pseudo_type_info(PseudoTypeInfo), RttiTypeCtor = pti_get_rtti_type_ctor(PseudoTypeInfo), RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_pseudo_type_info(PseudoTypeInfo)) ; RttiData = rtti_data_base_typeclass_info(TCName, Module, Instance, _), TCId = type_class_base_typeclass_info(Module, Instance), RttiId = tc_rtti_id(TCName, TCId) ; RttiData = rtti_data_type_class_decl(tc_decl(TCId, _, _)), TCId = tc_id(TCName, _, _), RttiId = tc_rtti_id(TCName, type_class_decl) ; RttiData = rtti_data_type_class_instance( tc_instance(TCName, TCTypes, _, _, _)), RttiId = tc_rtti_id(TCName, type_class_instance(TCTypes)) ). tcd_get_rtti_type_ctor(TypeCtorData) = RttiTypeCtor :- ModuleName = TypeCtorData ^ tcr_module_name, TypeName = TypeCtorData ^ tcr_type_name, Arity = TypeCtorData ^ tcr_arity, RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, Arity). :- func maybe_pseudo_get_rtti_type_ctor(rtti_maybe_pseudo_type_info) = rtti_type_ctor. maybe_pseudo_get_rtti_type_ctor(plain(TypeInfo)) = ti_get_rtti_type_ctor(TypeInfo). maybe_pseudo_get_rtti_type_ctor(pseudo(PseudoTypeInfo)) = pti_get_rtti_type_ctor(PseudoTypeInfo). :- func ti_get_rtti_type_ctor(rtti_type_info) = rtti_type_ctor. ti_get_rtti_type_ctor(plain_arity_zero_type_info(RttiTypeCtor)) = RttiTypeCtor. ti_get_rtti_type_ctor(plain_type_info(RttiTypeCtor, _)) = RttiTypeCtor. ti_get_rtti_type_ctor(var_arity_type_info(RttiVarArityId, _)) = var_arity_id_to_rtti_type_ctor(RttiVarArityId). :- func pti_get_rtti_type_ctor(rtti_pseudo_type_info) = rtti_type_ctor. pti_get_rtti_type_ctor(plain_arity_zero_pseudo_type_info(RttiTypeCtor)) = RttiTypeCtor. pti_get_rtti_type_ctor(plain_pseudo_type_info(RttiTypeCtor, _)) = RttiTypeCtor. pti_get_rtti_type_ctor(var_arity_pseudo_type_info(RttiVarArityId, _)) = var_arity_id_to_rtti_type_ctor(RttiVarArityId). pti_get_rtti_type_ctor(type_var(_)) = _ :- % there's no rtti_type_ctor associated with a type_var unexpected($module, $pred, "type_var"). var_arity_id_to_rtti_type_ctor(pred_type_info) = Ctor :- Builtin = mercury_public_builtin_module, Ctor = rtti_type_ctor(Builtin, "pred", 0). var_arity_id_to_rtti_type_ctor(func_type_info) = Ctor :- Builtin = mercury_public_builtin_module, Ctor = rtti_type_ctor(Builtin, "func", 0). var_arity_id_to_rtti_type_ctor(tuple_type_info) = Ctor :- Builtin = mercury_public_builtin_module, Ctor = rtti_type_ctor(Builtin, "tuple", 0). rtti_id_maybe_element_has_array_type(item_type(RttiId)) = rtti_id_has_array_type(RttiId). rtti_id_maybe_element_has_array_type(element_type(RttiId)) = not_array :- expect(unify(rtti_id_has_array_type(RttiId), is_array), $module, $pred, "base is not array"). rtti_id_has_array_type(ctor_rtti_id(_, RttiName)) = ctor_rtti_name_has_array_type(RttiName). rtti_id_has_array_type(tc_rtti_id(_, TCRttiName)) = tc_rtti_name_has_array_type(TCRttiName). ctor_rtti_name_has_array_type(RttiName) = IsArray :- ctor_rtti_name_type(RttiName, _, IsArray). tc_rtti_name_has_array_type(TCRttiName) = IsArray :- tc_rtti_name_type(TCRttiName, _, IsArray). rtti_id_is_exported(ctor_rtti_id(_, RttiName)) = ctor_rtti_name_is_exported(RttiName). rtti_id_is_exported(tc_rtti_id(_, TCRttiName)) = tc_rtti_name_is_exported(TCRttiName). ctor_rtti_name_is_exported(type_ctor_exist_locns(_)) = no. ctor_rtti_name_is_exported(type_ctor_exist_locn) = no. ctor_rtti_name_is_exported(type_ctor_exist_tc_constr(_, _, _)) = no. ctor_rtti_name_is_exported(type_ctor_exist_tc_constrs(_)) = no. ctor_rtti_name_is_exported(type_ctor_exist_info(_)) = no. ctor_rtti_name_is_exported(type_ctor_field_names(_)) = no. ctor_rtti_name_is_exported(type_ctor_field_types(_)) = no. ctor_rtti_name_is_exported(type_ctor_res_addrs) = no. ctor_rtti_name_is_exported(type_ctor_res_addr_functors) = no. ctor_rtti_name_is_exported(type_ctor_enum_functor_desc(_)) = no. ctor_rtti_name_is_exported(type_ctor_foreign_enum_functor_desc(_)) = no. ctor_rtti_name_is_exported(type_ctor_notag_functor_desc) = no. ctor_rtti_name_is_exported(type_ctor_du_functor_desc(_)) = no. ctor_rtti_name_is_exported(type_ctor_res_functor_desc(_)) = no. ctor_rtti_name_is_exported(type_ctor_enum_name_ordered_table) = no. ctor_rtti_name_is_exported(type_ctor_enum_value_ordered_table) = no. ctor_rtti_name_is_exported(type_ctor_foreign_enum_name_ordered_table) = no. ctor_rtti_name_is_exported(type_ctor_foreign_enum_ordinal_ordered_table) = no. ctor_rtti_name_is_exported(type_ctor_du_name_ordered_table) = no. ctor_rtti_name_is_exported(type_ctor_du_stag_ordered_table(_)) = no. ctor_rtti_name_is_exported(type_ctor_du_ptag_ordered_table) = no. ctor_rtti_name_is_exported(type_ctor_du_ptag_layout(_)) = no. ctor_rtti_name_is_exported(type_ctor_res_value_ordered_table) = no. ctor_rtti_name_is_exported(type_ctor_res_name_ordered_table) = no. ctor_rtti_name_is_exported(type_ctor_maybe_res_addr_functor_desc) = no. ctor_rtti_name_is_exported(type_ctor_functor_number_map) = no. ctor_rtti_name_is_exported(type_ctor_type_functors) = no. ctor_rtti_name_is_exported(type_ctor_type_layout) = no. ctor_rtti_name_is_exported(type_ctor_type_ctor_info) = yes. ctor_rtti_name_is_exported(type_ctor_type_info(TypeInfo)) = type_info_is_exported(TypeInfo). ctor_rtti_name_is_exported(type_ctor_pseudo_type_info(PseudoTypeInfo)) = pseudo_type_info_is_exported(PseudoTypeInfo). ctor_rtti_name_is_exported(type_ctor_type_hashcons_pointer) = no. tc_rtti_name_is_exported(type_class_base_typeclass_info(_, _)) = yes. tc_rtti_name_is_exported(type_class_id) = no. tc_rtti_name_is_exported(type_class_id_var_names) = no. tc_rtti_name_is_exported(type_class_id_method_ids) = no. tc_rtti_name_is_exported(type_class_decl) = yes. tc_rtti_name_is_exported(type_class_decl_super(_, _)) = no. tc_rtti_name_is_exported(type_class_decl_supers) = no. tc_rtti_name_is_exported(type_class_instance(_)) = yes. tc_rtti_name_is_exported(type_class_instance_tc_type_vector(_)) = no. tc_rtti_name_is_exported(type_class_instance_constraint(_, _, _)) = no. tc_rtti_name_is_exported(type_class_instance_constraints(_)) = no. tc_rtti_name_is_exported(type_class_instance_methods(_)) = no. :- func type_info_is_exported(rtti_type_info) = bool. type_info_is_exported(plain_arity_zero_type_info(_)) = yes. type_info_is_exported(plain_type_info(_, _)) = no. type_info_is_exported(var_arity_type_info(_, _)) = no. :- func pseudo_type_info_is_exported(rtti_pseudo_type_info) = bool. pseudo_type_info_is_exported(plain_arity_zero_pseudo_type_info(_)) = yes. pseudo_type_info_is_exported(plain_pseudo_type_info(_, _)) = no. pseudo_type_info_is_exported(var_arity_pseudo_type_info(_, _)) = no. pseudo_type_info_is_exported(type_var(_)) = no. id_to_c_identifier(ctor_rtti_id(RttiTypeCtor, RttiName), Str) :- Str = name_to_string(RttiTypeCtor, RttiName). id_to_c_identifier(tc_rtti_id(TCName, TCRttiName), Str) :- tc_name_to_string(TCName, TCRttiName, Str). :- func name_to_string(rtti_type_ctor, ctor_rtti_name) = string. name_to_string(RttiTypeCtor, RttiName) = Str :- mangle_rtti_type_ctor(RttiTypeCtor, ModuleName, TypeName, A_str), ( RttiName = type_ctor_exist_locns(Ordinal), string.int_to_string(Ordinal, O_str), string.append_list([ModuleName, "__exist_locns_", TypeName, "_", A_str, "_", O_str], Str) ; RttiName = type_ctor_exist_locn, string.append_list([ModuleName, "__exist_locn_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_exist_tc_constr(Ordinal, TCCNum, _), string.int_to_string(Ordinal, O_str), string.int_to_string(TCCNum, N_str), string.append_list([ModuleName, "__exist_tc_constr_", TypeName, "_", A_str, "_", O_str, "_", N_str], Str) ; RttiName = type_ctor_exist_tc_constrs(Ordinal), string.int_to_string(Ordinal, O_str), string.append_list([ModuleName, "__exist_tc_constrs_", TypeName, "_", A_str, "_", O_str], Str) ; RttiName = type_ctor_exist_info(Ordinal), string.int_to_string(Ordinal, O_str), string.append_list([ModuleName, "__exist_info_", TypeName, "_", A_str, "_", O_str], Str) ; RttiName = type_ctor_field_names(Ordinal), string.int_to_string(Ordinal, O_str), string.append_list([ModuleName, "__field_names_", TypeName, "_", A_str, "_", O_str], Str) ; RttiName = type_ctor_field_types(Ordinal), string.int_to_string(Ordinal, O_str), string.append_list([ModuleName, "__field_types_", TypeName, "_", A_str, "_", O_str], Str) ; RttiName = type_ctor_res_addrs, string.append_list([ModuleName, "__reserved_addrs_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_res_addr_functors, string.append_list([ModuleName, "__reserved_addr_functors_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_enum_functor_desc(Ordinal), string.int_to_string(Ordinal, O_str), string.append_list([ModuleName, "__enum_functor_desc_", TypeName, "_", A_str, "_", O_str], Str) ; RttiName = type_ctor_foreign_enum_functor_desc(Ordinal), string.int_to_string(Ordinal, O_str), string.append_list([ModuleName, "__foreign_enum_functor_desc_", TypeName, "_", A_str, "_", O_str], Str) ; RttiName = type_ctor_notag_functor_desc, string.append_list([ModuleName, "__notag_functor_desc_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_du_functor_desc(Ordinal), string.int_to_string(Ordinal, O_str), string.append_list([ModuleName, "__du_functor_desc_", TypeName, "_", A_str, "_", O_str], Str) ; RttiName = type_ctor_res_functor_desc(Ordinal), string.int_to_string(Ordinal, O_str), string.append_list([ModuleName, "__reserved_addr_functor_desc_", TypeName, "_", A_str, "_", O_str], Str) ; RttiName = type_ctor_enum_name_ordered_table, string.append_list([ModuleName, "__enum_name_ordered_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_enum_value_ordered_table, string.append_list([ModuleName, "__enum_value_ordered_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_foreign_enum_name_ordered_table, string.append_list([ModuleName, "__foreign_enum_name_ordered_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_foreign_enum_ordinal_ordered_table, string.append_list([ModuleName, "__foreign_enum_ordinal_ordered_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_du_name_ordered_table, string.append_list([ModuleName, "__du_name_ordered_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_du_stag_ordered_table(Ptag), string.int_to_string(Ptag, P_str), string.append_list([ModuleName, "__du_stag_ordered_", TypeName, "_", A_str, "_", P_str], Str) ; RttiName = type_ctor_du_ptag_ordered_table, string.append_list([ModuleName, "__du_ptag_ordered_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_du_ptag_layout(Ptag), string.int_to_string(Ptag, P_str), string.append_list([ModuleName, "__du_ptag_layout_", TypeName, "_", A_str, "_", P_str], Str) ; RttiName = type_ctor_res_value_ordered_table, string.append_list([ModuleName, "__res_layout_ordered_table_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_res_name_ordered_table, string.append_list([ModuleName, "__res_name_ordered_table_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_maybe_res_addr_functor_desc, string.append_list([ModuleName, "__maybe_res_addr_functor_desc_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_functor_number_map, string.append_list([ModuleName, "__functor_number_map_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_type_functors, string.append_list([ModuleName, "__type_functors", TypeName, "_", A_str], Str) ; RttiName = type_ctor_type_layout, string.append_list([ModuleName, "__type_layout", TypeName, "_", A_str], Str) ; RttiName = type_ctor_type_ctor_info, string.append_list([ModuleName, "__type_ctor_info_", TypeName, "_", A_str], Str) ; RttiName = type_ctor_type_info(TypeInfo), Str = type_info_to_string(TypeInfo) ; RttiName = type_ctor_pseudo_type_info(PseudoTypeInfo), Str = pseudo_type_info_to_string(PseudoTypeInfo) ; RttiName = type_ctor_type_hashcons_pointer, string.append_list([ModuleName, "__hashcons_ptr_", TypeName, "_", A_str], Str) ). :- pred tc_name_to_string(tc_name::in, tc_rtti_name::in, string::out) is det. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_base_typeclass_info(_ModuleName, InstanceStr), Str = make_base_typeclass_info_name(TCName, InstanceStr). tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_id, mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), Str = ModuleName ++ "__type_class_id_" ++ ClassName ++ "_" ++ ArityStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_id_method_ids, mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), Str = ModuleName ++ "__type_class_id_method_ids_" ++ ClassName ++ "_" ++ ArityStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_id_var_names, mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), Str = ModuleName ++ "__type_class_id_var_names_" ++ ClassName ++ "_" ++ ArityStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_decl, mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), Str = ModuleName ++ "__type_class_decl_" ++ ClassName ++ "_" ++ ArityStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_decl_supers, mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), Str = ModuleName ++ "__type_class_decl_supers_" ++ ClassName ++ "_" ++ ArityStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_decl_super(Ordinal, _), mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), string.int_to_string(Ordinal, OrdinalStr), Str = ModuleName ++ "__type_class_decl_super_" ++ ClassName ++ "_" ++ ArityStr ++ "_" ++ OrdinalStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_instance(TCTypes), mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), TypeStrs = list.map(encode_tc_instance_type, TCTypes), TypeVectorStr = string.append_list(TypeStrs), Str = ModuleName ++ "__type_class_instance_" ++ ClassName ++ "_" ++ ArityStr ++ "_" ++ TypeVectorStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_instance_tc_type_vector(TCTypes), mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), TypeStrs = list.map(encode_tc_instance_type, TCTypes), TypeVectorStr = string.append_list(TypeStrs), Str = ModuleName ++ "__type_class_instance_tc_type_vector_" ++ ClassName ++ "_" ++ ArityStr ++ "_" ++ TypeVectorStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_instance_constraint(TCTypes, Ordinal, _), mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), TypeStrs = list.map(encode_tc_instance_type, TCTypes), TypeVectorStr = string.append_list(TypeStrs), string.int_to_string(Ordinal, OrdinalStr), Str = ModuleName ++ "__type_class_instance_constraint_" ++ ClassName ++ "_" ++ ArityStr ++ "_" ++ OrdinalStr ++ "_" ++ TypeVectorStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_instance_constraints(TCTypes), mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), TypeStrs = list.map(encode_tc_instance_type, TCTypes), TypeVectorStr = string.append_list(TypeStrs), Str = ModuleName ++ "__type_class_instance_constraints_" ++ ClassName ++ "_" ++ ArityStr ++ "_" ++ TypeVectorStr. tc_name_to_string(TCName, TCRttiName, Str) :- TCRttiName = type_class_instance_methods(TCTypes), mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr), TypeStrs = list.map(encode_tc_instance_type, TCTypes), TypeVectorStr = string.append_list(TypeStrs), Str = ModuleName ++ "__type_class_instance_methods_" ++ ClassName ++ "_" ++ ArityStr ++ "_" ++ TypeVectorStr. encode_tc_instance_type(TCType) = Str :- % The encoding we use here depends on the types in instance declarations % being type constructors applied to vectors of distinct variables. When % we lift that restriction, we will have to change this scheme. % % The code here is based on the code of % base_typeclass_info.type_to_string, but its input is of type % `maybe_pseudo_type_info', not of type `type'. ( TCType = plain(TI), ( TI = plain_arity_zero_type_info(RttiTypeCtor), ArgTIs = [] ; TI = plain_type_info(RttiTypeCtor, ArgTIs) ; TI = var_arity_type_info(VarArityId, ArgTIs), RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId) ), Arity = list.length(ArgTIs) % XXX We may wish to check that all arguments are variables. % (possible only if Arity = 0) ; TCType = pseudo(PTI), ( PTI = plain_arity_zero_pseudo_type_info(RttiTypeCtor), ArgPTIs = [] ; PTI = plain_pseudo_type_info(RttiTypeCtor, ArgPTIs) ; PTI = var_arity_pseudo_type_info(VarArityId, ArgPTIs), RttiTypeCtor = var_arity_id_to_rtti_type_ctor(VarArityId) ; PTI = type_var(_), unexpected($module, $pred, "type_var") ), Arity = list.length(ArgPTIs) % XXX We may wish to check that all arguments are variables. ), RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, _CtorArity), TypeStr = sym_name_to_string_sep(qualified(ModuleName, TypeName), "__"), % XXX This naming scheme is the same as for base_typeclass_infos. % We should think about % - whether encoding guarantees different names for different instance % declarations; % - whether the encoding is uniquely invertible, and % - whether the encoding may ever need to be uniquely invertible. Str = TypeStr ++ "__arity" ++ int_to_string(Arity) ++ "__". :- pred mangle_rtti_type_ctor(rtti_type_ctor::in, string::out, string::out, string::out) is det. mangle_rtti_type_ctor(RttiTypeCtor, ModuleName, TypeName, ArityStr) :- RttiTypeCtor = rtti_type_ctor(ModuleNameSym0, TypeName0, TypeArity), % This predicate will be invoked only at stages of compilation % that are after everything has been module qualified. The only % things with an empty module name should be the builtins. ( ModuleNameSym0 = unqualified("") -> ModuleNameSym = mercury_public_builtin_module ; ModuleNameSym = ModuleNameSym0 ), ModuleName = sym_name_mangle(ModuleNameSym), TypeName = name_mangle(TypeName0), string.int_to_string(TypeArity, ArityStr). :- pred mangle_rtti_type_class_name(tc_name::in, string::out, string::out, string::out) is det. mangle_rtti_type_class_name(TCName, ModuleName, ClassName, ArityStr) :- TCName = tc_name(ModuleNameSym, ClassName0, Arity), ModuleName = sym_name_mangle(ModuleNameSym), ClassName = name_mangle(ClassName0), string.int_to_string(Arity, ArityStr). %-----------------------------------------------------------------------------% type_info_to_string(TypeInfo) = Str :- ( TypeInfo = plain_arity_zero_type_info(RttiTypeCtor), RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), id_to_c_identifier(RttiId, Str) ; TypeInfo = plain_type_info(RttiTypeCtor, Args), mangle_rtti_type_ctor(RttiTypeCtor, ModuleName, TypeName, ArityStr), ArgsStr = type_info_list_to_string(Args), Str = ModuleName ++ "__ti_" ++ TypeName ++ "_" ++ ArityStr ++ ArgsStr ; TypeInfo = var_arity_type_info(VarArityId, Args), RealArity = list.length(Args), ArgsStr = type_info_list_to_string(Args), IdStr = var_arity_ctor_id_to_string(VarArityId), Str = "__vti_" ++ IdStr ++ "_" ++ int_to_string(RealArity) ++ ArgsStr ). pseudo_type_info_to_string(PseudoTypeInfo) = Str :- ( PseudoTypeInfo = plain_arity_zero_pseudo_type_info(RttiTypeCtor), RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), id_to_c_identifier(RttiId, Str) ; PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, Args), mangle_rtti_type_ctor(RttiTypeCtor, ModuleName, TypeName, ArityStr), ArgsStr = maybe_pseudo_type_info_list_to_string(Args), Str = ModuleName ++ "__pti_" ++ TypeName ++ "_" ++ ArityStr ++ ArgsStr ; PseudoTypeInfo = var_arity_pseudo_type_info(VarArityId, Args), RealArity = list.length(Args), ArgsStr = maybe_pseudo_type_info_list_to_string(Args), IdStr = var_arity_ctor_id_to_string(VarArityId), Str = "__vpti_" ++ IdStr ++ "_" ++ int_to_string(RealArity) ++ ArgsStr ; PseudoTypeInfo = type_var(VarNum), string.int_to_string(VarNum, Str) ). :- func maybe_pseudo_type_info_to_string(rtti_maybe_pseudo_type_info) = string. maybe_pseudo_type_info_to_string(plain(TypeInfo)) = "__plain_" ++ type_info_to_string(TypeInfo). maybe_pseudo_type_info_to_string(pseudo(PseudoTypeInfo)) = "__pseudo_" ++ pseudo_type_info_to_string(PseudoTypeInfo). :- func var_arity_ctor_id_to_string(var_arity_ctor_id) = string. var_arity_ctor_id_to_string(pred_type_info) = "pred". var_arity_ctor_id_to_string(func_type_info) = "func". var_arity_ctor_id_to_string(tuple_type_info) = "tuple". %-----------------------------------------------------------------------------% :- func maybe_pseudo_type_info_list_to_string( list(rtti_maybe_pseudo_type_info)) = string. maybe_pseudo_type_info_list_to_string(MaybePseudoTypeInfoList) = string.append_list( list.map(maybe_pseudo_type_info_to_string, MaybePseudoTypeInfoList)). :- func pseudo_type_info_list_to_string(list(rtti_pseudo_type_info)) = string. pseudo_type_info_list_to_string(PseudoTypeInfoList) = string.append_list( list.map(pseudo_type_info_to_string, PseudoTypeInfoList)). :- func type_info_list_to_string(list(rtti_type_info)) = string. type_info_list_to_string(TypeInfoList) = string.append_list(list.map(type_info_to_string, TypeInfoList)). %-----------------------------------------------------------------------------% pred_or_func_to_string(pf_predicate, "MR_PREDICATE"). pred_or_func_to_string(pf_function, "MR_FUNCTION"). sectag_locn_to_string(sectag_none, "MR_SECTAG_NONE"). sectag_locn_to_string(sectag_local, "MR_SECTAG_LOCAL"). sectag_locn_to_string(sectag_remote, "MR_SECTAG_REMOTE"). sectag_and_locn_to_locn_string(sectag_locn_none, "MR_SECTAG_NONE"). sectag_and_locn_to_locn_string(sectag_locn_local(_), "MR_SECTAG_LOCAL"). sectag_and_locn_to_locn_string(sectag_locn_remote(_), "MR_SECTAG_REMOTE"). type_ctor_rep_to_string(TypeCtorData, RepStr) :- TypeCtorDetails = TypeCtorData ^ tcr_rep_details, ( TypeCtorDetails = tcd_enum(TypeCtorUserEq, _, _, _, IsDummy, _), ( IsDummy = yes, expect(unify(TypeCtorUserEq, standard), $module, $pred, "dummy type with user equality"), RepStr = "MR_TYPECTOR_REP_DUMMY" ; IsDummy = no, ( TypeCtorUserEq = standard, RepStr = "MR_TYPECTOR_REP_ENUM" ; TypeCtorUserEq = user_defined, RepStr = "MR_TYPECTOR_REP_ENUM_USEREQ" ) ) ; TypeCtorDetails = tcd_foreign_enum(_, TypeCtorUserEq, _, _, _, _), ( TypeCtorUserEq = standard, RepStr = "MR_TYPECTOR_REP_FOREIGN_ENUM" ; TypeCtorUserEq = user_defined, RepStr = "MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ" ) ; TypeCtorDetails = tcd_du(TypeCtorUserEq, _, _, _, _), ( TypeCtorUserEq = standard, RepStr = "MR_TYPECTOR_REP_DU" ; TypeCtorUserEq = user_defined, RepStr = "MR_TYPECTOR_REP_DU_USEREQ" ) ; TypeCtorDetails = tcd_reserved(TypeCtorUserEq, _, _, _, _, _), ( TypeCtorUserEq = standard, RepStr = "MR_TYPECTOR_REP_RESERVED_ADDR" ; TypeCtorUserEq = user_defined, RepStr = "MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ" ) ; TypeCtorDetails = tcd_notag(TypeCtorUserEq, NotagFunctor), NotagEqvType = NotagFunctor ^ nt_arg_type, ( TypeCtorUserEq = standard, ( NotagEqvType = pseudo(_), RepStr = "MR_TYPECTOR_REP_NOTAG" ; NotagEqvType = plain(_), RepStr = "MR_TYPECTOR_REP_NOTAG_GROUND" ) ; TypeCtorUserEq = user_defined, ( NotagEqvType = pseudo(_), RepStr = "MR_TYPECTOR_REP_NOTAG_USEREQ" ; NotagEqvType = plain(_), RepStr = "MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ" ) ) ; TypeCtorDetails = tcd_eqv(EqvType), ( EqvType = pseudo(_), RepStr = "MR_TYPECTOR_REP_EQUIV" ; EqvType = plain(_), RepStr = "MR_TYPECTOR_REP_EQUIV_GROUND" ) ; TypeCtorDetails = tcd_builtin(BuiltinCtor), builtin_ctor_rep_to_string(BuiltinCtor, RepStr) ; TypeCtorDetails = tcd_impl_artifact(ImplCtor), impl_ctor_rep_to_string(ImplCtor, RepStr) ; TypeCtorDetails = tcd_foreign(IsStable), ModuleName = TypeCtorData ^ tcr_module_name, TypeName = TypeCtorData ^ tcr_type_name, TypeArity = TypeCtorData ^ tcr_arity, TypeCtor = type_ctor(qualified(ModuleName, TypeName), TypeArity), ( type_ctor_is_array(TypeCtor) -> % XXX This is a kludge to allow accurate GC to trace arrays. % We should allow users to provide tracing functions for % foreign types. RepStr = "MR_TYPECTOR_REP_ARRAY" ; type_ctor_is_bitmap(TypeCtor) -> % bitmaps are handled much like strings. RepStr = "MR_TYPECTOR_REP_BITMAP" ; ( IsStable = is_stable, RepStr = "MR_TYPECTOR_REP_STABLE_FOREIGN" ; IsStable = is_not_stable, RepStr = "MR_TYPECTOR_REP_FOREIGN" ) ) ). :- pred builtin_ctor_rep_to_string(builtin_ctor::in, string::out) is det. builtin_ctor_rep_to_string(builtin_ctor_int, "MR_TYPECTOR_REP_INT"). builtin_ctor_rep_to_string(builtin_ctor_string, "MR_TYPECTOR_REP_STRING"). builtin_ctor_rep_to_string(builtin_ctor_float, "MR_TYPECTOR_REP_FLOAT"). builtin_ctor_rep_to_string(builtin_ctor_char, "MR_TYPECTOR_REP_CHAR"). builtin_ctor_rep_to_string(builtin_ctor_void, "MR_TYPECTOR_REP_VOID"). builtin_ctor_rep_to_string(builtin_ctor_c_pointer(is_not_stable), "MR_TYPECTOR_REP_C_POINTER"). builtin_ctor_rep_to_string(builtin_ctor_c_pointer(is_stable), "MR_TYPECTOR_REP_STABLE_C_POINTER"). builtin_ctor_rep_to_string(builtin_ctor_pred_ctor, "MR_TYPECTOR_REP_PRED"). builtin_ctor_rep_to_string(builtin_ctor_func_ctor, "MR_TYPECTOR_REP_FUNC"). builtin_ctor_rep_to_string(builtin_ctor_tuple, "MR_TYPECTOR_REP_TUPLE"). builtin_ctor_rep_to_string(builtin_ctor_ref, "MR_TYPECTOR_REP_REFERENCE"). builtin_ctor_rep_to_string(builtin_ctor_type_ctor_desc, "MR_TYPECTOR_REP_TYPECTORDESC"). builtin_ctor_rep_to_string(builtin_ctor_pseudo_type_desc, "MR_TYPECTOR_REP_PSEUDOTYPEDESC"). builtin_ctor_rep_to_string(builtin_ctor_type_desc, "MR_TYPECTOR_REP_TYPEDESC"). :- pred impl_ctor_rep_to_string(impl_ctor::in, string::out) is det. impl_ctor_rep_to_string(impl_ctor_type_ctor_info, "MR_TYPECTOR_REP_TYPECTORINFO"). impl_ctor_rep_to_string(impl_ctor_type_info, "MR_TYPECTOR_REP_TYPEINFO"). impl_ctor_rep_to_string(impl_ctor_typeclass_info, "MR_TYPECTOR_REP_TYPECLASSINFO"). impl_ctor_rep_to_string(impl_ctor_base_typeclass_info, "MR_TYPECTOR_REP_BASETYPECLASSINFO"). impl_ctor_rep_to_string(impl_ctor_hp, "MR_TYPECTOR_REP_HP"). impl_ctor_rep_to_string(impl_ctor_succip, "MR_TYPECTOR_REP_SUCCIP"). impl_ctor_rep_to_string(impl_ctor_curfr, "MR_TYPECTOR_REP_CURFR"). impl_ctor_rep_to_string(impl_ctor_maxfr, "MR_TYPECTOR_REP_MAXFR"). impl_ctor_rep_to_string(impl_ctor_redofr, "MR_TYPECTOR_REP_REDOFR"). impl_ctor_rep_to_string(impl_ctor_redoip, "MR_TYPECTOR_REP_REDOIP"). impl_ctor_rep_to_string(impl_ctor_trail_ptr, "MR_TYPECTOR_REP_TRAIL_PTR"). impl_ctor_rep_to_string(impl_ctor_ticket, "MR_TYPECTOR_REP_TICKET"). impl_ctor_rep_to_string(impl_ctor_subgoal, "MR_TYPECTOR_REP_SUBGOAL"). type_info_to_rtti_data(TypeInfo) = rtti_data_type_info(TypeInfo). maybe_pseudo_type_info_to_rtti_data(pseudo(PseudoTypeInfo)) = rtti_data_pseudo_type_info(PseudoTypeInfo). maybe_pseudo_type_info_to_rtti_data(plain(TypeInfo)) = rtti_data_type_info(TypeInfo). maybe_pseudo_type_info_or_self_to_rtti_data(pseudo(PseudoTypeInfo)) = rtti_data_pseudo_type_info(PseudoTypeInfo). maybe_pseudo_type_info_or_self_to_rtti_data(plain(TypeInfo)) = rtti_data_type_info(TypeInfo). maybe_pseudo_type_info_or_self_to_rtti_data(self) = rtti_data_pseudo_type_info(type_var(0)). type_ctor_details_num_ptags(tcd_enum(_, _, _, _, _, _)) = -1. type_ctor_details_num_ptags(tcd_foreign_enum(_, _, _, _, _, _)) = -1. type_ctor_details_num_ptags(tcd_du(_, _, PtagMap, _, _)) = LastPtag + 1 :- map.keys(PtagMap, Ptags), list.det_last(Ptags, LastPtag). type_ctor_details_num_ptags(tcd_reserved(_, _, _, PtagMap, _, _)) = NumPtags :- map.keys(PtagMap, Ptags), ( Ptags = [], NumPtags = -1 ; Ptags = [_ | _], list.det_last(Ptags, LastPtag), NumPtags = LastPtag + 1 ). type_ctor_details_num_ptags(tcd_notag(_, _)) = -1. type_ctor_details_num_ptags(tcd_eqv(_)) = -1. type_ctor_details_num_ptags(tcd_builtin(_)) = -1. type_ctor_details_num_ptags(tcd_impl_artifact(_)) = -1. type_ctor_details_num_ptags(tcd_foreign(_)) = -1. type_ctor_details_num_functors(tcd_enum(_, Functors, _, _, _, _)) = list.length(Functors). type_ctor_details_num_functors(tcd_foreign_enum(_, _, Functors, _, _, _)) = list.length(Functors). type_ctor_details_num_functors(tcd_du(_, Functors, _, _, _)) = list.length(Functors). type_ctor_details_num_functors(tcd_reserved(_, Functors, _, _, _, _)) = list.length(Functors). type_ctor_details_num_functors(tcd_notag(_, _)) = 1. type_ctor_details_num_functors(tcd_eqv(_)) = -1. type_ctor_details_num_functors(tcd_builtin(_)) = -1. type_ctor_details_num_functors(tcd_impl_artifact(_)) = -1. type_ctor_details_num_functors(tcd_foreign(_)) = -1. du_arg_info_name(ArgInfo) = ArgInfo ^ du_arg_name. du_arg_info_type(ArgInfo) = ArgInfo ^ du_arg_type. project_yes(yes(X)) = X. enum_functor_rtti_name(EnumFunctor) = type_ctor_enum_functor_desc(EnumFunctor ^ enum_ordinal). foreign_enum_functor_rtti_name(EnumFunctor) = type_ctor_foreign_enum_functor_desc(EnumFunctor ^ foreign_enum_ordinal). du_functor_rtti_name(DuFunctor) = type_ctor_du_functor_desc(DuFunctor ^ du_ordinal). res_functor_rtti_name(ResFunctor) = type_ctor_res_functor_desc(ResFunctor ^ res_ordinal). maybe_res_functor_rtti_name(du_func(DuFunctor)) = type_ctor_du_functor_desc(DuFunctor ^ du_ordinal). maybe_res_functor_rtti_name(res_func(ResFunctor)) = type_ctor_res_functor_desc(ResFunctor ^ res_ordinal). res_addr_rep(ResFunctor) = ResFunctor ^ res_rep. res_addr_is_numeric(null_pointer). res_addr_is_numeric(small_pointer(_)). rtti_id_would_include_code_addr(ctor_rtti_id(_, RttiName)) = ctor_rtti_name_would_include_code_addr(RttiName). rtti_id_would_include_code_addr(tc_rtti_id(_, TCRttiName)) = tc_rtti_name_would_include_code_addr(TCRttiName). ctor_rtti_name_would_include_code_addr(RttiName) = % Just to make the table not overflow every line. ctor_rtti_name_code_addr(RttiName). tc_rtti_name_would_include_code_addr(TCName) = % Just to make the table not overflow every line. tc_rtti_name_code_addr(TCName). :- func ctor_rtti_name_code_addr(ctor_rtti_name) = bool. ctor_rtti_name_code_addr(type_ctor_exist_locns(_)) = no. ctor_rtti_name_code_addr(type_ctor_exist_locn) = no. ctor_rtti_name_code_addr(type_ctor_exist_tc_constr(_, _, _)) = no. ctor_rtti_name_code_addr(type_ctor_exist_tc_constrs(_)) = no. ctor_rtti_name_code_addr(type_ctor_exist_info(_)) = no. ctor_rtti_name_code_addr(type_ctor_field_names(_)) = no. ctor_rtti_name_code_addr(type_ctor_field_types(_)) = no. ctor_rtti_name_code_addr(type_ctor_res_addrs) = no. ctor_rtti_name_code_addr(type_ctor_res_addr_functors) = no. ctor_rtti_name_code_addr(type_ctor_enum_functor_desc(_)) = no. ctor_rtti_name_code_addr(type_ctor_foreign_enum_functor_desc(_)) = no. ctor_rtti_name_code_addr(type_ctor_notag_functor_desc) = no. ctor_rtti_name_code_addr(type_ctor_du_functor_desc(_)) = no. ctor_rtti_name_code_addr(type_ctor_res_functor_desc(_)) = no. ctor_rtti_name_code_addr(type_ctor_enum_name_ordered_table) = no. ctor_rtti_name_code_addr(type_ctor_enum_value_ordered_table) = no. ctor_rtti_name_code_addr(type_ctor_foreign_enum_name_ordered_table) = no. ctor_rtti_name_code_addr(type_ctor_foreign_enum_ordinal_ordered_table) = no. ctor_rtti_name_code_addr(type_ctor_du_name_ordered_table) = no. ctor_rtti_name_code_addr(type_ctor_du_stag_ordered_table(_)) = no. ctor_rtti_name_code_addr(type_ctor_du_ptag_ordered_table) = no. ctor_rtti_name_code_addr(type_ctor_du_ptag_layout(_)) = no. ctor_rtti_name_code_addr(type_ctor_res_value_ordered_table) = no. ctor_rtti_name_code_addr(type_ctor_res_name_ordered_table) = no. ctor_rtti_name_code_addr(type_ctor_maybe_res_addr_functor_desc) = no. ctor_rtti_name_code_addr(type_ctor_functor_number_map) = no. ctor_rtti_name_code_addr(type_ctor_type_hashcons_pointer) = no. ctor_rtti_name_code_addr(type_ctor_type_functors) = no. ctor_rtti_name_code_addr(type_ctor_type_layout) = no. ctor_rtti_name_code_addr(type_ctor_type_ctor_info) = yes. ctor_rtti_name_code_addr(type_ctor_type_info(TypeInfo)) = type_info_would_incl_code_addr(TypeInfo). ctor_rtti_name_code_addr(type_ctor_pseudo_type_info(PseudoTypeInfo)) = pseudo_type_info_would_incl_code_addr(PseudoTypeInfo). :- func tc_rtti_name_code_addr(tc_rtti_name) = bool. tc_rtti_name_code_addr(type_class_base_typeclass_info(_, _)) = yes. tc_rtti_name_code_addr(type_class_id) = no. tc_rtti_name_code_addr(type_class_id_var_names) = no. tc_rtti_name_code_addr(type_class_id_method_ids) = no. tc_rtti_name_code_addr(type_class_decl) = no. tc_rtti_name_code_addr(type_class_decl_super(_, _)) = no. tc_rtti_name_code_addr(type_class_decl_supers) = no. tc_rtti_name_code_addr(type_class_instance(_)) = no. tc_rtti_name_code_addr(type_class_instance_tc_type_vector(_)) = no. tc_rtti_name_code_addr(type_class_instance_constraint(_, _, _)) = no. tc_rtti_name_code_addr(type_class_instance_constraints(_)) = no. tc_rtti_name_code_addr(type_class_instance_methods(_)) = no. type_info_would_incl_code_addr(plain_arity_zero_type_info(_)) = yes. type_info_would_incl_code_addr(plain_type_info(_, _)) = no. type_info_would_incl_code_addr(var_arity_type_info(_, _)) = no. pseudo_type_info_would_incl_code_addr(plain_arity_zero_pseudo_type_info(_)) = yes. pseudo_type_info_would_incl_code_addr(plain_pseudo_type_info(_, _)) = no. pseudo_type_info_would_incl_code_addr(var_arity_pseudo_type_info(_, _)) = no. pseudo_type_info_would_incl_code_addr(type_var(_)) = no. rtti_id_maybe_element_c_type(item_type(RttiId), CTypeName, IsArray) :- rtti_id_c_type(RttiId, CTypeName, IsArray). rtti_id_maybe_element_c_type(element_type(RttiId), CTypeName, IsArray) :- rtti_id_c_type(RttiId, CTypeName, IsArray0), ( IsArray0 = not_array, unexpected($module, $pred, "base is not array") ; IsArray0 = is_array, IsArray = not_array ). rtti_id_c_type(ctor_rtti_id(_, RttiName), CTypeName, IsArray) :- ctor_rtti_name_c_type(RttiName, CTypeName, IsArray). rtti_id_c_type(tc_rtti_id(_, TCRttiName), CTypeName, IsArray) :- tc_rtti_name_c_type(TCRttiName, CTypeName, IsArray). ctor_rtti_name_c_type(RttiName, CTypeName, IsArray) :- ctor_rtti_name_type(RttiName, GenTypeName, IsArray), CTypeName = "MR_" ++ GenTypeName. tc_rtti_name_c_type(TCRttiName, CTypeName, IsArray) :- tc_rtti_name_type(TCRttiName, GenTypeName, IsArray), CTypeName = string.append("MR_", GenTypeName). rtti_id_maybe_element_java_type(item_type(RttiId), CTypeName, IsArray) :- rtti_id_java_type(RttiId, CTypeName, IsArray). rtti_id_maybe_element_java_type(element_type(RttiId), CTypeName, IsArray) :- rtti_id_java_type(RttiId, CTypeName, IsArray0), ( IsArray0 = not_array, unexpected($module, $pred, "base is not array") ; IsArray0 = is_array, IsArray = not_array ). rtti_id_java_type(ctor_rtti_id(_, RttiName), JavaTypeName, IsArray) :- ctor_rtti_name_java_type(RttiName, JavaTypeName, IsArray). rtti_id_java_type(tc_rtti_id(_, TCRttiName), JavaTypeName, IsArray) :- tc_rtti_name_java_type(TCRttiName, JavaTypeName, IsArray). ctor_rtti_name_java_type(RttiName, JavaTypeName, IsArray) :- ctor_rtti_name_type(RttiName, GenTypeName0, IsArray), ( % Java doesn't have typedefs (or "const"), % so we need to use "String" rather than "ConstString" GenTypeName0 = "ConstString" -> JavaTypeName = "java.lang.String" ; GenTypeName0 = "Integer" -> JavaTypeName = "int" ; % In Java, every non-builtin type is a pointer, % so there's no need for the "Ptr" suffixes. string.remove_suffix(GenTypeName0, "Ptr", GenTypeName1) -> JavaTypeName = "jmercury.runtime." ++ GenTypeName1 ; % In C, we do some nasty hacks to represent type class % constraints of different arities as different structures % ending with arrays of the appropriate length, but in % Java we just use a single type for all of them % (with an extra level of indirection for the array). string.prefix(GenTypeName0, "TypeClassConstraint_") -> JavaTypeName = "jmercury.runtime.TypeClassConstraint" ; % In C, we do some nasty hacks to represent type infos % different arities as different structures % ending with arrays of the appropriate length, but in % Java we just use a single type for all of them % (with an extra level of indirection for the array). ( string.prefix(GenTypeName0, "FA_PseudoTypeInfo_Struct") ; string.prefix(GenTypeName0, "FA_TypeInfo_Struct") ; string.prefix(GenTypeName0, "VA_PseudoTypeInfo_Struct") ; string.prefix(GenTypeName0, "VA_TypeInfo_Struct") ) -> JavaTypeName = "jmercury.runtime.TypeInfo_Struct" ; JavaTypeName = "jmercury.runtime." ++ GenTypeName0 ). tc_rtti_name_java_type(TCRttiName, JavaTypeName, IsArray) :- tc_rtti_name_type(TCRttiName, GenTypeName, IsArray), ( % BaseTypeClassInfo in C is represented using a % variable-length array as the last field, % so we need to handle it specially in Java GenTypeName = "BaseTypeclassInfo" -> JavaTypeName = "java.lang.Object" /* & IsArray = yes */ ; % Java doesn't have typedefs (or "const"), % so we need to use "String" rather than "ConstString" GenTypeName = "ConstString" -> JavaTypeName = "java.lang.String" ; % In C, we do some nasty hacks to represent type class % constraints of different arities as different structures % ending with arrays of the appropriate length, but in % Java we just use a single type for all of them % (with an extra level of indirection for the array). string.prefix(GenTypeName, "TypeClassConstraint_") -> JavaTypeName = "jmercury.runtime.TypeClassConstraint" ; % The rest are all defined in Mercury's Java runtime % (java/runtime/*.java). JavaTypeName = "jmercury.runtime." ++ GenTypeName ). rtti_id_maybe_element_csharp_type(item_type(RttiId), CTypeName, IsArray) :- rtti_id_csharp_type(RttiId, CTypeName, IsArray). rtti_id_maybe_element_csharp_type(element_type(RttiId), CTypeName, IsArray) :- rtti_id_csharp_type(RttiId, CTypeName, IsArray0), ( IsArray0 = not_array, unexpected($module, $pred, "base is not array") ; IsArray0 = is_array, IsArray = not_array ). rtti_id_csharp_type(ctor_rtti_id(_, RttiName), CsharpTypeName, IsArray) :- ctor_rtti_name_csharp_type(RttiName, CsharpTypeName, IsArray). rtti_id_csharp_type(tc_rtti_id(_, TCRttiName), CsharpTypeName, IsArray) :- tc_rtti_name_csharp_type(TCRttiName, CsharpTypeName, IsArray). ctor_rtti_name_csharp_type(RttiName, CsharpTypeName, IsArray) :- ctor_rtti_name_type(RttiName, GenTypeName0, IsArray), ( GenTypeName0 = "ConstString" -> CsharpTypeName = "string" ; GenTypeName0 = "Integer" -> CsharpTypeName = "int" ; string.remove_suffix(GenTypeName0, "Ptr", GenTypeName1) -> CsharpTypeName = "runtime." ++ GenTypeName1 ; string.prefix(GenTypeName0, "TypeClassConstraint_") -> CsharpTypeName = "runtime.TypeClassConstraint" ; ( string.prefix(GenTypeName0, "FA_PseudoTypeInfo_Struct") ; string.prefix(GenTypeName0, "FA_TypeInfo_Struct") ; string.prefix(GenTypeName0, "VA_PseudoTypeInfo_Struct") ; string.prefix(GenTypeName0, "VA_TypeInfo_Struct") ) -> CsharpTypeName = "runtime.TypeInfo_Struct" ; CsharpTypeName = "runtime." ++ GenTypeName0 ). tc_rtti_name_csharp_type(TCRttiName, CsharpTypeName, IsArray) :- tc_rtti_name_type(TCRttiName, GenTypeName, IsArray), ( GenTypeName = "BaseTypeclassInfo" -> CsharpTypeName = "object" /* & IsArray = yes */ ; GenTypeName = "ConstString" -> CsharpTypeName = "string" ; string.prefix(GenTypeName, "TypeClassConstraint_") -> CsharpTypeName = "runtime.TypeClassConstraint" ; CsharpTypeName = "runtime." ++ GenTypeName ). % ctor_rtti_name_type(RttiName, Type, IsArray) % :- pred ctor_rtti_name_type(ctor_rtti_name::in, string::out, is_array::out) is det. ctor_rtti_name_type(type_ctor_exist_locns(_), "DuExistLocn", is_array). ctor_rtti_name_type(type_ctor_exist_locn, "DuExistLocn", not_array). ctor_rtti_name_type(type_ctor_exist_tc_constr(_, _, N), tc_constraint_type_name(N), not_array). ctor_rtti_name_type(type_ctor_exist_tc_constrs(_), "TypeClassConstraint", is_array). ctor_rtti_name_type(type_ctor_exist_info(_), "DuExistInfo", not_array). ctor_rtti_name_type(type_ctor_field_names(_), "ConstString", is_array). ctor_rtti_name_type(type_ctor_field_types(_), "PseudoTypeInfo", is_array). ctor_rtti_name_type(type_ctor_res_addrs, "ReservedAddr", is_array). ctor_rtti_name_type(type_ctor_res_addr_functors, "ReservedAddrFunctorDescPtr", is_array). ctor_rtti_name_type(type_ctor_enum_functor_desc(_), "EnumFunctorDesc", not_array). ctor_rtti_name_type(type_ctor_foreign_enum_functor_desc(_), "ForeignEnumFunctorDesc", not_array). ctor_rtti_name_type(type_ctor_notag_functor_desc, "NotagFunctorDesc", not_array). ctor_rtti_name_type(type_ctor_du_functor_desc(_), "DuFunctorDesc", not_array). ctor_rtti_name_type(type_ctor_res_functor_desc(_), "ReservedAddrFunctorDesc", not_array). ctor_rtti_name_type(type_ctor_enum_name_ordered_table, "EnumFunctorDescPtr", is_array). ctor_rtti_name_type(type_ctor_enum_value_ordered_table, "EnumFunctorDescPtr", is_array). ctor_rtti_name_type(type_ctor_foreign_enum_name_ordered_table, "ForeignEnumFunctorDescPtr", is_array). ctor_rtti_name_type(type_ctor_foreign_enum_ordinal_ordered_table, "ForeignEnumFunctorDescPtr", is_array). ctor_rtti_name_type(type_ctor_du_name_ordered_table, "DuFunctorDescPtr", is_array). ctor_rtti_name_type(type_ctor_du_stag_ordered_table(_), "DuFunctorDescPtr", is_array). ctor_rtti_name_type(type_ctor_du_ptag_ordered_table, "DuPtagLayout", is_array). ctor_rtti_name_type(type_ctor_du_ptag_layout(_), "DuPtagLayout", not_array). ctor_rtti_name_type(type_ctor_res_value_ordered_table, "ReservedAddrTypeLayout", not_array). ctor_rtti_name_type(type_ctor_res_name_ordered_table, "MaybeResAddrFunctorDesc", is_array). ctor_rtti_name_type(type_ctor_maybe_res_addr_functor_desc, "MaybeResAddrFunctorDesc", not_array). ctor_rtti_name_type(type_ctor_functor_number_map, "Integer", is_array). ctor_rtti_name_type(type_ctor_type_functors, "TypeFunctors", not_array). ctor_rtti_name_type(type_ctor_type_layout, "TypeLayout", not_array). ctor_rtti_name_type(type_ctor_type_ctor_info, "TypeCtorInfo_Struct", not_array). ctor_rtti_name_type(type_ctor_type_hashcons_pointer, "TrieNodePtr", not_array). ctor_rtti_name_type(type_ctor_type_info(TypeInfo), type_info_name_type(TypeInfo), not_array). ctor_rtti_name_type(type_ctor_pseudo_type_info(PseudoTypeInfo), pseudo_type_info_name_type(PseudoTypeInfo), not_array). % tc_rtti_name_type(RttiName, Type, IsArray) % :- pred tc_rtti_name_type(tc_rtti_name::in, string::out, is_array::out) is det. tc_rtti_name_type(type_class_base_typeclass_info(_, _), "BaseTypeclassInfo", is_array). tc_rtti_name_type(type_class_id, "TypeClassId", not_array). tc_rtti_name_type(type_class_id_var_names, "ConstString", is_array). tc_rtti_name_type(type_class_id_method_ids, "TypeClassMethod", is_array). tc_rtti_name_type(type_class_decl, "TypeClassDeclStruct", not_array). tc_rtti_name_type(type_class_decl_super(_, N), TypeName, not_array) :- TypeName = tc_constraint_type_name(N). tc_rtti_name_type(type_class_decl_supers, "TypeClassConstraint", is_array). tc_rtti_name_type(type_class_instance(_), "InstanceStruct", not_array). tc_rtti_name_type(type_class_instance_tc_type_vector(_), "PseudoTypeInfo", is_array). tc_rtti_name_type(type_class_instance_constraint(_, _, N), TypeName, not_array) :- TypeName = tc_constraint_type_name(N). tc_rtti_name_type(type_class_instance_constraints(_), "TypeClassConstraint", is_array). tc_rtti_name_type(type_class_instance_methods(_), "CodePtr", is_array). :- func tc_constraint_type_name(int) = string. tc_constraint_type_name(N) = "TypeClassConstraint_" ++ int_to_string(N) ++ "Struct". :- func type_info_name_type(rtti_type_info) = string. type_info_name_type(plain_arity_zero_type_info(_)) = "TypeCtorInfo_Struct". type_info_name_type(plain_type_info(_, ArgTypes)) = string.format("FA_TypeInfo_Struct%d", [i(list.length(ArgTypes))]). type_info_name_type(var_arity_type_info(_, ArgTypes)) = string.format("VA_TypeInfo_Struct%d", [i(list.length(ArgTypes))]). :- func pseudo_type_info_name_type(rtti_pseudo_type_info) = string. pseudo_type_info_name_type(plain_arity_zero_pseudo_type_info(_)) = "TypeCtorInfo_Struct". pseudo_type_info_name_type(plain_pseudo_type_info(_TypeCtor, ArgTypes)) = string.format("FA_PseudoTypeInfo_Struct%d", [i(list.length(ArgTypes))]). pseudo_type_info_name_type(var_arity_pseudo_type_info(_TypeCtor, ArgTypes)) = string.format("VA_PseudoTypeInfo_Struct%d", [i(list.length(ArgTypes))]). pseudo_type_info_name_type(type_var(_)) = _ :- % we use small integers to represent type_vars, % rather than pointers, so there is no pointed-to type unexpected($module, $pred, "type_var"). module_qualify_name_of_rtti_id(RttiId) = ShouldModuleQualify :- ( RttiId = ctor_rtti_id(_, CtorRttiName), ShouldModuleQualify = module_qualify_name_of_ctor_rtti_name(CtorRttiName) ; RttiId = tc_rtti_id(_, TCRttiName), ShouldModuleQualify = module_qualify_name_of_tc_rtti_name(TCRttiName) ). module_qualify_name_of_ctor_rtti_name(_) = yes. % We don't want to include the module name as part of the name for % base_typeclass_infos, since we _want_ to cause a link error for % overlapping instance decls, even if they are in a different modules. % % When we start generating data structures replacing base_typeclass_infos, % we should include their names here. % % This decision is implemented separately in tc_name_to_string. module_qualify_name_of_tc_rtti_name(TCRttiName) = ModuleQualify :- ( TCRttiName = type_class_base_typeclass_info(_, _), ModuleQualify = no ; ( TCRttiName = type_class_id ; TCRttiName = type_class_id_var_names ; TCRttiName = type_class_id_method_ids ; TCRttiName = type_class_decl ; TCRttiName = type_class_decl_super(_, _) ; TCRttiName = type_class_decl_supers ; TCRttiName = type_class_instance(_) ; TCRttiName = type_class_instance_tc_type_vector(_) ; TCRttiName = type_class_instance_constraint(_, _, _) ; TCRttiName = type_class_instance_constraints(_) ; TCRttiName = type_class_instance_methods(_) ), ModuleQualify = yes ). rtti_id_emits_type_ctor_info(RttiId, TypeCtor) :- RttiId = ctor_rtti_id(RttiTypeCtor, RttiName), ( RttiName = type_ctor_type_ctor_info, TypeCtor = RttiTypeCtor ; RttiName = type_ctor_type_info(TypeInfo), TypeInfo = plain_arity_zero_type_info(TypeCtor) ; RttiName = type_ctor_pseudo_type_info(PseudoTypeInfo), PseudoTypeInfo = plain_arity_zero_pseudo_type_info(TypeCtor) ). %-----------------------------------------------------------------------------% tabling_info_id_str(tabling_info) = "table_info". tabling_info_id_str(tabling_ptis) = "table_ptis". tabling_info_id_str(tabling_type_param_locns) = "tabling_type_param_locns". tabling_info_id_str(tabling_root_node) = "table_root_node". tabling_info_id_str(tabling_steps_desc(call_table)) = "table_input_steps". tabling_info_id_str(tabling_steps_desc(answer_table)) = "table_output_steps". tabling_info_id_str(tabling_stats(call_table, curr_table)) = "table_call_stats". tabling_info_id_str(tabling_stats(call_table, prev_table)) = "table_prev_call_stats". tabling_info_id_str(tabling_stats(answer_table, curr_table)) = "table_answer_stats". tabling_info_id_str(tabling_stats(answer_table, prev_table)) = "table_prev_answer_stats". tabling_info_id_str(tabling_stat_steps(call_table, curr_table)) = "table_call_step_stats". tabling_info_id_str(tabling_stat_steps(call_table, prev_table)) = "table_prev_call_step_stats". tabling_info_id_str(tabling_stat_steps(answer_table, curr_table)) = "table_answer_step_stats". tabling_info_id_str(tabling_stat_steps(answer_table, prev_table)) = "table_prev_answer_step_stats". tabling_info_id_str(tabling_tips) = "table_tips". tabling_id_c_type(Id, JavaTypeName, IsArray) :- % Since tabling is not yet implemented for Java, this is only provisional. tabling_id_base_type(Id, CTypeName, IsArray), JavaTypeName = "MR_" ++ CTypeName. tabling_id_java_type(Id, JavaTypeName, IsArray) :- % Since tabling is not yet implemented for Java, this is only provisional. tabling_id_base_type(Id, CTypeName, IsArray), JavaTypeName = "jmercury.runtime." ++ CTypeName. :- pred tabling_id_base_type(proc_tabling_struct_id::in, string::out, is_array::out) is det. % These should be without the MR_ prefix. tabling_id_base_type(tabling_info, "ProcTableInfo", not_array). tabling_id_base_type(tabling_ptis, "PseudoTypeInfo", is_array). tabling_id_base_type(tabling_type_param_locns, "TypeParamLocns", is_array). tabling_id_base_type(tabling_root_node, "TableNode", not_array). tabling_id_base_type(tabling_steps_desc(_), "TableStepDesc", is_array). tabling_id_base_type(tabling_stats(_, _), "TableStats", not_array). tabling_id_base_type(tabling_stat_steps(_, _), "TableStepStats", is_array). tabling_id_base_type(tabling_tips, "TrieNode", is_array). tabling_id_has_array_type(Id) = IsArray :- tabling_id_base_type(Id, _, IsArray). table_trie_step_to_c(table_trie_step_dummy, "MR_TABLE_STEP_DUMMY", no). table_trie_step_to_c(table_trie_step_int, "MR_TABLE_STEP_INT", no). table_trie_step_to_c(table_trie_step_char, "MR_TABLE_STEP_CHAR", no). table_trie_step_to_c(table_trie_step_string, "MR_TABLE_STEP_STRING", no). table_trie_step_to_c(table_trie_step_float, "MR_TABLE_STEP_FLOAT", no). table_trie_step_to_c(table_trie_step_enum(EnumRange), "MR_TABLE_STEP_ENUM", yes(EnumRange)). table_trie_step_to_c(table_trie_step_foreign_enum, "MR_TABLE_STEP_FOREIGN_ENUM", no). table_trie_step_to_c(table_trie_step_general(_, table_is_mono, table_value), "MR_TABLE_STEP_GEN", no). table_trie_step_to_c(table_trie_step_general(_, table_is_poly, table_value), "MR_TABLE_STEP_GEN_POLY", no). table_trie_step_to_c(table_trie_step_general(_, table_is_mono, table_addr), "MR_TABLE_STEP_GEN_ADDR", no). table_trie_step_to_c(table_trie_step_general(_, table_is_poly, table_addr), "MR_TABLE_STEP_GEN_POLY_ADDR", no). table_trie_step_to_c(table_trie_step_typeinfo, "MR_TABLE_STEP_TYPEINFO", no). table_trie_step_to_c(table_trie_step_typeclassinfo, "MR_TABLE_STEP_TYPECLASSINFO", no). table_trie_step_to_c(table_trie_step_promise_implied, "MR_TABLE_STEP_PROMISE_IMPLIED", no). %-----------------------------------------------------------------------------% :- end_module backend_libs.rtti. %-----------------------------------------------------------------------------%