%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 2000-2007 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_out.m. % Main author: zs. % % This module contains code to output the RTTI data structures defined in % rtti.m as C code. % % This module is part of the LLDS back-end. The decl_set data type that it % uses, which is defined in llds_out.m, represents a set of LLDS declarations, % and thus depends on the LLDS. Also the code to output code_addrs depends on % the LLDS. % % The MLDS back-end does not use this module; instead it converts the RTTI % data structures to MLDS (and then to C or Java, etc.). % %-----------------------------------------------------------------------------% :- module ll_backend.rtti_out. :- interface. :- import_module backend_libs.rtti. :- import_module ll_backend.llds_out. :- import_module bool. :- import_module io. :- import_module list. %-----------------------------------------------------------------------------% % Output a C expression holding the address of the C name of the specified % rtti_data, preceded by the string in the first argument (that string will % usually be a C cast). % :- pred output_cast_addr_of_rtti_data(string::in, rtti_data::in, io::di, io::uo) is det. % Output a C expression holding the address of the C name of % the specified rtti_data. % :- pred output_addr_of_rtti_data(rtti_data::in, io::di, io::uo) is det. % Output a C declaration for the rtti_datas. % :- pred output_rtti_data_decl_list(list(rtti_data)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. % Output a C declaration for the rtti_data. % :- pred output_rtti_data_decl(rtti_data::in, decl_set::in, decl_set::out, io::di, io::uo) is det. % Output a C definition for the rtti_data. % :- pred output_rtti_data_defn(rtti_data::in, decl_set::in, decl_set::out, io::di, io::uo) is det. % Output C code (e.g. a call to the MR_INIT_TYPE_CTOR_INFO() macro) % to initialize the rtti_data if necessary. % :- pred init_rtti_data_if_nec(rtti_data::in, io::di, io::uo) is det. % Output C code (e.g. a call to MR_register_type_ctor_info()) to register % the rtti_data in the type tables, if it represents a data structure % that should be so registered. % :- pred register_rtti_data_if_nec(rtti_data::in, io::di, io::uo) is det. % Output the C name of the rtti_data specified by the given rtti_id. % :- pred output_rtti_id(rtti_id::in, io::di, io::uo) is det. % Output the C storage class, C type, and C name of the rtti_data % specified by the given rtti_id for use in a declaration or % definition. The bool should be `yes' iff it is for a definition. % :- pred output_rtti_id_storage_type_name(rtti_id::in, bool::in, decl_set::in, decl_set::out, io::di, io::uo) is det. % Output the C storage class, C type, and C name of the rtti_data % specified by the given rtti_id for use in a declaration or % definition. The bool should be `yes' iff it is for a definition. % :- pred output_rtti_id_storage_type_name_no_decl(rtti_id::in, bool::in, io::di, io::uo) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module backend_libs.c_util. :- import_module backend_libs.name_mangle. :- import_module backend_libs.type_ctor_info. :- import_module hlds.hlds_data. :- import_module hlds.hlds_rtti. :- import_module libs.compiler_util. :- import_module libs.globals. :- import_module ll_backend.code_util. :- import_module ll_backend.layout_out. :- import_module ll_backend.llds. :- import_module mdbcomp.prim_data. :- import_module parse_tree.prog_foreign. :- import_module assoc_list. :- import_module counter. :- import_module int. :- import_module map. :- import_module maybe. :- import_module multi_map. :- import_module pair. :- import_module string. :- import_module univ. %-----------------------------------------------------------------------------% output_rtti_data_defn(rtti_data_type_info(TypeInfo), !DeclSet, !IO) :- output_type_info_defn(TypeInfo, !DeclSet, !IO). output_rtti_data_defn(rtti_data_pseudo_type_info(PseudoTypeInfo), !DeclSet, !IO) :- output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO). output_rtti_data_defn(rtti_data_type_ctor_info(TypeCtorData), !DeclSet, !IO) :- output_type_ctor_data_defn(TypeCtorData, !DeclSet, !IO). output_rtti_data_defn(rtti_data_base_typeclass_info(TCName, InstanceModuleName, InstanceString, BaseTypeClassInfo), !DeclSet, !IO) :- output_base_typeclass_info_defn(TCName, InstanceModuleName, InstanceString, BaseTypeClassInfo, !DeclSet, !IO). output_rtti_data_defn(rtti_data_type_class_decl(TCDecl), !DeclSet, !IO) :- output_type_class_decl_defn(TCDecl, !DeclSet, !IO). output_rtti_data_defn(rtti_data_type_class_instance(InstanceDecl), !DeclSet, !IO) :- output_type_class_instance_defn(InstanceDecl, !DeclSet, !IO). %-----------------------------------------------------------------------------% :- pred output_base_typeclass_info_defn(tc_name::in, module_name::in, string::in, base_typeclass_info::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_base_typeclass_info_defn(TCName, InstanceModuleName, InstanceString, base_typeclass_info(N1, N2, N3, N4, N5, Methods), !DeclSet, !IO) :- CodeAddrs = list.map(make_code_addr, Methods), list.foldl2(output_code_addr_decls, CodeAddrs, !DeclSet, !IO), io.write_string("\n", !IO), RttiId = tc_rtti_id(TCName, type_class_base_typeclass_info(InstanceModuleName, InstanceString)), output_rtti_id_storage_type_name(RttiId, yes, !DeclSet, !IO), % XXX It would be nice to avoid generating redundant declarations % of base_typeclass_infos, but currently we don't. io.write_string(" = {\n\t(MR_Code *) ", !IO), io.write_list([N1, N2, N3, N4, N5], ",\n\t(MR_Code *) ", io.write_int, !IO), io.write_string(",\n\t", !IO), io.write_list(CodeAddrs, ",\n\t", output_static_code_addr, !IO), io.write_string("\n};\n", !IO). %-----------------------------------------------------------------------------% :- pred output_type_class_decl_defn(tc_decl::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_type_class_decl_defn(TCDecl, !DeclSet, !IO) :- TCDecl = tc_decl(TCId, Version, Supers), TCId = tc_id(TCName, TVarNames, MethodIds), TCName = tc_name(ModuleSymName, ClassName, Arity), TCIdVarNamesRttiName = type_class_id_var_names, TCIdVarNamesRttiId = tc_rtti_id(TCName, TCIdVarNamesRttiName), TCIdMethodIdsRttiName = type_class_id_method_ids, TCIdMethodIdsRttiId = tc_rtti_id(TCName, TCIdMethodIdsRttiName), TCIdRttiName = type_class_id, TCIdRttiId = tc_rtti_id(TCName, TCIdRttiName), TCDeclSupersRttiName = type_class_decl_supers, TCDeclSupersRttiId = tc_rtti_id(TCName, TCDeclSupersRttiName), TCDeclRttiName = type_class_decl, TCDeclRttiId = tc_rtti_id(TCName, TCDeclRttiName), ( TVarNames = [] ; TVarNames = [_ | _], output_generic_rtti_data_defn_start(TCIdVarNamesRttiId, !DeclSet, !IO), io.write_string(" = {\n", !IO), list.foldl(output_type_class_id_tvar_name, TVarNames, !IO), io.write_string("};\n", !IO) ), ( MethodIds = [] ; MethodIds = [_ | _], output_generic_rtti_data_defn_start(TCIdMethodIdsRttiId, !DeclSet, !IO), io.write_string(" = {\n", !IO), list.foldl(output_type_class_id_method_id, MethodIds, !IO), io.write_string("};\n", !IO) ), list.length(TVarNames, NumTVarNames), list.length(MethodIds, NumMethodIds), output_generic_rtti_data_defn_start(TCIdRttiId, !DeclSet, !IO), io.write_string(" = {\n\t""", !IO), c_util.output_quoted_string(sym_name_to_string(ModuleSymName), !IO), io.write_string(""",\n\t""", !IO), c_util.output_quoted_string(ClassName, !IO), io.write_string(""",\n\t", !IO), io.write_int(Arity, !IO), io.write_string(",\n\t", !IO), io.write_int(NumTVarNames, !IO), io.write_string(",\n\t", !IO), io.write_int(NumMethodIds, !IO), io.write_string(",\n\t", !IO), ( TVarNames = [], io.write_string("NULL", !IO) ; TVarNames = [_ | _], output_rtti_id(TCIdVarNamesRttiId, !IO) ), io.write_string(",\n\t", !IO), ( MethodIds = [], io.write_string("NULL", !IO) ; MethodIds = [_ | _], output_rtti_id(TCIdMethodIdsRttiId, !IO) ), io.write_string("\n};\n", !IO), ( Supers = [] ; Supers = [_ | _], list.map_foldl3(output_type_class_constraint( make_tc_decl_super_id(TCName)), Supers, SuperIds, counter.init(1), _, !DeclSet, !IO), output_generic_rtti_data_defn_start(TCDeclSupersRttiId, !DeclSet, !IO), io.write_string(" = {\n", !IO), output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ", SuperIds, !IO), io.write_string("};\n", !IO) ), list.length(Supers, NumSupers), output_generic_rtti_data_defn_start(TCDeclRttiId, !DeclSet, !IO), io.write_string(" = {\n\t&", !IO), output_rtti_id(TCIdRttiId, !IO), io.write_string(",\n\t", !IO), io.write_int(Version, !IO), io.write_string(",\n\t", !IO), io.write_int(NumSupers, !IO), io.write_string(",\n\t", !IO), ( Supers = [], io.write_string("NULL", !IO) ; Supers = [_ | _], output_rtti_id(TCDeclSupersRttiId, !IO) ), io.write_string("\n};\n", !IO). :- pred output_type_class_id_tvar_name(string::in, io::di, io::uo) is det. output_type_class_id_tvar_name(TVarName, !IO) :- io.write_string("\t""", !IO), c_util.output_quoted_string(TVarName, !IO), io.write_string(""",\n", !IO). :- pred output_type_class_id_method_id(tc_method_id::in, io::di, io::uo) is det. output_type_class_id_method_id(MethodId, !IO) :- MethodId = tc_method_id(MethodName, MethodArity, PredOrFunc), io.write_string("\t{ """, !IO), c_util.output_quoted_string(MethodName, !IO), io.write_string(""", ", !IO), io.write_int(MethodArity, !IO), io.write_string(", ", !IO), output_pred_or_func(PredOrFunc, !IO), io.write_string(" },\n", !IO). :- pred make_tc_decl_super_id(tc_name::in, int::in, int::in, rtti_id::out) is det. make_tc_decl_super_id(TCName, Ordinal, NumTypes, RttiId) :- RttiId = tc_rtti_id(TCName, type_class_decl_super(Ordinal, NumTypes)). %-----------------------------------------------------------------------------% :- pred output_type_class_instance_defn(tc_instance::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_type_class_instance_defn(Instance, !DeclSet, !IO) :- Instance = tc_instance(TCName, TCTypes, NumTypeVars, Constraints, _MethodProcLabels), list.foldl2(output_maybe_pseudo_type_info_defn, TCTypes, !DeclSet, !IO), TCTypeRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, TCTypes), TCInstanceTypesRttiId = tc_rtti_id(TCName, type_class_instance_tc_type_vector(TCTypes)), output_generic_rtti_data_defn_start(TCInstanceTypesRttiId, !DeclSet, !IO), io.write_string(" = {\n", !IO), output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", TCTypeRttiDatas, !IO), io.write_string("};\n", !IO), TCInstanceConstraintsRttiId = tc_rtti_id(TCName, type_class_instance_constraints(TCTypes)), ( Constraints = [] ; Constraints = [_ | _], list.map_foldl3(output_type_class_constraint( make_tc_instance_constraint_id(TCName, TCTypes)), Constraints, ConstraintIds, counter.init(1), _, !DeclSet, !IO), output_generic_rtti_data_defn_start(TCInstanceConstraintsRttiId, !DeclSet, !IO), io.write_string(" = {\n", !IO), output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ", ConstraintIds, !IO), io.write_string("};\n", !IO) ), % TCInstanceMethodsRttiId = tc_rtti_id( % type_class_instance_methods(TCName, TCTypes)), % ( % MethodProcLabels = [] % ; % MethodProcLabels = [_ | _], % MethodCodeAddrs = list.map(make_code_addr, MethodProcLabels), % list.foldl2(output_code_addr_decls, MethodCodeAddrs, % !DeclSet, !IO), % output_generic_rtti_data_defn_start(TCInstanceMethodsRttiId, % !DeclSet, !IO), % io.write_string(" = {\n", !IO), % list.foldl(output_code_addr_in_list, MethodCodeAddrs, !IO), % io.write_string("};\n", !IO) % ), TCDeclRttiId = tc_rtti_id(TCName, type_class_decl), output_rtti_id_decls(TCDeclRttiId, "", "", 0, _, !DeclSet, !IO), TCInstanceRttiId = tc_rtti_id(TCName, type_class_instance(TCTypes)), output_generic_rtti_data_defn_start(TCInstanceRttiId, !DeclSet, !IO), io.write_string(" = {\n\t&", !IO), output_rtti_id(TCDeclRttiId, !IO), io.write_string(",\n\t", !IO), io.write_int(NumTypeVars, !IO), io.write_string(",\n\t", !IO), io.write_int(list.length(Constraints), !IO), io.write_string(",\n\t", !IO), output_rtti_id(TCInstanceTypesRttiId, !IO), io.write_string(",\n\t", !IO), ( Constraints = [], io.write_string("NULL", !IO) ; Constraints = [_ | _], output_rtti_id(TCInstanceConstraintsRttiId, !IO) ), % io.write_string(",\n\t", !IO), % ( % MethodProcLabels = [], % io.write_string("NULL", !IO) % ; % MethodProcLabels = [_ | _], % io.write_string("&", !IO), % output_rtti_id(TCInstanceMethodsRttiId, !IO) % ), io.write_string("\n};\n", !IO). :- pred make_tc_instance_constraint_id(tc_name::in, list(tc_type)::in, int::in, int::in, rtti_id::out) is det. make_tc_instance_constraint_id(TCName, TCTypes, Ordinal, NumTypes, RttiId) :- RttiId = tc_rtti_id(TCName, type_class_instance_constraint(TCTypes, Ordinal, NumTypes)). :- pred output_code_addr_in_list(code_addr::in, io::di, io::uo) is det. output_code_addr_in_list(CodeAddr, !IO) :- io.write_string("\t", !IO), output_static_code_addr(CodeAddr, !IO), io.write_string(",\n", !IO). %-----------------------------------------------------------------------------% :- pred output_type_class_constraint( pred(int, int, rtti_id)::in(pred(in, in, out) is det), tc_constraint::in, rtti_id::out, counter::in, counter::out, decl_set::in, decl_set::out, io::di, io::uo) is det. output_type_class_constraint(MakeRttiId, Constraint, TCDeclSuperRttiId, !Counter, !DeclSet, !IO) :- Constraint = tc_constraint(TCName, Types), list.length(Types, NumTypes), counter.allocate(TCNum, !Counter), MakeRttiId(TCNum, NumTypes, TCDeclSuperRttiId), TCDeclRttiId = tc_rtti_id(TCName, type_class_decl), output_generic_rtti_data_decl(TCDeclRttiId, !DeclSet, !IO), list.foldl2(output_maybe_pseudo_type_info_defn, Types, !DeclSet, !IO), TypeRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, Types), output_generic_rtti_data_defn_start(TCDeclSuperRttiId, !DeclSet, !IO), io.write_string(" = {\n\t&", !IO), output_rtti_id(TCDeclRttiId, !IO), io.write_string(",\n\t{\n", !IO), output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", TypeRttiDatas, !IO), io.write_string("\t}\n};\n", !IO). %-----------------------------------------------------------------------------% :- pred output_maybe_pseudo_type_info_or_self_defn( rtti_maybe_pseudo_type_info_or_self::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_maybe_pseudo_type_info_or_self_defn(plain(TypeInfo), !DeclSet, !IO) :- output_type_info_defn(TypeInfo, !DeclSet, !IO). output_maybe_pseudo_type_info_or_self_defn(pseudo(PseudoTypeInfo), !DeclSet, !IO) :- output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO). output_maybe_pseudo_type_info_or_self_defn(self, !DeclSet, !IO). :- pred output_maybe_pseudo_type_info_defn(rtti_maybe_pseudo_type_info::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_maybe_pseudo_type_info_defn(plain(TypeInfo), !DeclSet, !IO) :- output_type_info_defn(TypeInfo, !DeclSet, !IO). output_maybe_pseudo_type_info_defn(pseudo(PseudoTypeInfo), !DeclSet, !IO) :- output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO). :- pred output_type_info_defn(rtti_type_info::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_type_info_defn(TypeInfo, !DeclSet, !IO) :- ( rtti_data_to_id(rtti_data_type_info(TypeInfo), RttiId), DataAddr = rtti_addr(RttiId), decl_set_is_member(decl_data_addr(DataAddr), !.DeclSet) -> true ; do_output_type_info_defn(TypeInfo, !DeclSet, !IO) ). :- pred do_output_type_info_defn(rtti_type_info::in, decl_set::in, decl_set::out, io::di, io::uo) is det. do_output_type_info_defn(TypeInfo, !DeclSet, !IO) :- TypeInfo = plain_arity_zero_type_info(RttiTypeCtor), TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO). do_output_type_info_defn(TypeInfo, !DeclSet, !IO) :- TypeInfo = plain_type_info(RttiTypeCtor, Args), TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO), ArgRttiDatas = list.map(type_info_to_rtti_data, Args), output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_type_info(TypeInfo)), !DeclSet, !IO), io.write_string(" = {\n\t&", !IO), output_ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info, !IO), io.write_string(",\n{", !IO), output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas, !IO), io.write_string("}};\n", !IO). do_output_type_info_defn(TypeInfo, !DeclSet, !IO) :- TypeInfo = var_arity_type_info(RttiVarArityId, Args), RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId), TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO), ArgRttiDatas = list.map(type_info_to_rtti_data, Args), output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_type_info(TypeInfo)), !DeclSet, !IO), io.write_string(" = {\n\t&", !IO), output_ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info, !IO), io.write_string(",\n\t", !IO), list.length(Args, Arity), io.write_int(Arity, !IO), io.write_string(",\n{", !IO), output_cast_addr_of_rtti_datas("(MR_TypeInfo) ", ArgRttiDatas, !IO), io.write_string("}};\n", !IO). :- pred output_pseudo_type_info_defn(rtti_pseudo_type_info::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO) :- ( PseudoTypeInfo = type_var(_) -> true ; rtti_data_to_id(rtti_data_pseudo_type_info(PseudoTypeInfo), RttiId), DataAddr = rtti_addr(RttiId), decl_set_is_member(decl_data_addr(DataAddr), !.DeclSet) -> true ; do_output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO) ). :- pred do_output_pseudo_type_info_defn(rtti_pseudo_type_info::in, decl_set::in, decl_set::out, io::di, io::uo) is det. do_output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO) :- PseudoTypeInfo = plain_arity_zero_pseudo_type_info(RttiTypeCtor), TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO). do_output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO) :- PseudoTypeInfo = plain_pseudo_type_info(RttiTypeCtor, Args), TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO), ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, Args), output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_pseudo_type_info(PseudoTypeInfo)), !DeclSet, !IO), io.write_string(" = {\n\t&", !IO), output_ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info, !IO), io.write_string(",\n{", !IO), output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas, !IO), io.write_string("}};\n", !IO). do_output_pseudo_type_info_defn(PseudoTypeInfo, !DeclSet, !IO) :- PseudoTypeInfo = var_arity_pseudo_type_info(RttiVarArityId, Args), RttiTypeCtor = var_arity_id_to_rtti_type_ctor(RttiVarArityId), TypeCtorRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), output_rtti_id_decls(TypeCtorRttiId, "", "", 0, _, !DeclSet, !IO), ArgRttiDatas = list.map(maybe_pseudo_type_info_to_rtti_data, Args), output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_pseudo_type_info(PseudoTypeInfo)), !DeclSet, !IO), io.write_string(" = {\n\t&", !IO), output_ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info, !IO), io.write_string(",\n\t", !IO), list.length(Args, Arity), io.write_int(Arity, !IO), io.write_string(",\n{", !IO), output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgRttiDatas, !IO), io.write_string("}};\n", !IO). do_output_pseudo_type_info_defn(type_var(_), !DeclSet, !IO). :- pred output_type_ctor_arg_defns_and_decls(list(rtti_data)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_type_ctor_arg_defns_and_decls(ArgRttiDatas, !DeclSet, !IO) :- % We must output the definitions of the rtti_datas of the argument % typeinfos and/or pseudo-typeinfos, because they may contain other % typeinfos and/or pseudo-typeinfos nested within them. However, % zero arity typeinfos and pseudo-typeinfos have empty definitions, % yet the type_ctor_info they refer to still must be declared. % This is why both calls below are needed. list.foldl2(output_rtti_data_defn, ArgRttiDatas, !DeclSet, !IO), output_rtti_datas_decls(ArgRttiDatas, "", "", 0, _, !DeclSet, !IO). %-----------------------------------------------------------------------------% :- pred output_type_ctor_data_defn(type_ctor_data::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_type_ctor_data_defn(TypeCtorData, !DeclSet, !IO) :- RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData), TypeCtorData = type_ctor_data(Version, Module, TypeName, TypeArity, UnifyUniv, CompareUniv, Flags, TypeCtorDetails), output_type_ctor_details_defn(RttiTypeCtor, TypeCtorDetails, MaybeFunctorsName, MaybeLayoutName, HaveFunctorNumberMap, !DeclSet, !IO), det_univ_to_type(UnifyUniv, UnifyProcLabel), UnifyCodeAddr = make_code_addr(UnifyProcLabel), det_univ_to_type(CompareUniv, CompareProcLabel), CompareCodeAddr = make_code_addr(CompareProcLabel), CodeAddrs = [UnifyCodeAddr, CompareCodeAddr], list.foldl2(output_code_addr_decls, CodeAddrs, !DeclSet, !IO), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), !DeclSet, !IO), io.write_string(" = {\n\t", !IO), io.write_int(TypeArity, !IO), io.write_string(",\n\t", !IO), io.write_int(Version, !IO), io.write_string(",\n\t", !IO), io.write_int(type_ctor_details_num_ptags(TypeCtorDetails), !IO), io.write_string(",\n\t", !IO), rtti.type_ctor_rep_to_string(TypeCtorData, CtorRepStr), io.write_string(CtorRepStr, !IO), io.write_string(",\n\t", !IO), output_static_code_addr(UnifyCodeAddr, !IO), io.write_string(",\n\t", !IO), output_static_code_addr(CompareCodeAddr, !IO), io.write_string(",\n\t""", !IO), c_util.output_quoted_string(sym_name_to_string(Module), !IO), io.write_string(""",\n\t""", !IO), c_util.output_quoted_string(TypeName, !IO), io.write_string(""",\n\t", !IO), ( MaybeFunctorsName = yes(FunctorsName), FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, FunctorsName), io.write_string("{ ", !IO), output_cast_addr_of_rtti_id("(void *)", FunctorsRttiId, !IO), io.write_string(" }", !IO) ; MaybeFunctorsName = no, io.write_string("{ 0 }", !IO) ), io.write_string(",\n\t", !IO), ( MaybeLayoutName = yes(LayoutName), LayoutRttiId = ctor_rtti_id(RttiTypeCtor, LayoutName), io.write_string("{ ", !IO), output_cast_addr_of_rtti_id("(void *)", LayoutRttiId, !IO), io.write_string(" }", !IO) ; MaybeLayoutName = no, io.write_string("{ 0 }", !IO) ), io.write_string(",\n\t", !IO), io.write_int(type_ctor_details_num_functors(TypeCtorDetails), !IO), io.write_string(",\n\t", !IO), io.write_int(encode_type_ctor_flags(Flags), !IO), io.write_string(",\n\t", !IO), ( HaveFunctorNumberMap = yes, FunctorNumberMapRttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_functor_number_map), output_rtti_id(FunctorNumberMapRttiId, !IO) ; HaveFunctorNumberMap = no, io.write_string("NULL", !IO) ), % This code is commented out while the corresponding fields of the % MR_TypeCtorInfo_Struct type are commented out. % % io.write_string(",\n\t"), % ( % { MaybeHashCons = yes(HashConsDataAddr) }, % io.write_string("&"), % output_ctor_rtti_id(RttiTypeCtor, HashConsDataAddr) % ; % { MaybeHashCons = no }, % io.write_string("NULL") % ), % io.write_string(",\n\t"), % output_maybe_static_code_addr(Prettyprinter), io.write_string("\n};\n", !IO). :- pred output_type_ctor_details_defn(rtti_type_ctor::in, type_ctor_details::in, maybe(ctor_rtti_name)::out, maybe(ctor_rtti_name)::out, bool::out, decl_set::in, decl_set::out, io::di, io::uo) is det. output_type_ctor_details_defn(RttiTypeCtor, TypeCtorDetails, MaybeFunctorsName, MaybeLayoutName, HaveFunctorNumberMap, !DeclSet, !IO) :- ( TypeCtorDetails = enum(_, EnumFunctors, EnumByRep, EnumByName, _IsDummy, FunctorNumberMap), list.foldl2(output_enum_functor_defn(RttiTypeCtor), EnumFunctors, !DeclSet, !IO), output_enum_value_ordered_table(RttiTypeCtor, EnumByRep, !DeclSet, !IO), output_enum_name_ordered_table(RttiTypeCtor, EnumByName, !DeclSet, !IO), output_functor_number_map(RttiTypeCtor, FunctorNumberMap, !DeclSet, !IO), MaybeLayoutName = yes(type_ctor_enum_value_ordered_table), MaybeFunctorsName = yes(type_ctor_enum_name_ordered_table), HaveFunctorNumberMap = yes ; TypeCtorDetails = du(_, DuFunctors, DuByRep, DuByName, FunctorNumberMap), list.foldl2(output_du_functor_defn(RttiTypeCtor), DuFunctors, !DeclSet, !IO), output_du_ptag_ordered_table(RttiTypeCtor, DuByRep, !DeclSet, !IO), output_du_name_ordered_table(RttiTypeCtor, DuByName, !DeclSet, !IO), output_functor_number_map(RttiTypeCtor, FunctorNumberMap, !DeclSet, !IO), MaybeLayoutName = yes(type_ctor_du_ptag_ordered_table), MaybeFunctorsName = yes(type_ctor_du_name_ordered_table), HaveFunctorNumberMap = yes ; TypeCtorDetails = reserved(_, MaybeResFunctors, ResFunctors, DuByRep, MaybeResByName, FunctorNumberMap), list.foldl2(output_maybe_res_functor_defn(RttiTypeCtor), MaybeResFunctors, !DeclSet, !IO), output_res_value_ordered_table(RttiTypeCtor, ResFunctors, DuByRep, !DeclSet, !IO), output_res_name_ordered_table(RttiTypeCtor, MaybeResByName, !DeclSet, !IO), output_functor_number_map(RttiTypeCtor, FunctorNumberMap, !DeclSet, !IO), MaybeLayoutName = yes(type_ctor_res_value_ordered_table), MaybeFunctorsName = yes(type_ctor_res_name_ordered_table), HaveFunctorNumberMap = yes ; TypeCtorDetails = notag(_, NotagFunctor), output_notag_functor_defn(RttiTypeCtor, NotagFunctor, !DeclSet, !IO), output_functor_number_map(RttiTypeCtor, [0], !DeclSet, !IO), MaybeLayoutName = yes(type_ctor_notag_functor_desc), MaybeFunctorsName = yes(type_ctor_notag_functor_desc), HaveFunctorNumberMap = yes ; TypeCtorDetails = eqv(EqvType), output_maybe_pseudo_type_info_defn(EqvType, !DeclSet, !IO), TypeData = maybe_pseudo_type_info_to_rtti_data(EqvType), output_rtti_data_decls(TypeData, "", "", 0, _, !DeclSet, !IO), ( EqvType = plain(TypeInfo), LayoutName = type_ctor_type_info(TypeInfo) ; EqvType = pseudo(PseudoTypeInfo), LayoutName = type_ctor_pseudo_type_info(PseudoTypeInfo) ), MaybeLayoutName = yes(LayoutName), MaybeFunctorsName = no, HaveFunctorNumberMap = no ; TypeCtorDetails = builtin(_), MaybeLayoutName = no, MaybeFunctorsName = no, HaveFunctorNumberMap = no ; TypeCtorDetails = impl_artifact(_), MaybeLayoutName = no, MaybeFunctorsName = no, HaveFunctorNumberMap = no ; TypeCtorDetails = foreign(_), MaybeLayoutName = no, MaybeFunctorsName = no, HaveFunctorNumberMap = no ). %-----------------------------------------------------------------------------% :- pred output_enum_functor_defn(rtti_type_ctor::in, enum_functor::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_enum_functor_defn(RttiTypeCtor, EnumFunctor, !DeclSet, !IO) :- EnumFunctor = enum_functor(FunctorName, Ordinal), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_enum_functor_desc(Ordinal)), !DeclSet, !IO), io.write_string(" = {\n\t""", !IO), c_util.output_quoted_string(FunctorName, !IO), io.write_string(""",\n\t", !IO), io.write_int(Ordinal, !IO), io.write_string("\n};\n", !IO). :- pred output_notag_functor_defn(rtti_type_ctor::in, notag_functor::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_notag_functor_defn(RttiTypeCtor, NotagFunctor, !DeclSet, !IO) :- NotagFunctor = notag_functor(FunctorName, ArgType, MaybeArgName), output_maybe_pseudo_type_info_defn(ArgType, !DeclSet, !IO), ArgTypeData = maybe_pseudo_type_info_to_rtti_data(ArgType), output_rtti_data_decls(ArgTypeData, "", "", 0, _, !DeclSet, !IO), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_notag_functor_desc), !DeclSet, !IO), io.write_string(" = {\n\t""", !IO), c_util.output_quoted_string(FunctorName, !IO), io.write_string(""",\n\t", !IO), ( ArgType = plain(ArgTypeInfo), output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ", rtti_data_type_info(ArgTypeInfo), !IO) ; ArgType = pseudo(ArgPseudoTypeInfo), % We need to cast the argument to MR_PseudoTypeInfo in case % it turns out to be a small integer, not a pointer. output_cast_addr_of_rtti_data("(MR_PseudoTypeInfo) ", rtti_data_pseudo_type_info(ArgPseudoTypeInfo), !IO) ), io.write_string(",\n\t", !IO), ( MaybeArgName = yes(ArgName), io.write_string("""", !IO), io.write_string(ArgName, !IO), io.write_string("""", !IO) ; MaybeArgName = no, io.write_string("NULL", !IO) ), io.write_string("\n};\n", !IO). :- pred output_du_functor_defn(rtti_type_ctor::in, du_functor::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_du_functor_defn(RttiTypeCtor, DuFunctor, !DeclSet, !IO) :- DuFunctor = du_functor(FunctorName, OrigArity, Ordinal, Rep, ArgInfos, MaybeExistInfo), ArgTypes = list.map(du_arg_info_type, ArgInfos), MaybeArgNames = list.map(du_arg_info_name, ArgInfos), ArgNames = list.filter_map(project_yes, MaybeArgNames), ( ArgInfos = [_ | _], output_du_arg_types(RttiTypeCtor, Ordinal, ArgTypes, !DeclSet, !IO) ; ArgInfos = [] ), ( ArgNames = [_ | _], output_du_arg_names(RttiTypeCtor, Ordinal, MaybeArgNames, !DeclSet, !IO) ; ArgNames = [] ), ( MaybeExistInfo = yes(ExistInfo), output_exist_info(RttiTypeCtor, Ordinal, ExistInfo, !DeclSet, !IO) ; MaybeExistInfo = no ), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_du_functor_desc(Ordinal)), !DeclSet, !IO), io.write_string(" = {\n\t""", !IO), c_util.output_quoted_string(FunctorName, !IO), io.write_string(""",\n\t", !IO), io.write_int(OrigArity, !IO), io.write_string(",\n\t", !IO), ContainsVarBitVector = compute_contains_var_bit_vector(ArgTypes), io.write_int(ContainsVarBitVector, !IO), io.write_string(",\n\t", !IO), ( Rep = du_ll_rep(Ptag, SectagAndLocn) ; Rep = du_hl_rep(_), unexpected(this_file, "output_du_functor_defn: du_hl_rep") ), ( SectagAndLocn = sectag_locn_none, Locn = "MR_SECTAG_NONE", Stag = -1 ; SectagAndLocn = sectag_locn_local(Stag), Locn = "MR_SECTAG_LOCAL" ; SectagAndLocn = sectag_locn_remote(Stag), Locn = "MR_SECTAG_REMOTE" ), io.write_string(Locn, !IO), io.write_string(",\n\t", !IO), io.write_int(Ptag, !IO), io.write_string(",\n\t", !IO), io.write_int(Stag, !IO), io.write_string(",\n\t", !IO), io.write_int(Ordinal, !IO), io.write_string(",\n\t", !IO), io.write_string("(MR_PseudoTypeInfo *) ", !IO), % cast away const ( ArgInfos = [_ | _], output_addr_of_ctor_rtti_id(RttiTypeCtor, type_ctor_field_types(Ordinal), !IO) ; ArgInfos = [], io.write_string("NULL", !IO) ), io.write_string(",\n\t", !IO), ( ArgNames = [_ | _], output_addr_of_ctor_rtti_id(RttiTypeCtor, type_ctor_field_names(Ordinal), !IO) ; ArgNames = [], io.write_string("NULL", !IO) ), io.write_string(",\n\t", !IO), ( MaybeExistInfo = yes(_), output_addr_of_ctor_rtti_id(RttiTypeCtor, type_ctor_exist_info(Ordinal), !IO) ; MaybeExistInfo = no, io.write_string("NULL", !IO) ), io.write_string("\n};\n", !IO). :- pred output_res_functor_defn(rtti_type_ctor::in, reserved_functor::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_res_functor_defn(RttiTypeCtor, ResFunctor, !DeclSet, !IO) :- ResFunctor = reserved_functor(FunctorName, Ordinal, Rep), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_res_functor_desc(Ordinal)), !DeclSet, !IO), io.write_string(" = {\n\t""", !IO), c_util.output_quoted_string(FunctorName, !IO), io.write_string(""",\n\t", !IO), io.write_int(Ordinal, !IO), io.write_string(",\n\t", !IO), io.write_string("(void *) ", !IO), ( Rep = null_pointer, io.write_string("NULL", !IO) ; Rep = small_pointer(SmallPtr), io.write_int(SmallPtr, !IO) ; Rep = reserved_object(_, _, _), unexpected(this_file, "output_res_functor_defn: reserved object") ), io.write_string("\n};\n", !IO). :- pred output_maybe_res_functor_defn(rtti_type_ctor::in, maybe_reserved_functor::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_maybe_res_functor_defn(RttiTypeCtor, MaybeResFunctor, !DeclSet, !IO) :- ( MaybeResFunctor = res_func(ResFunctor), output_res_functor_defn(RttiTypeCtor, ResFunctor, !DeclSet, !IO) ; MaybeResFunctor = du_func(DuFunctor), output_du_functor_defn(RttiTypeCtor, DuFunctor, !DeclSet, !IO) ). %-----------------------------------------------------------------------------% :- pred output_exist_locns_array(rtti_type_ctor::in, int::in, list(exist_typeinfo_locn)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_exist_locns_array(RttiTypeCtor, Ordinal, Locns, !DeclSet, !IO) :- output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_exist_locns(Ordinal)), !DeclSet, !IO), ( % ANSI/ISO C doesn't allow empty arrays, so % place a dummy value in the array if necessary. Locns = [], io.write_string("= { {0, 0} };\n", !IO) ; Locns = [_ | _], io.write_string(" = {\n", !IO), output_exist_locns(Locns, !IO), io.write_string("};\n", !IO) ). :- pred make_exist_tc_constr_id(rtti_type_ctor::in, int::in, int::in, int::in, rtti_id::out) is det. make_exist_tc_constr_id(RttiTypeCtor, Ordinal, TCNum, Arity, RttiId) :- RttiName = type_ctor_exist_tc_constr(Ordinal, TCNum, Arity), RttiId = ctor_rtti_id(RttiTypeCtor, RttiName). :- pred output_exist_constraints_data(rtti_type_ctor::in, int::in, list(tc_constraint)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_exist_constraints_data(RttiTypeCtor, Ordinal, Constraints, !DeclSet, !IO) :- list.map_foldl3(output_type_class_constraint( make_exist_tc_constr_id(RttiTypeCtor, Ordinal)), Constraints, ConstraintIds, counter.init(1), _, !DeclSet, !IO), RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_exist_tc_constrs(Ordinal)), output_generic_rtti_data_defn_start(RttiId, !DeclSet, !IO), io.write_string(" = {\n\t", !IO), output_cast_addr_of_rtti_ids("(MR_TypeClassConstraint) ", ConstraintIds, !IO), io.write_string("\n};\n", !IO). :- pred output_exist_info(rtti_type_ctor::in, int::in, exist_info::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_exist_info(RttiTypeCtor, Ordinal, ExistInfo, !DeclSet, !IO) :- ExistInfo = exist_info(Plain, InTci, Constraints, Locns), output_exist_locns_array(RttiTypeCtor, Ordinal, Locns, !DeclSet, !IO), ( Constraints = [_ | _], output_exist_constraints_data(RttiTypeCtor, Ordinal, Constraints, !DeclSet, !IO) ; Constraints = [] ), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_exist_info(Ordinal)), !DeclSet, !IO), io.write_string(" = {\n\t", !IO), io.write_int(Plain, !IO), io.write_string(",\n\t", !IO), io.write_int(InTci, !IO), io.write_string(",\n\t", !IO), list.length(Constraints, Tci), io.write_int(Tci, !IO), io.write_string(",\n\t", !IO), output_ctor_rtti_id(RttiTypeCtor, type_ctor_exist_locns(Ordinal), !IO), io.write_string(",\n\t", !IO), ( Constraints = [_ | _], output_ctor_rtti_id(RttiTypeCtor, type_ctor_exist_tc_constrs(Ordinal), !IO) ; Constraints = [] ), io.write_string("\n};\n", !IO). :- pred output_du_arg_types(rtti_type_ctor::in, int::in, list(rtti_maybe_pseudo_type_info_or_self)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_du_arg_types(RttiTypeCtor, Ordinal, ArgTypes, !DeclSet, !IO) :- list.foldl2(output_maybe_pseudo_type_info_or_self_defn, ArgTypes, !DeclSet, !IO), ArgTypeDatas = list.map(maybe_pseudo_type_info_or_self_to_rtti_data, ArgTypes), output_rtti_datas_decls(ArgTypeDatas, "", "", 0, _, !DeclSet, !IO), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_field_types(Ordinal)), !DeclSet, !IO), io.write_string(" = {\n", !IO), expect(list.is_not_empty(ArgTypes), this_file, "output_du_arg_types: empty list"), output_cast_addr_of_rtti_datas("(MR_PseudoTypeInfo) ", ArgTypeDatas, !IO), io.write_string("};\n", !IO). :- pred output_du_arg_names(rtti_type_ctor::in, int::in, list(maybe(string))::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_du_arg_names(RttiTypeCtor, Ordinal, MaybeNames, !DeclSet, !IO) :- output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_field_names(Ordinal)), !DeclSet, !IO), io.write_string(" = {\n", !IO), expect(list.is_not_empty(MaybeNames), this_file, "output_du_arg_names: empty list"), output_maybe_quoted_strings(MaybeNames, !IO), io.write_string("};\n", !IO). %-----------------------------------------------------------------------------% :- pred output_enum_value_ordered_table(rtti_type_ctor::in, map(int, enum_functor)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_enum_value_ordered_table(RttiTypeCtor, FunctorMap, !DeclSet, !IO) :- Functors = map.values(FunctorMap), FunctorRttiNames = list.map(enum_functor_rtti_name, Functors), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_enum_value_ordered_table), !DeclSet, !IO), io.write_string(" = {\n", !IO), output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO), io.write_string("};\n", !IO). :- pred output_enum_name_ordered_table(rtti_type_ctor::in, map(string, enum_functor)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_enum_name_ordered_table(RttiTypeCtor, FunctorMap, !DeclSet, !IO) :- Functors = map.values(FunctorMap), FunctorRttiNames = list.map(enum_functor_rtti_name, Functors), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_enum_name_ordered_table), !DeclSet, !IO), io.write_string(" = {\n", !IO), output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO), io.write_string("};\n", !IO). :- pred output_du_name_ordered_table(rtti_type_ctor::in, map(string, map(int, du_functor))::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_du_name_ordered_table(RttiTypeCtor, NameArityMap, !DeclSet, !IO) :- map.values(NameArityMap, ArityMaps), list.map(map.values, ArityMaps, FunctorLists), list.condense(FunctorLists, Functors), FunctorRttiNames = list.map(du_functor_rtti_name, Functors), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_du_name_ordered_table), !DeclSet, !IO), io.write_string(" = {\n", !IO), output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorRttiNames, !IO), io.write_string("};\n", !IO). :- pred output_du_stag_ordered_table(rtti_type_ctor::in, pair(int, sectag_table)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_du_stag_ordered_table(RttiTypeCtor, Ptag - SectagTable, !DeclSet, !IO) :- SectagTable = sectag_table(_SectagLocn, _NumSharers, SectagMap), map.values(SectagMap, SectagFunctors), FunctorNames = list.map(du_functor_rtti_name, SectagFunctors), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_du_stag_ordered_table(Ptag)), !DeclSet, !IO), io.write_string(" = {\n", !IO), output_addr_of_ctor_rtti_names(RttiTypeCtor, FunctorNames, !IO), io.write_string("\n};\n", !IO). :- pred output_du_ptag_ordered_table(rtti_type_ctor::in, map(int, sectag_table)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_du_ptag_ordered_table(RttiTypeCtor, PtagMap, !DeclSet, !IO) :- map.to_assoc_list(PtagMap, PtagList), list.foldl2(output_du_stag_ordered_table(RttiTypeCtor), PtagList, !DeclSet, !IO), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_du_ptag_ordered_table), !DeclSet, !IO), io.write_string(" = {\n", !IO), ( PtagList = [1 - _ | _] -> % Output a dummy ptag definition for the reserved tag first. output_dummy_ptag_layout_defn(!IO), FirstPtag = 1 ; PtagList = [0 - _ | _] -> FirstPtag = 0 ; unexpected(this_file, "output_dummy_ptag_layout_defn: bad ptag list") ), output_du_ptag_ordered_table_body(RttiTypeCtor, PtagList, FirstPtag, !IO), io.write_string("\n};\n", !IO). :- pred output_du_ptag_ordered_table_body(rtti_type_ctor::in, assoc_list(int, sectag_table)::in, int::in, io::di, io::uo) is det. output_du_ptag_ordered_table_body(_RttiTypeCtor, [], _CurPtag, !IO). output_du_ptag_ordered_table_body(RttiTypeCtor, [Ptag - SectagTable | PtagTail], CurPtag, !IO) :- expect(unify(Ptag, CurPtag), this_file, "output_du_ptag_ordered_table_body: ptag mismatch"), SectagTable = sectag_table(SectagLocn, NumSharers, _SectagMap), io.write_string("\t{ ", !IO), io.write_int(NumSharers, !IO), io.write_string(", ", !IO), rtti.sectag_locn_to_string(SectagLocn, LocnStr), io.write_string(LocnStr, !IO), io.write_string(",\n\t", !IO), output_ctor_rtti_id(RttiTypeCtor, type_ctor_du_stag_ordered_table(Ptag), !IO), ( PtagTail = [], io.write_string(" }\n", !IO) ; PtagTail = [_ | _], io.write_string(" },\n", !IO), output_du_ptag_ordered_table_body(RttiTypeCtor, PtagTail, CurPtag + 1, !IO) ). % Output a `dummy' ptag layout, for use by tags that aren't *real* tags, % such as the tag reserved when --reserve-tag is on. % % XXX Note that if one of these dummy ptag definitions is actually accessed % by the Mercury runtime, the result will be undefined. This should be % fixed by adding a MR_SECTAG_DUMMY and handling it gracefully. % :- pred output_dummy_ptag_layout_defn(io::di, io::uo) is det. output_dummy_ptag_layout_defn(!IO) :- io.write_string("\t{ 0, MR_SECTAG_VARIABLE, NULL },\n", !IO). :- pred output_res_addr_functors(rtti_type_ctor::in, reserved_functor::in, io::di, io::uo) is det. output_res_addr_functors(RttiTypeCtor, ResFunctor, !IO) :- output_ctor_rtti_id(RttiTypeCtor, res_functor_rtti_name(ResFunctor), !IO), io.write_string(",\n", !IO). :- pred output_res_value_ordered_table(rtti_type_ctor::in, list(reserved_functor)::in, map(int, sectag_table)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_res_value_ordered_table(RttiTypeCtor, ResFunctors, DuPtagTable, !DeclSet, !IO) :- ResFunctorReps = list.map(res_addr_rep, ResFunctors), list.filter(res_addr_is_numeric, ResFunctorReps, NumericResFunctorReps, SymbolicResFunctorReps), list.length(NumericResFunctorReps, NumNumericResFunctorReps), list.length(SymbolicResFunctorReps, NumSymbolicResFunctorReps), expect(unify(NumSymbolicResFunctorReps, 0), this_file, "output_res_value_ordered_table: symbolic functors"), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_res_addr_functors), !DeclSet, !IO), io.write_string(" = {\n", !IO), list.foldl(output_res_addr_functors(RttiTypeCtor), ResFunctors, !IO), io.write_string("};\n", !IO), output_du_ptag_ordered_table(RttiTypeCtor, DuPtagTable, !DeclSet, !IO), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_res_value_ordered_table), !DeclSet, !IO), io.write_string(" = {\n\t""", !IO), io.write_int(NumNumericResFunctorReps, !IO), io.write_string(",\n\t", !IO), io.write_int(NumSymbolicResFunctorReps, !IO), io.write_string(",\n\t", !IO), io.write_string("NULL", !IO), io.write_string(",\n\t", !IO), output_ctor_rtti_id(RttiTypeCtor, type_ctor_res_addr_functors, !IO), io.write_string(",\n\t", !IO), output_ctor_rtti_id(RttiTypeCtor, type_ctor_du_ptag_ordered_table, !IO), io.write_string("\n};\n", !IO). :- pred output_res_name_ordered_table(rtti_type_ctor::in, map(string, map(int, maybe_reserved_functor))::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_res_name_ordered_table(RttiTypeCtor, NameArityMap, !DeclSet, !IO) :- map.values(NameArityMap, ArityMaps), list.map(map.values, ArityMaps, FunctorLists), list.condense(FunctorLists, Functors), output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_res_name_ordered_table), !DeclSet, !IO), io.write_string(" = {\n\t""", !IO), list.foldl(output_res_name_ordered_table_element(RttiTypeCtor), Functors, !IO), io.write_string("\n};\n", !IO). :- pred output_res_name_ordered_table_element(rtti_type_ctor::in, maybe_reserved_functor::in, io::di, io::uo) is det. output_res_name_ordered_table_element(RttiTypeCtor, MaybeResFunctor, !IO) :- io.write_string("\t{ """, !IO), ( MaybeResFunctor = res_func(ResFunctor), Name = ResFunctor ^ res_name, io.write_string(Name, !IO), io.write_string(""", ", !IO), io.write_string("0, ", !IO), io.write_string("MR_TRUE, ", !IO) ; MaybeResFunctor = du_func(DuFunctor), Name = DuFunctor ^ du_name, Arity = DuFunctor ^ du_orig_arity, io.write_string(Name, !IO), io.write_string(""", ", !IO), io.write_int(Arity, !IO), io.write_string(", ", !IO), io.write_string("MR_FALSE, ", !IO) ), RttiName = maybe_res_functor_rtti_name(MaybeResFunctor), output_ctor_rtti_id(RttiTypeCtor, RttiName, !IO), io.write_string(" },\n", !IO). %-----------------------------------------------------------------------------% :- func make_code_addr(rtti_proc_label) = code_addr. make_code_addr(ProcLabel) = make_entry_label_from_rtti(ProcLabel, no). :- pred output_reserved_address(reserved_address::in, io::di, io::uo) is det. output_reserved_address(null_pointer, !IO) :- io.write_string("NULL", !IO). output_reserved_address(small_pointer(Val), !IO) :- io.write_string("(const void *) ", !IO), io.write_int(Val, !IO). output_reserved_address(reserved_object(_, _, _), !IO) :- % These should only be used for the MLDS back-end. unexpected(this_file, "reserved_object"). %-----------------------------------------------------------------------------% :- pred output_functor_number_map(rtti_type_ctor::in, list(int)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_functor_number_map(RttiTypeCtor, FunctorNumberMap, !DeclSet, !IO) :- output_generic_rtti_data_defn_start( ctor_rtti_id(RttiTypeCtor, type_ctor_functor_number_map), !DeclSet, !IO), io.write_string(" = {\n\t", !IO), io.write_list(FunctorNumberMap, ",\n\t", io.write_int, !IO), io.write_string(" };\n\t", !IO). %-----------------------------------------------------------------------------% :- type data_group ---> data_group( data_c_type :: string, data_is_array :: bool, data_linkage :: linkage ). output_rtti_data_decl_list(RttiDatas, !DeclSet, !IO) :- classify_rtti_datas_to_decl(RttiDatas, multi_map.init, GroupMap), multi_map.to_assoc_list(GroupMap, GroupList), list.foldl2(output_rtti_data_decl_group, GroupList, !DeclSet, !IO). :- pred classify_rtti_datas_to_decl(list(rtti_data)::in, multi_map(data_group, rtti_id)::in, multi_map(data_group, rtti_id)::out) is det. classify_rtti_datas_to_decl([], !GroupMap). classify_rtti_datas_to_decl([RttiData | RttiDatas], !GroupMap) :- ( RttiData = rtti_data_pseudo_type_info(type_var(_)) -> % These just get represented as integers, so we don't need to declare % them. Also rtti_data_to_id/3 does not handle this case. true ; rtti_data_to_id(RttiData, RttiId), rtti_id_c_type(RttiId, CType, IsArray), rtti_id_linkage(RttiId, Linkage), Group = data_group(CType, IsArray, Linkage), multi_map.set(!.GroupMap, Group, RttiId, !:GroupMap) ), classify_rtti_datas_to_decl(RttiDatas, !GroupMap). :- pred output_rtti_data_decl_group(pair(data_group, list(rtti_id))::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_rtti_data_decl_group(Group - RttiIds, !DeclSet, !IO) :- % ChunkSize should be as large as possible to reduce the size of the % file being generated, but small enough not to overload the fixed % limits of our target C compilers. ChunkSize = 10, % The process of creating the multi_map reverses the order of rtti_ids, % we now undo this reversal. list.chunk(list.reverse(RttiIds), ChunkSize, RttiIdChunks), list.foldl2(output_rtti_data_decl_chunk(Group), RttiIdChunks, !DeclSet, !IO). :- pred output_rtti_data_decl_chunk(data_group::in, list(rtti_id)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_rtti_data_decl_chunk(Group, RttiIds, !DeclSet, !IO) :- ( % Pick a representative RttiId. All the operations we perform on it % below would have the same result regardless of which one we picked. RttiIds = [RttiId | _] ; RttiIds = [], unexpected(this_file, "output_rtti_data_decl_group: empty list") ), Group = data_group(CType, IsArray, Linkage), io.nl(!IO), output_rtti_type_decl(RttiId, !DeclSet, !IO), globals.io_get_globals(Globals, !IO), LinkageStr = c_data_linkage_string(Linkage, no), InclCodeAddr = rtti_id_would_include_code_addr(RttiId), io.write_string(LinkageStr, !IO), io.write_string(c_data_const_string(Globals, InclCodeAddr), !IO), c_util.output_quoted_string(CType, !IO), io.nl(!IO), output_rtti_data_decl_chunk_entries(IsArray, RttiIds, !DeclSet, !IO). :- pred output_rtti_data_decl_chunk_entries(bool::in, list(rtti_id)::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_rtti_data_decl_chunk_entries(_IsArray, [], !DeclSet, !IO) :- unexpected(this_file, "output_rtti_data_decl_chunk_entries: empty list"). output_rtti_data_decl_chunk_entries(IsArray, [RttiId | RttiIds], !DeclSet, !IO) :- DataAddr = rtti_addr(RttiId), decl_set_insert(decl_data_addr(DataAddr), !DeclSet), io.write_string("\t", !IO), output_rtti_id(RttiId, !IO), ( IsArray = yes, io.write_string("[]", !IO) ; IsArray = no ), ( RttiIds = [_ | _], io.write_string(",\n", !IO), output_rtti_data_decl_chunk_entries(IsArray, RttiIds, !DeclSet, !IO) ; RttiIds = [], io.write_string(";\n", !IO) ). %-----------------------------------------------------------------------------% output_rtti_data_decl(RttiData, !DeclSet, !IO) :- ( RttiData = rtti_data_pseudo_type_info(type_var(_)) -> % These just get represented as integers, so we don't need to declare % them. Also rtti_data_to_id/3 does not handle this case. true ; rtti_data_to_id(RttiData, RttiId), output_generic_rtti_data_decl(RttiId, !DeclSet, !IO) ). %-----------------------------------------------------------------------------% :- pred output_generic_rtti_data_decl(rtti_id::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_generic_rtti_data_decl(RttiId, !DeclSet, !IO) :- output_rtti_id_storage_type_name(RttiId, no, !DeclSet, !IO), io.write_string(";\n", !IO), DataAddr = rtti_addr(RttiId), decl_set_insert(decl_data_addr(DataAddr), !DeclSet). :- pred output_generic_rtti_data_defn_start(rtti_id::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_generic_rtti_data_defn_start(RttiId, !DeclSet, !IO) :- io.write_string("\n", !IO), output_rtti_id_storage_type_name(RttiId, yes, !DeclSet, !IO), DataAddr = rtti_addr(RttiId), decl_set_insert(decl_data_addr(DataAddr), !DeclSet). output_rtti_id_storage_type_name_no_decl(RttiId, BeingDefined, !IO) :- decl_set_init(DeclSet0), output_rtti_id_storage_type_name(RttiId, BeingDefined, DeclSet0, _, !IO). output_rtti_id_storage_type_name(RttiId, BeingDefined, !DeclSet, !IO) :- output_rtti_type_decl(RttiId, !DeclSet, !IO), rtti_id_linkage(RttiId, Linkage), globals.io_get_globals(Globals, !IO), LinkageStr = c_data_linkage_string(Linkage, BeingDefined), io.write_string(LinkageStr, !IO), InclCodeAddr = rtti_id_would_include_code_addr(RttiId), io.write_string(c_data_const_string(Globals, InclCodeAddr), !IO), rtti_id_c_type(RttiId, CType, IsArray), c_util.output_quoted_string(CType, !IO), io.write_string(" ", !IO), output_rtti_id(RttiId, !IO), ( IsArray = yes, io.write_string("[]", !IO) ; IsArray = no ). % Each type_info and pseudo_type_info may have a different C type, % depending on what kind of type_info or pseudo_type_info it is, % and also on its arity. We need to declare that C type here. % :- pred output_rtti_type_decl(rtti_id::in, decl_set::in, decl_set::out, io::di, io::uo) is det. output_rtti_type_decl(RttiId, !DeclSet, !IO) :- ( RttiId = ctor_rtti_id(_, RttiName), rtti_type_ctor_template_arity(RttiName, Arity), Arity > max_always_declared_arity_type_ctor -> DeclId = decl_type_info_like_struct(Arity), ( decl_set_is_member(DeclId, !.DeclSet) -> true ; Template = "#ifndef MR_TYPE_INFO_LIKE_STRUCTS_FOR_ARITY_%d_GUARD #define MR_TYPE_INFO_LIKE_STRUCTS_FOR_ARITY_%d_GUARD MR_DECLARE_ALL_TYPE_INFO_LIKE_STRUCTS_FOR_ARITY(%d); #endif ", io.format(Template, [i(Arity), i(Arity), i(Arity)], !IO), decl_set_insert(DeclId, !DeclSet) ) ; RttiId = tc_rtti_id(_, TCRttiName), rtti_type_class_constraint_template_arity(TCRttiName, Arity), Arity > max_always_declared_arity_type_class_constraint -> DeclId = decl_typeclass_constraint_struct(Arity), ( decl_set_is_member(DeclId, !.DeclSet) -> true ; Template = "#ifndef MR_TYPECLASS_CONSTRAINT_STRUCT_%d_GUARD #define MR_TYPECLASS_CONSTRAINT_STRUCT_%d_GUARD MR_DEFINE_TYPECLASS_CONSTRAINT_STRUCT(MR_TypeClassConstraint_%d, %d); #endif ", io.format(Template, [i(Arity), i(Arity), i(Arity), i(Arity)], !IO), decl_set_insert(DeclId, !DeclSet) ) ; true ). :- pred rtti_type_ctor_template_arity(ctor_rtti_name::in, int::out) is semidet. rtti_type_ctor_template_arity(RttiName, NumArgTypes) :- RttiName = type_ctor_type_info(TypeInfo), ( TypeInfo = plain_type_info(_, ArgTypes) ; TypeInfo = var_arity_type_info(_, ArgTypes) ), NumArgTypes = list.length(ArgTypes). rtti_type_ctor_template_arity(RttiName, NumArgTypes) :- RttiName = type_ctor_pseudo_type_info(PseudoTypeInfo), ( PseudoTypeInfo = plain_pseudo_type_info(_, ArgTypes) ; PseudoTypeInfo = var_arity_pseudo_type_info(_, ArgTypes) ), NumArgTypes = list.length(ArgTypes). :- func max_always_declared_arity_type_ctor = int. max_always_declared_arity_type_ctor = 20. :- pred rtti_type_class_constraint_template_arity(tc_rtti_name::in, int::out) is semidet. rtti_type_class_constraint_template_arity(TCRttiName, Arity) :- TCRttiName = type_class_decl_super(_, Arity). rtti_type_class_constraint_template_arity(TCRttiName, Arity) :- TCRttiName = type_class_instance_constraint(_, _, Arity). :- func max_always_declared_arity_type_class_constraint = int. max_always_declared_arity_type_class_constraint = 5. %-----------------------------------------------------------------------------% init_rtti_data_if_nec(Data, !IO) :- ( Data = rtti_data_type_ctor_info(TypeCtorData), RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData), io.write_string("\tMR_INIT_TYPE_CTOR_INFO(\n\t\t", !IO), output_ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info, !IO), io.write_string(",\n\t\t", !IO), RttiTypeCtor = rtti_type_ctor(ModuleName, TypeName, Arity), ModuleNameString = sym_name_mangle(ModuleName), string.append(ModuleNameString, "__", UnderscoresModule), ( string.append(UnderscoresModule, _, TypeName) -> true ; io.write_string(UnderscoresModule, !IO) ), MangledTypeName = name_mangle(TypeName), io.write_string(MangledTypeName, !IO), io.write_string("_", !IO), io.write_int(Arity, !IO), io.write_string("_0);\n", !IO) ; Data = rtti_data_base_typeclass_info(TCName, _ModuleName, ClassArity, base_typeclass_info(_N1, _N2, _N3, _N4, _N5, Methods)), io.write_string("#ifndef MR_STATIC_CODE_ADDRESSES\n", !IO), % The field number for the first method is 5, since the methods are % stored after N1 .. N5, and fields are numbered from 0. FirstFieldNum = 5, CodeAddrs = list.map(make_code_addr, Methods), output_init_method_pointers(FirstFieldNum, CodeAddrs, TCName, ClassArity, !IO), io.write_string("#endif /* MR_STATIC_CODE_ADDRESSES */\n", !IO) ; Data = rtti_data_type_class_instance(_), io.write_string("#ifndef MR_STATIC_CODE_ADDRESSES\n", !IO), io.write_string("#error ""type_class_instance " ++ "not yet supported without static code addresses""\n", !IO), io.write_string("#endif /* MR_STATIC_CODE_ADDRESSES */\n", !IO) ; ( Data = rtti_data_type_info(_) ; Data = rtti_data_pseudo_type_info(_) ; Data = rtti_data_type_class_decl(_) ) ). register_rtti_data_if_nec(Data, !IO) :- ( Data = rtti_data_type_ctor_info(TypeCtorData), RttiTypeCtor = tcd_get_rtti_type_ctor(TypeCtorData), RttiId = ctor_rtti_id(RttiTypeCtor, type_ctor_type_ctor_info), io.write_string("\t{\n\t", !IO), io.write_string("\tMR_register_type_ctor_info(\n\t\t&", !IO), output_rtti_id(RttiId, !IO), io.write_string(");\n\t}\n", !IO) ; Data = rtti_data_type_class_decl(TCDecl), TCDecl = tc_decl(TCId, _, _), TCId = tc_id(TCName, _, _), RttiId = tc_rtti_id(TCName, type_class_decl), io.write_string("\t{\n\t", !IO), io.write_string("\tMR_register_type_class_decl(\n\t\t&", !IO), output_rtti_id(RttiId, !IO), io.write_string(");\n\t}\n", !IO) ; Data = rtti_data_type_class_instance(TCInstance), TCInstance = tc_instance(TCName, TCTypes, _, _, _), RttiId = tc_rtti_id(TCName, type_class_instance(TCTypes)), io.write_string("\t{\n\t", !IO), io.write_string("\tMR_register_type_class_instance(\n\t\t&", !IO), output_rtti_id(RttiId, !IO), io.write_string(");\n\t}\n", !IO) ; ( Data = rtti_data_type_info(_) ; Data = rtti_data_pseudo_type_info(_) ; Data = rtti_data_base_typeclass_info(_, _, _, _) ) ). :- pred output_init_method_pointers(int::in, list(code_addr)::in, tc_name::in, string::in, io::di, io::uo) is det. output_init_method_pointers(_, [], _, _, !IO). output_init_method_pointers(FieldNum, [Arg | Args], TCName, InstanceStr, !IO) :- io.write_string("\t\t", !IO), io.write_string("MR_field(MR_mktag(0), ", !IO), output_base_typeclass_info_name(TCName, InstanceStr, !IO), io.format(", %d) =\n\t\t\t", [i(FieldNum)], !IO), output_code_addr(Arg, !IO), io.write_string(";\n", !IO), output_init_method_pointers(FieldNum + 1, Args, TCName, InstanceStr, !IO). %-----------------------------------------------------------------------------% :- pred output_rtti_datas_decls(list(rtti_data)::in, string::in, string::in, int::in, int::out, decl_set::in, decl_set::out, io::di, io::uo) is det. output_rtti_datas_decls([], _, _, !N, !DeclSet, !IO). output_rtti_datas_decls([RttiData | RttiDatas], FirstIndent, LaterIndent, !N, !DeclSet, !IO) :- output_rtti_data_decls(RttiData, FirstIndent, LaterIndent, !N, !DeclSet, !IO), output_rtti_datas_decls(RttiDatas, FirstIndent, LaterIndent, !N, !DeclSet, !IO). :- pred output_rtti_data_decls(rtti_data::in, string::in, string::in, int::in, int::out, decl_set::in, decl_set::out, io::di, io::uo) is det. output_rtti_data_decls(RttiData, FirstIndent, LaterIndent, !N, !DeclSet, !IO) :- ( RttiData = rtti_data_pseudo_type_info(type_var(_)) -> % These just get represented as integers, so we don't need to declare % them. Also rtti_data_to_id/3 does not handle this case. true ; rtti_data_to_id(RttiData, RttiId), output_rtti_id_decls(RttiId, FirstIndent, LaterIndent, !N, !DeclSet, !IO) ). :- pred output_rtti_id_decls(rtti_id::in, string::in, string::in, int::in, int::out, decl_set::in, decl_set::out, io::di, io::uo) is det. output_rtti_id_decls(RttiId, FirstIndent, LaterIndent, !N, !DeclSet, !IO) :- output_data_addr_decls_format(rtti_addr(RttiId), FirstIndent, LaterIndent, !N, !DeclSet, !IO). :- pred output_cast_addr_of_rtti_ids(string::in, list(rtti_id)::in, io::di, io::uo) is det. output_cast_addr_of_rtti_ids(_, [], !IO) :- io.write_string( "\t/* Dummy entry, since ISO C forbids zero-sized arrays */\n", !IO), io.write_string("\t0\n", !IO). output_cast_addr_of_rtti_ids(Cast, [TCRttiName | TCRttiNames], !IO) :- io.write_string("\t", !IO), io.write_list([TCRttiName | TCRttiNames], ",\n\t", output_cast_addr_of_rtti_id(Cast), !IO), io.write_string("\n", !IO). :- pred output_addr_of_ctor_rtti_names(rtti_type_ctor::in, list(ctor_rtti_name)::in, io::di, io::uo) is det. output_addr_of_ctor_rtti_names(_, [], !IO). output_addr_of_ctor_rtti_names(RttiTypeCtor, [RttiName | RttiNames], !IO) :- io.write_string("\t", !IO), io.write_list([RttiName | RttiNames], ",\n\t", output_addr_of_ctor_rtti_id(RttiTypeCtor), !IO), io.write_string("\n", !IO). :- pred output_cast_addr_of_rtti_datas(string::in, list(rtti_data)::in, io::di, io::uo) is det. output_cast_addr_of_rtti_datas(_, [], !IO) :- io.write_string( "\t/* Dummy entry, since ISO C forbids zero-sized arrays */\n", !IO), io.write_string("\t0\n", !IO). output_cast_addr_of_rtti_datas(Cast, [RttiData | RttiDatas], !IO) :- io.write_string("\t", !IO), io.write_list([RttiData | RttiDatas], ",\n\t", output_cast_addr_of_rtti_data(Cast), !IO), io.write_string("\n", !IO). :- pred output_addr_of_rtti_datas(list(rtti_data)::in, io::di, io::uo) is det. output_addr_of_rtti_datas([], !IO). output_addr_of_rtti_datas([RttiData | RttiDatas], !IO) :- io.write_string("\t", !IO), io.write_list([RttiData | RttiDatas], ",\n\t", output_addr_of_rtti_data, !IO), io.write_string("\n", !IO). output_cast_addr_of_rtti_data(Cast, RttiData, !IO) :- io.write_string(Cast, !IO), output_addr_of_rtti_data(RttiData, !IO). output_addr_of_rtti_data(RttiData, !IO) :- ( RttiData = rtti_data_pseudo_type_info(type_var(VarNum)) -> % rtti_data_to_id/3 does not handle this case io.write_int(VarNum, !IO) ; rtti_data_to_id(RttiData, RttiId), output_addr_of_rtti_id(RttiId, !IO) ). :- pred output_cast_addr_of_rtti_id(string::in, rtti_id::in, io::di, io::uo) is det. output_cast_addr_of_rtti_id(Cast, RttiId, !IO) :- io.write_string(Cast, !IO), output_addr_of_rtti_id(RttiId, !IO). :- pred output_addr_of_rtti_id(rtti_id::in, io::di, io::uo) is det. output_addr_of_rtti_id(RttiId, !IO) :- % If the RttiName is not an array, then we need to use `&' % to take its address. ( RttiId = ctor_rtti_id(_, type_ctor_pseudo_type_info(type_var(VarNum))) -> io.write_int(VarNum, !IO) ; rtti_id_has_array_type(RttiId) = yes -> output_rtti_id(RttiId, !IO) ; io.write_string("&", !IO), output_rtti_id(RttiId, !IO) ). :- pred output_addr_of_ctor_rtti_id(rtti_type_ctor::in, ctor_rtti_name::in, io::di, io::uo) is det. output_addr_of_ctor_rtti_id(RttiTypeCtor, RttiName, !IO) :- output_addr_of_rtti_id(ctor_rtti_id(RttiTypeCtor, RttiName), !IO). output_rtti_id(RttiId, !IO) :- io.write_string(mercury_data_prefix, !IO), rtti.id_to_c_identifier(RttiId, Str), io.write_string(Str, !IO). :- pred output_ctor_rtti_id(rtti_type_ctor::in, ctor_rtti_name::in, io::di, io::uo) is det. output_ctor_rtti_id(RttiTypeCtor, RttiName, !IO) :- output_rtti_id(ctor_rtti_id(RttiTypeCtor, RttiName), !IO). %-----------------------------------------------------------------------------% :- pred output_maybe_quoted_string(maybe(string)::in, io::di, io::uo) is det. output_maybe_quoted_string(MaybeName, !IO) :- ( MaybeName = yes(Name), io.write_string("""", !IO), c_util.output_quoted_string(Name, !IO), io.write_string("""", !IO) ; MaybeName = no, io.write_string("NULL", !IO) ). :- pred output_maybe_quoted_strings(list(maybe(string))::in, io::di, io::uo) is det. output_maybe_quoted_strings(MaybeNames, !IO) :- io.write_string("\t", !IO), io.write_list(MaybeNames, ",\n\t", output_maybe_quoted_string, !IO), io.write_string("\n", !IO). %-----------------------------------------------------------------------------% :- pred output_exist_locn(exist_typeinfo_locn::in, io::di, io::uo) is det. output_exist_locn(Locn, !IO) :- ( Locn = plain_typeinfo(SlotInCell), io.write_string("{ ", !IO), io.write_int(SlotInCell, !IO), io.write_string(", -1 }", !IO) ; Locn = typeinfo_in_tci(SlotInCell, SlotInTci), io.write_string("{ ", !IO), io.write_int(SlotInCell, !IO), io.write_string(", ", !IO), io.write_int(SlotInTci, !IO), io.write_string(" }", !IO) ). :- pred output_exist_locns(list(exist_typeinfo_locn)::in, io::di, io::uo) is det. output_exist_locns(Locns, !IO) :- io.write_string("\t", !IO), io.write_list(Locns, ",\n\t", output_exist_locn, !IO), io.write_string("\n", !IO). :- pred output_maybe_static_code_addr(maybe(code_addr)::in, io::di, io::uo) is det. output_maybe_static_code_addr(yes(CodeAddr), !IO) :- output_static_code_addr(CodeAddr, !IO). output_maybe_static_code_addr(no, !IO) :- io.write_string("NULL", !IO). :- pred output_static_code_addr(code_addr::in, io::di, io::uo) is det. output_static_code_addr(CodeAddr, !IO) :- io.write_string("MR_MAYBE_STATIC_CODE(", !IO), output_code_addr(CodeAddr, !IO), io.write_string(")", !IO). %-----------------------------------------------------------------------------% :- pred rtti_id_linkage(rtti_id::in, linkage::out) is det. rtti_id_linkage(RttiId, Linkage) :- ( % ANSI/ISO C doesn't allow forward declarations of static data % with incomplete types (in this case array types without an explicit % array size), so make the declarations extern. yes = rtti_id_has_array_type(RttiId) -> Linkage = extern ; Exported = rtti_id_is_exported(RttiId), ( Exported = yes, Linkage = extern ; Exported = no, Linkage = static ) ). %-----------------------------------------------------------------------------% :- func this_file = string. this_file = "rtti_out.m". %-----------------------------------------------------------------------------%