%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2015 The Mercury team. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % This module converts the parse tree structure representations of pragmas % back into Mercury source text. % %---------------------------------------------------------------------------% :- module parse_tree.parse_tree_out_pragma. :- interface. :- import_module parse_tree.parse_tree_out_info. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_data_pragma. :- import_module parse_tree.prog_item. :- import_module bool. :- import_module io. :- import_module maybe. %---------------------------------------------------------------------------% :- pred mercury_output_item_decl_pragma(merc_out_info::in, io.text_output_stream::in, item_decl_pragma_info::in, io::di, io::uo) is det. :- pred mercury_output_item_impl_pragma(merc_out_info::in, io.text_output_stream::in, item_impl_pragma_info::in, io::di, io::uo) is det. :- pred mercury_output_item_generated_pragma(merc_out_info::in, io.text_output_stream::in, item_generated_pragma_info::in, io::di, io::uo) is det. %---------------------------------------------------------------------------% :- pred mercury_output_item_pred_marker(io.text_output_stream::in, pragma_info_pred_marker::in, io::di, io::uo) is det. %---------------------------------------------------------------------------% :- pred mercury_output_pragma_decl_pred_pf_name_arity( io.text_output_stream::in, string::in, pred_pf_name_arity::in, string::in, io::di, io::uo) is det. :- func mercury_pragma_decl_pred_pf_name_arity_to_string(string, pred_pf_name_arity, string) = string. :- pred mercury_output_pragma_foreign_decl(io.text_output_stream::in, pragma_info_foreign_decl::in, io::di, io::uo) is det. :- func mercury_pragma_foreign_decl_to_string(pragma_info_foreign_decl) = string. :- pred mercury_output_pragma_foreign_proc(io.text_output_stream::in, output_lang::in, pragma_info_foreign_proc::in, io::di, io::uo) is det. :- func mercury_pragma_foreign_proc_to_string(output_lang, pragma_info_foreign_proc) = string. :- pred mercury_output_pragma_type_spec(io.text_output_stream::in, output_lang::in, pragma_info_type_spec::in, io::di, io::uo) is det. :- pred mercury_output_pragma_unused_args(io.text_output_stream::in, pragma_info_unused_args::in, io::di, io::uo) is det. :- pred mercury_output_pragma_exceptions(io.text_output_stream::in, pragma_info_exceptions::in, io::di, io::uo) is det. :- pred mercury_output_pragma_trailing_info(io.text_output_stream::in, pragma_info_trailing_info::in, io::di, io::uo) is det. :- pred mercury_output_pragma_mm_tabling_info(io.text_output_stream::in, pragma_info_mm_tabling_info::in, io::di, io::uo) is det. %---------------------------------------------------------------------------% % This predicate outputs termination_info pragmas; % such annotations can be part of .opt and .trans_opt files. % :- pred write_pragma_termination_info(io.text_output_stream::in, output_lang::in, pragma_info_termination_info::in, io::di, io::uo) is det. % Return a string representation of the given arg size info. % Include the representation of any error infos if the first arg is yes. % :- func maybe_arg_size_info_to_string(bool, maybe(generic_arg_size_info(T))) = string. % Return a string representation of the given termination info. % Include the representation of any error_infos if the first arg is yes. % :- func maybe_termination_info_to_string(bool, maybe(generic_termination_info(S, T))) = string. %---------------------------------------------------------------------------% :- pred write_pragma_termination2_info(io.text_output_stream::in, output_lang::in, pragma_info_termination2_info::in, io::di, io::uo) is det. %---------------------------------------------------------------------------% :- pred write_pragma_structure_sharing_info(io.text_output_stream::in, output_lang::in, pragma_info_structure_sharing::in, io::di, io::uo) is det. :- pred write_pragma_structure_reuse_info(io.text_output_stream::in, output_lang::in, pragma_info_structure_reuse::in, io::di, io::uo) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module libs. :- import_module libs.compiler_util. :- import_module libs.globals. :- import_module libs.rat. :- import_module mdbcomp. :- import_module mdbcomp.prim_data. :- import_module mdbcomp.sym_name. :- import_module parse_tree.parse_tree_out_inst. :- import_module parse_tree.parse_tree_out_misc. :- import_module parse_tree.parse_tree_out_pred_decl. :- import_module parse_tree.parse_tree_out_sym_name. :- import_module parse_tree.parse_tree_out_term. :- import_module parse_tree.parse_tree_out_type. :- import_module parse_tree.prog_ctgc. :- import_module parse_tree.prog_data_foreign. :- import_module parse_tree.prog_util. :- import_module parse_tree.var_db. :- import_module char. :- import_module list. :- import_module one_or_more. :- import_module pair. :- import_module require. :- import_module set. :- import_module string. :- import_module term. :- import_module term_io. :- import_module unit. :- import_module varset. %---------------------------------------------------------------------------% mercury_output_item_decl_pragma(Info, Stream, ItemDeclPragma, !IO) :- ItemDeclPragma = item_pragma_info(Pragma, Context, _SeqNum), maybe_output_line_number(Info, Context, Stream, !IO), Lang = get_output_lang(Info), ( Pragma = decl_pragma_obsolete_pred(ObsPredInfo), mercury_output_pragma_obsolete_pred(Stream, ObsPredInfo, !IO) ; Pragma = decl_pragma_obsolete_proc(ObsProcInfo), mercury_output_pragma_obsolete_proc(Stream, Lang, ObsProcInfo, !IO) ; Pragma = decl_pragma_format_call(FormatCallInfo), mercury_output_pragma_format_call(Stream, FormatCallInfo, !IO) ; Pragma = decl_pragma_type_spec(TypeSpecInfo), mercury_output_pragma_type_spec(Stream, Lang, TypeSpecInfo, !IO) ; Pragma = decl_pragma_oisu(OISUInfo), mercury_output_pragma_oisu(Stream, OISUInfo, !IO) ; Pragma = decl_pragma_terminates(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "terminates", PredSpec, "", Stream, !IO) ; Pragma = decl_pragma_does_not_terminate(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "does_not_terminate", PredSpec, "", Stream, !IO) ; Pragma = decl_pragma_check_termination(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "check_termination", PredSpec, "", Stream, !IO) ; Pragma = decl_pragma_termination_info(TermInfo), write_pragma_termination_info(Stream, Lang, TermInfo, !IO) ; Pragma = decl_pragma_termination2_info(Term2Info), write_pragma_termination2_info(Stream, Lang, Term2Info, !IO) ; Pragma = decl_pragma_structure_sharing(SharingInfo), write_pragma_structure_sharing_info(Stream, Lang, SharingInfo, !IO) ; Pragma = decl_pragma_structure_reuse(ReuseInfo), write_pragma_structure_reuse_info(Stream, Lang, ReuseInfo, !IO) ). mercury_output_item_impl_pragma(Info, Stream, ItemImplPragma, !IO) :- ItemImplPragma = item_pragma_info(Pragma, Context, _SeqNum), maybe_output_line_number(Info, Context, Stream, !IO), Lang = get_output_lang(Info), ( Pragma = impl_pragma_foreign_decl(FDInfo), mercury_output_pragma_foreign_decl(Stream, FDInfo, !IO) ; Pragma = impl_pragma_foreign_code(FCInfo), mercury_output_pragma_foreign_code(Stream, FCInfo, !IO) ; Pragma = impl_pragma_foreign_proc(FPInfo), mercury_output_pragma_foreign_proc(Stream, Lang, FPInfo, !IO) ; Pragma = impl_pragma_foreign_proc_export(FPEInfo), mercury_format_pragma_foreign_proc_export(Lang, FPEInfo, Stream, !IO) ; Pragma = impl_pragma_external_proc(ExternalInfo), mercury_format_pragma_external_proc(ExternalInfo, Stream, !IO) ; Pragma = impl_pragma_fact_table(FactTableInfo), mercury_format_pragma_fact_table(FactTableInfo, Stream, !IO) ; Pragma = impl_pragma_inline(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "inline", PredSpec, "", Stream, !IO) ; Pragma = impl_pragma_no_inline(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "no_inline", PredSpec, "", Stream, !IO) ; Pragma = impl_pragma_tabled(TabledInfo), mercury_output_pragma_tabled(Stream, TabledInfo, !IO) ; Pragma = impl_pragma_consider_used(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "consider_used", PredSpec, "", Stream, !IO) ; Pragma = impl_pragma_no_detism_warning(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "no_determinism_warning", PredSpec, "", Stream, !IO) ; Pragma = impl_pragma_mode_check_clauses(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "mode_check_clauses", PredSpec, "", Stream, !IO) ; Pragma = impl_pragma_require_tail_rec(RequireTailrecPragma), mercury_output_pragma_require_tail_rec(Stream, Lang, RequireTailrecPragma, !IO) ; Pragma = impl_pragma_promise_pure(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "promise_pure", PredSpec, "", Stream, !IO) ; Pragma = impl_pragma_promise_semipure(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "promise_semipure", PredSpec, "", Stream, !IO) ; Pragma = impl_pragma_promise_eqv_clauses(PredSpec), mercury_format_pragma_decl_pred_pfu_name_arity( "promise_equivalent_clauses", PredSpec, "", Stream, !IO) ; Pragma = impl_pragma_require_feature_set(RFSInfo), mercury_format_pragma_require_feature_set(RFSInfo, Stream, !IO) ). mercury_output_item_generated_pragma(Info, Stream, ItemGenPragma, !IO) :- ItemGenPragma = item_pragma_info(Pragma, Context, _SeqNum), maybe_output_line_number(Info, Context, Stream, !IO), ( Pragma = gen_pragma_unused_args(UnusedArgsInfo), mercury_output_pragma_unused_args(Stream, UnusedArgsInfo, !IO) ; Pragma = gen_pragma_exceptions(ExceptionsInfo), mercury_output_pragma_exceptions(Stream, ExceptionsInfo, !IO) ; Pragma = gen_pragma_trailing_info(TrailingInfo), mercury_output_pragma_trailing_info(Stream, TrailingInfo, !IO) ; Pragma = gen_pragma_mm_tabling_info(TablingInfo), mercury_output_pragma_mm_tabling_info(Stream, TablingInfo, !IO) ). %---------------------------------------------------------------------------% mercury_output_item_pred_marker(Stream, PredMarker, !IO) :- PredMarker = pragma_info_pred_marker(PredSpec, PredMarkerKind), ( PredMarkerKind = pmpk_inline, PragmaName = "inline" ; PredMarkerKind = pmpk_noinline, PragmaName = "no_inline" ; PredMarkerKind = pmpk_promise_eqv_clauses, PragmaName = "promise_equivalent_clauses" ; PredMarkerKind = pmpk_promise_pure, PragmaName = "promise_pure" ; PredMarkerKind = pmpk_promise_semipure, PragmaName = "promise_semipure" ; PredMarkerKind = pmpk_terminates, PragmaName = "terminates" ; PredMarkerKind = pmpk_does_not_terminate, PragmaName = "does_not_terminate" ; PredMarkerKind = pmpk_mode_check_clauses, PragmaName = "mode_check_clauses" ), mercury_format_pragma_decl_pred_pf_name_arity(PragmaName, PredSpec, "", Stream, !IO). %---------------------------------------------------------------------------% % % Output a generic pragma declaration. Used to implement % several kinds of pragmas. % :- pred mercury_format_pragma_decl_pred_or_proc_pfumm_name(string::in, pred_or_proc_pfumm_name::in, string::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_decl_pred_or_proc_pfumm_name(PragmaName, PredOrProcSpec, AfterStr, S, !U) :- PredOrProcSpecStr = pred_or_proc_pfumm_name_to_string(output_mercury, PredOrProcSpec), add_string(":- pragma ", S, !U), add_string(PragmaName, S, !U), add_string("(", S, !U), add_string(PredOrProcSpecStr, S, !U), add_string(AfterStr, S, !U), add_string(").\n", S, !U). %---------------------% mercury_output_pragma_decl_pred_pf_name_arity(Stream, PragmaName, PredSpec, MaybeAfter, !IO) :- mercury_format_pragma_decl_pred_pf_name_arity(PragmaName, PredSpec, MaybeAfter, Stream, !IO). mercury_pragma_decl_pred_pf_name_arity_to_string(PragmaName, PredSpec, MaybeAfter) = String :- mercury_format_pragma_decl_pred_pf_name_arity(PragmaName, PredSpec, MaybeAfter, unit, "", String). :- pred mercury_format_pragma_decl_pred_pf_name_arity(string::in, pred_pf_name_arity::in, string::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_decl_pred_pf_name_arity(PragmaName, PredSpec0, AfterStr, S, !U) :- add_string(":- pragma ", S, !U), add_string(PragmaName, S, !U), add_string("(", S, !U), PredSpec0 = pred_pf_name_arity(PredOrFunc, PredName, Arity), mercury_format_pred_pf_name_arity(PredOrFunc, PredName, Arity, S, !U), add_string(AfterStr, S, !U), add_string(").\n", S, !U). %---------------------% :- pred mercury_format_pragma_decl_pred_pfu_name_arity(string::in, pred_pfu_name_arity::in, string::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_decl_pred_pfu_name_arity(PragmaName, PredSpec0, AfterStr, S, !U) :- add_string(":- pragma ", S, !U), add_string(PragmaName, S, !U), add_string("(", S, !U), PredSpec0 = pred_pfu_name_arity(PFU, PredName, Arity), mercury_format_pred_pfu_name_arity(PFU, PredName, Arity, S, !U), add_string(AfterStr, S, !U), add_string(").\n", S, !U). %---------------------------------------------------------------------------% % % Output a foreign_decl pragma. % mercury_output_pragma_foreign_decl(Stream, FDInfo, !IO) :- mercury_format_pragma_foreign_decl(FDInfo, Stream, !IO). mercury_pragma_foreign_decl_to_string(FDInfo) = String :- mercury_format_pragma_foreign_decl(FDInfo, unit, "", String). :- pred mercury_format_pragma_foreign_decl(pragma_info_foreign_decl::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_foreign_decl(FDInfo, S, !U) :- FDInfo = pragma_info_foreign_decl(Lang, IsLocal, LiteralOrInclude), add_string(":- pragma foreign_decl(", S, !U), mercury_format_foreign_language_string(Lang, S, !U), add_string(", ", S, !U), ( IsLocal = foreign_decl_is_local, add_string("local", S, !U) ; IsLocal = foreign_decl_is_exported, add_string("exported", S, !U) ), add_string(", ", S, !U), mercury_format_foreign_literal_or_include(LiteralOrInclude, S, !U), add_string(").\n", S, !U). %---------------------------------------------------------------------------% % % Output a foreign_code pragma. % :- pred mercury_output_pragma_foreign_code(io.text_output_stream::in, pragma_info_foreign_code::in, io::di, io::uo) is det. mercury_output_pragma_foreign_code(Stream, FCInfo, !IO) :- FCInfo = pragma_info_foreign_code(Lang, LiteralOrInclude), LangStr = mercury_foreign_language_to_string(Lang), LorIStr = foreign_literal_or_include_to_string(LiteralOrInclude), io.format(Stream, ":- pragma foreign_code(%s, %s).\n", [s(LangStr), s(LorIStr)], !IO). :- func foreign_literal_or_include_to_string(foreign_literal_or_include) = string. foreign_literal_or_include_to_string(LiteralOrInclude) = Str :- mercury_format_foreign_literal_or_include(LiteralOrInclude, unit, "", Str). :- pred mercury_format_foreign_literal_or_include( foreign_literal_or_include::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_foreign_literal_or_include(LiteralOrInclude, S, !U) :- ( LiteralOrInclude = floi_literal(Code), mercury_format_foreign_code_string(Code, S, !U) ; LiteralOrInclude = floi_include_file(FileName), add_string("include_file(", S, !U), add_quoted_string(FileName, S, !U), add_string(")", S, !U) ). %---------------------% % The code here is similar to the code for term_io.quote_string, % but \n and \t are output directly, rather than escaped. % Any changes here may require corresponding changes to term_io and vice versa. :- pred mercury_format_foreign_code_string(string::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_foreign_code_string(Str, S, !U) :- add_string("""", S, !U), mercury_format_escaped_string(Str, S, !U), add_string("""", S, !U). :- pred mercury_format_escaped_string(string::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_escaped_string(String, S, !U) :- string.foldl(mercury_format_escaped_char(S), String, !U). :- pred mercury_format_escaped_char(S::in, char::in, U::di, U::uo) is det <= output(S, U). mercury_format_escaped_char(S, Char, !U) :- ( if escape_special_char(Char, QuoteChar) then add_char('\\', S, !U), add_char(QuoteChar, S, !U) else if mercury_is_source_char(Char) then add_char(Char, S, !U) else add_string(mercury_escape_char(Char), S, !U) ). % escape_special_char(Char, EscapeChar): % % True iff Char is character for which there is a special backslash-escape % character EscapeChar that can be used after a backslash in Mercury % foreign_code string literals to represent Char. % :- pred escape_special_char(char::in, char::out) is semidet. escape_special_char('''', ''''). escape_special_char('"', '"'). escape_special_char('\\', '\\'). escape_special_char('\b', 'b'). % Succeed if Char is a character which is allowed in % Mercury string and character literals. % :- pred mercury_is_source_char(char::in) is semidet. mercury_is_source_char(Char) :- ( char.is_alnum(Char) ; is_mercury_punctuation_char(Char) ; Char = '\n' ; Char = '\t' ). %---------------------------------------------------------------------------% % % Output a foreign_proc pragma. % mercury_output_pragma_foreign_proc(Stream, Lang, FPInfo, !IO) :- mercury_format_pragma_foreign_proc(Lang, FPInfo, Stream, !IO). mercury_pragma_foreign_proc_to_string(Lang, FPInfo) = String :- mercury_format_pragma_foreign_proc(Lang, FPInfo, unit, "", String). :- pred mercury_format_pragma_foreign_proc(output_lang::in, pragma_info_foreign_proc::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_foreign_proc(Lang, FPInfo, S, !U) :- FPInfo = pragma_info_foreign_proc(Attributes, PredName, PredOrFunc, Vars0, ProgVarSet, InstVarSet, PragmaCode), add_string(":- pragma foreign_proc(", S, !U), ForeignLang = get_foreign_language(Attributes), mercury_format_foreign_language_string(ForeignLang, S, !U), add_string(", ", S, !U), mercury_format_sym_name(PredName, S, !U), ( PredOrFunc = pf_predicate, Vars = Vars0, ResultVars = [] ; PredOrFunc = pf_function, pred_args_to_func_args(Vars0, Vars, ResultVar), ResultVars = [ResultVar] ), ( Vars = [] ; Vars = [_ | _], add_string("(", S, !U), mercury_format_pragma_foreign_proc_vars(Lang, ProgVarSet, InstVarSet, Vars, S, !U), add_string(")", S, !U) ), ( PredOrFunc = pf_predicate ; PredOrFunc = pf_function, add_string(" = (", S, !U), mercury_format_pragma_foreign_proc_vars(Lang, ProgVarSet, InstVarSet, ResultVars, S, !U), add_string(")", S, !U) ), add_string(", ", S, !U), mercury_format_pragma_foreign_attributes(ProgVarSet, Attributes, S, !U), add_string(", ", S, !U), PragmaCode = fp_impl_ordinary(C_Code, _), mercury_format_foreign_code_string(C_Code, S, !U), add_string(").\n", S, !U). %---------------------% :- pred mercury_format_pragma_foreign_proc_vars(output_lang::in, prog_varset::in, inst_varset::in, list(pragma_var)::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_foreign_proc_vars(_, _, _, [], _S, !U). mercury_format_pragma_foreign_proc_vars(Lang, ProgVarSet, InstVarSet, [Var | Vars], S, !U) :- Var = pragma_var(_Var, VarName, Mode, _BoxPolicy), add_string(VarName, S, !U), add_string(" :: ", S, !U), mercury_format_mode(Lang, InstVarSet, Mode, S, !U), ( Vars = [] ; Vars = [_ | _], add_string(", ", S, !U) ), mercury_format_pragma_foreign_proc_vars(Lang, ProgVarSet, InstVarSet, Vars, S, !U). %---------------------% :- pred mercury_format_pragma_foreign_attributes(prog_varset::in, pragma_foreign_proc_attributes::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_foreign_attributes(VarSet, Attributes, S, !U) :- add_string("[", S, !U), add_list(add_string, ", ", foreign_proc_attributes_to_strings(Attributes, VarSet), S, !U), add_string("]", S, !U). % Convert the foreign code attributes to their source code representations % suitable for placing in the attributes list of the pragma (not all % attributes have one). In particular, the foreign language attribute needs % to be handled separately as it belongs at the start of the pragma. % :- func foreign_proc_attributes_to_strings(pragma_foreign_proc_attributes, prog_varset) = list(string). foreign_proc_attributes_to_strings(Attrs, VarSet) = StringList :- MayCallMercury = get_may_call_mercury(Attrs), ThreadSafe = get_thread_safe(Attrs), TabledForIO = get_tabled_for_io(Attrs), Purity = get_purity(Attrs), Terminates = get_terminates(Attrs), UserSharing = get_user_annotated_sharing(Attrs), Exceptions = get_may_throw_exception(Attrs), OrdinaryDespiteDetism = get_ordinary_despite_detism(Attrs), MayModifyTrail = get_may_modify_trail(Attrs), MayCallMM_Tabled = get_may_call_mm_tabled(Attrs), BoxPolicy = get_box_policy(Attrs), AffectsLiveness = get_affects_liveness(Attrs), AllocatesMemory = get_allocates_memory(Attrs), RegistersRoots = get_registers_roots(Attrs), MaybeMayDuplicate = get_may_duplicate(Attrs), MaybeMayExportBody = get_may_export_body(Attrs), ExtraAttributes = get_extra_attributes(Attrs), ( MayCallMercury = proc_may_call_mercury, MayCallMercuryStr = "may_call_mercury" ; MayCallMercury = proc_will_not_call_mercury, MayCallMercuryStr = "will_not_call_mercury" ), ( ThreadSafe = proc_not_thread_safe, ThreadSafeStr = "not_thread_safe" ; ThreadSafe = proc_thread_safe, ThreadSafeStr = "thread_safe" ; ThreadSafe = proc_maybe_thread_safe, ThreadSafeStr = "maybe_thread_safe" ), ( TabledForIO = proc_tabled_for_io, TabledForIOStr = "tabled_for_io" ; TabledForIO = proc_tabled_for_io_unitize, TabledForIOStr = "tabled_for_io_unitize" ; TabledForIO = proc_tabled_for_descendant_io, TabledForIOStr = "tabled_for_descendant_io" ; TabledForIO = proc_not_tabled_for_io, TabledForIOStr = "not_tabled_for_io" ), ( Purity = purity_pure, PurityStrList = ["promise_pure"] ; Purity = purity_semipure, PurityStrList = ["promise_semipure"] ; Purity = purity_impure, PurityStrList = [] ), ( Terminates = proc_terminates, TerminatesStrList = ["terminates"] ; Terminates = proc_does_not_terminate, TerminatesStrList = ["does_not_terminate"] ; Terminates = depends_on_mercury_calls, TerminatesStrList = [] ), ( UserSharing = user_sharing(Sharing, MaybeTypes), String = user_annotated_sharing_to_string(VarSet, Sharing, MaybeTypes), UserSharingStrList = [String] ; UserSharing = no_user_annotated_sharing, UserSharingStrList = [] ), ( Exceptions = proc_will_not_throw_exception, ExceptionsStrList = ["will_not_throw_exception"] ; Exceptions = default_exception_behaviour, ExceptionsStrList = [] ), ( OrdinaryDespiteDetism = yes, OrdinaryDespiteDetismStrList = ["ordinary_despite_detism"] ; OrdinaryDespiteDetism = no, OrdinaryDespiteDetismStrList = [] ), ( MayModifyTrail = proc_may_modify_trail, MayModifyTrailStrList = ["may_modify_trail"] ; MayModifyTrail = proc_will_not_modify_trail, MayModifyTrailStrList = ["will_not_modify_trail"] ), ( MayCallMM_Tabled = proc_may_call_mm_tabled, MayCallMM_TabledStrList = ["may_call_mm_tabled"] ; MayCallMM_Tabled = proc_will_not_call_mm_tabled, MayCallMM_TabledStrList =["will_not_call_mm_tabled"] ; MayCallMM_Tabled = proc_default_calls_mm_tabled, MayCallMM_TabledStrList = [] ), ( BoxPolicy = bp_native_if_possible, BoxPolicyStrList = [] ; BoxPolicy = bp_always_boxed, BoxPolicyStrList = ["always_boxed"] ), ( AffectsLiveness = proc_affects_liveness, AffectsLivenessStrList = ["affects_liveness"] ; AffectsLiveness = proc_does_not_affect_liveness, AffectsLivenessStrList = ["doesnt_affect_liveness"] ; AffectsLiveness = proc_default_affects_liveness, AffectsLivenessStrList = [] ), ( AllocatesMemory = proc_does_not_allocate_memory, AllocatesMemoryStrList =["doesnt_allocate_memory"] ; AllocatesMemory = proc_allocates_bounded_memory, AllocatesMemoryStrList = ["allocates_bounded_memory"] ; AllocatesMemory = proc_allocates_unbounded_memory, AllocatesMemoryStrList = ["allocates_unbounded_memory"] ; AllocatesMemory = proc_default_allocates_memory, AllocatesMemoryStrList = [] ), ( RegistersRoots = proc_registers_roots, RegistersRootsStrList = ["registers_roots"] ; RegistersRoots = proc_does_not_register_roots, RegistersRootsStrList =["doesnt_register_roots"] ; RegistersRoots = proc_does_not_have_roots, RegistersRootsStrList = ["doesnt_have_roots"] ; RegistersRoots = proc_default_registers_roots, RegistersRootsStrList = [] ), ( MaybeMayDuplicate = yes(MayDuplicate), ( MayDuplicate = proc_may_duplicate, MayDuplicateStrList = ["may_duplicate"] ; MayDuplicate = proc_may_not_duplicate, MayDuplicateStrList = ["may_not_duplicate"] ) ; MaybeMayDuplicate = no, MayDuplicateStrList = [] ), ( MaybeMayExportBody = yes(MayExportBody), ( MayExportBody = proc_may_export_body, MayExportBodyStrList = ["may_export_body"] ; MayExportBody = proc_may_not_export_body, MayExportBodyStrList = ["may_not_export_body"] ) ; MaybeMayExportBody = no, MayExportBodyStrList = [] ), StringList = [MayCallMercuryStr, ThreadSafeStr, TabledForIOStr | PurityStrList] ++ TerminatesStrList ++ UserSharingStrList ++ ExceptionsStrList ++ OrdinaryDespiteDetismStrList ++ MayModifyTrailStrList ++ MayCallMM_TabledStrList ++ BoxPolicyStrList ++ AffectsLivenessStrList ++ AllocatesMemoryStrList ++ RegistersRootsStrList ++ MayDuplicateStrList ++ MayExportBodyStrList ++ list.map(extra_attribute_to_string, ExtraAttributes). :- func user_annotated_sharing_to_string(prog_varset, structure_sharing_domain, maybe(user_sharing_type_information)) = string. user_annotated_sharing_to_string(VarSet, Sharing, MaybeTypes) = String :- ( Sharing = structure_sharing_bottom, String = "no_sharing" ; Sharing = structure_sharing_top(_), String = "unknown_sharing" ; Sharing = structure_sharing_real(SharingPairs), ( MaybeTypes = yes(user_type_info(Types, TypeVarSet)), TypeStrs = list.map( mercury_type_to_string(TypeVarSet, print_name_only), Types), TypeListStr = string.join_list(", ", TypeStrs), MaybeTypesStr = "yes(" ++ TypeListStr ++ ")" ; MaybeTypes = no, MaybeTypesStr = "no", TypeVarSet = varset.init ), SharingPairStrs = list.map(sharing_pair_to_string(VarSet, TypeVarSet), SharingPairs), SharingPairListStr = string.join_list(", ", SharingPairStrs), String = string.append_list( ["sharing(", MaybeTypesStr, ", [", SharingPairListStr, "])"]) ). :- func sharing_pair_to_string(prog_varset, tvarset, structure_sharing_pair) = string. sharing_pair_to_string(VarSet, TypeVarSet, DataA - DataB) = Str :- DataA = selected_cel(VarA, SelectorA), DataB = selected_cel(VarB, SelectorB), VarStrA = mercury_var_to_string_vs(VarSet, print_name_only, VarA), VarStrB = mercury_var_to_string_vs(VarSet, print_name_only, VarB), SelectorStrA = selector_to_string(TypeVarSet, SelectorA), SelectorStrB = selector_to_string(TypeVarSet, SelectorB), StrA = "cel(" ++ VarStrA ++ ", [" ++ SelectorStrA ++ "])", StrB = "cel(" ++ VarStrB ++ ", [" ++ SelectorStrB ++ "])", Str = StrA ++ " - " ++ StrB. :- func selector_to_string(tvarset, selector) = string. selector_to_string(TypeVarSet, Selector) = String :- UnitStrs = list.map(unit_selector_to_string(TypeVarSet), Selector), String = string.join_list(", ", UnitStrs). :- func unit_selector_to_string(tvarset, unit_selector) = string. unit_selector_to_string(TypeVarSet, UnitSelector) = String :- ( UnitSelector = typesel(Type), String = mercury_type_to_string(TypeVarSet, print_name_only, Type) ; UnitSelector = termsel(_, _), unexpected($pred, "termsel in user-annotated sharing") ). :- func extra_attribute_to_string(pragma_foreign_proc_extra_attribute) = string. extra_attribute_to_string(refers_to_llds_stack) = "refers_to_llds_stack". extra_attribute_to_string(backend(low_level_backend)) = "low_level_backend". extra_attribute_to_string(backend(high_level_backend)) = "high_level_backend". extra_attribute_to_string(needs_call_standard_output_registers) = "needs_call_standard_output_registers". %---------------------------------------------------------------------------% % % Output a foreign_proc_export pragma. % :- pred mercury_format_pragma_foreign_proc_export(output_lang::in, pragma_info_foreign_proc_export::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_foreign_proc_export(Lang, FPEInfo, S, !U) :- FPEInfo = pragma_info_foreign_proc_export(_Origin, ForeignLang, PredNameModesPF, ExportName, VarSet), PredNameModesPF = proc_pf_name_modes(PredOrFunc, SymName, Modes), add_string(":- pragma foreign_export(", S, !U), mercury_format_foreign_language_string(ForeignLang, S, !U), add_string(", ", S, !U), mercury_format_sym_name(SymName, S, !U), varset.coerce(VarSet, InstVarSet), ( PredOrFunc = pf_function, pred_args_to_func_args(Modes, ArgModes, RetMode), add_string("(", S, !U), mercury_format_mode_list(Lang, InstVarSet, ArgModes, S, !U), add_string(") = ", S, !U), mercury_format_mode(Lang, InstVarSet, RetMode, S, !U) ; PredOrFunc = pf_predicate, add_string("(", S, !U), mercury_format_mode_list(Lang, InstVarSet, Modes, S, !U), add_string(")", S, !U) ), add_string(", ", S, !U), add_string(ExportName, S, !U), add_string(").\n", S, !U). %---------------------------------------------------------------------------% % % Output an external_proc pragma. % :- pred mercury_format_pragma_external_proc(pragma_info_external_proc::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_external_proc(ExternalInfo, S, !U) :- ExternalInfo = pragma_info_external_proc(PFNameArity, MaybeBackend), PFNameArity = pred_pf_name_arity(PorF, PredName, user_arity(Arity)), PorFStr = pred_or_func_to_str(PorF), add_string(":- pragma external_", S, !U), add_string(PorFStr, S, !U), add_string("(", S, !U), mercury_format_sym_name(PredName, S, !U), add_string("/", S, !U), add_int(Arity, S, !U), ( MaybeBackend = no ; MaybeBackend = yes(Backend), add_string(", [", S, !U), add_string(backend_to_string(Backend), S, !U), add_string("]", S, !U) ), add_string(").\n", S, !U). :- func backend_to_string(backend) = string. backend_to_string(Backend) = Str :- ( Backend = low_level_backend, Str = "low_level_backend" ; Backend = high_level_backend, Str = "high_level_backend" ). %---------------------------------------------------------------------------% % % Output a type_spec pragma. % mercury_output_pragma_type_spec(Stream, Lang, TypeSpecInfo, !IO) :- TypeSpecInfo = pragma_info_type_spec(PFUMM, PredName, _SpecModuleName, TypeSubst, VarSet, _), io.write_string(Stream, ":- pragma type_spec(", !IO), ( ( PFUMM = pfumm_predicate(ModesOrArity), PredOrFunc = pf_predicate ; PFUMM = pfumm_function(ModesOrArity), PredOrFunc = pf_function ), ( ModesOrArity = moa_modes(Modes), PredNameModesPF = proc_pf_name_modes(PredOrFunc, PredName, Modes), PredStr = proc_pf_name_modes_to_string(Lang, PredNameModesPF), io.write_string(Stream, PredStr, !IO) ; ModesOrArity = moa_arity(Arity), mercury_format_pred_pf_name_arity(PredOrFunc, PredName, Arity, Stream, !IO) ) ; PFUMM = pfumm_unknown(PredArity), mercury_format_pred_name_arity(PredName, PredArity, Stream, !IO) ), io.write_string(Stream, ", ", !IO), % The code that parses type_spec pragmas ensures that all types variables % in the substitution are named. Therefore there is no reason to print % variable numbers. In fact, printing variable numbers would be a bug, % since any code reading the pragma we are now writing out would mistake % the variable number as part of the variable *name*. See the long comment % on the tspec_tvarset field of the pragma in prog_item.m. TypeSubst = one_or_more(HeadTypeSubst, TailTypeSubsts), ( TailTypeSubsts = [], % In the common case of there being only type substitution, % do not put unnecessary parentheses around it. mercury_output_type_subst(VarSet, print_name_only, HeadTypeSubst, Stream, !IO) ; TailTypeSubsts = [_ | _], io.write_string(Stream, "(", !IO), write_out_list(mercury_output_type_subst(VarSet, print_name_only), ", ", [HeadTypeSubst | TailTypeSubsts], Stream, !IO), io.write_string(Stream, ")", !IO) ), io.write_string(Stream, ").\n", !IO). :- pred mercury_output_type_subst(tvarset::in, var_name_print::in, pair(tvar, mer_type)::in, io.text_output_stream::in, io::di, io::uo) is det. mercury_output_type_subst(VarSet, VarNamePrint, Var - Type, Stream, !IO) :- mercury_output_var_vs(VarSet, VarNamePrint, Var, Stream, !IO), io.write_string(Stream, " = ", !IO), mercury_output_type(VarSet, VarNamePrint, Type, Stream, !IO). %---------------------------------------------------------------------------% % % Output an unused_args pragma. % mercury_output_pragma_unused_args(Stream, UnusedArgsInfo, !IO) :- UnusedArgsInfo = pragma_info_unused_args(PredNameArityPFMn, UnusedArgs), PredNameArityPFMn = proc_pf_name_arity_mn(PredOrFunc, SymName, user_arity(Arity), ModeNum), PorFStr = pred_or_func_to_full_str(PredOrFunc), SymNameStr = mercury_bracketed_sym_name_to_string(SymName), UnusedArgsStr = int_list_to_string(UnusedArgs), io.format(Stream, ":- pragma unused_args(%s, %s, %d, %d, [%s]", [s(PorFStr), s(SymNameStr), i(Arity), i(ModeNum), s(UnusedArgsStr)], !IO). %---------------------------------------------------------------------------% % % Output an exceptions pragma. % mercury_output_pragma_exceptions(Stream, ExceptionsInfo, !IO) :- ExceptionsInfo = pragma_info_exceptions(PredNameArityPFMn, ThrowStatus), PredNameArityPFMn = proc_pf_name_arity_mn(PredOrFunc, SymName, user_arity(Arity), ModeNum), PorFStr = pred_or_func_to_full_str(PredOrFunc), SymNameStr = mercury_bracketed_sym_name_to_string(SymName), ( ThrowStatus = will_not_throw, ThrowStr = "will_not_throw" ; ThrowStatus = may_throw(ExceptionType), ( ExceptionType = user_exception, ThrowStr = "may_throw(user_exception)" ; ExceptionType = type_exception, ThrowStr = "may_throw(type_exception)" ) ; ThrowStatus = throw_conditional, ThrowStr = "conditional" ), io.format(Stream, ":- pragma exceptions(%s, %s, %d, %d, %s).\n", [s(PorFStr), s(SymNameStr), i(Arity), i(ModeNum), s(ThrowStr)], !IO). %---------------------------------------------------------------------------% % % Output a trailing_info pragma. % mercury_output_pragma_trailing_info(Stream, TrailingInfo, !IO) :- TrailingInfo = pragma_info_trailing_info(PredNameArityPFMn, TrailingStatus), PredNameArityPFMn = proc_pf_name_arity_mn(PredOrFunc, SymName, user_arity(Arity), ModeNum), PorFStr = pred_or_func_to_full_str(PredOrFunc), SymNameStr = mercury_bracketed_sym_name_to_string(SymName), ( TrailingStatus = trail_may_modify, TrailStr = "may_modify_trail" ; TrailingStatus = trail_will_not_modify, TrailStr = "will_not_modify_trail" ; TrailingStatus = trail_conditional, TrailStr = "conditional" ), io.format(Stream, ":- pragma trailing_info(%s, %s, %d, %d, %s).\n", [s(PorFStr), s(SymNameStr), i(Arity), i(ModeNum), s(TrailStr)], !IO). %---------------------------------------------------------------------------% % % Output a mm_tabling_info pragma. % mercury_output_pragma_mm_tabling_info(Stream, TablingInfo, !IO) :- TablingInfo = pragma_info_mm_tabling_info(PredNameArityPFMn, MM_TablingStatus), PredNameArityPFMn = proc_pf_name_arity_mn(PredOrFunc, SymName, user_arity(Arity), ModeNum), PorFStr = pred_or_func_to_full_str(PredOrFunc), SymNameStr = mercury_bracketed_sym_name_to_string(SymName), ( MM_TablingStatus = mm_tabled_may_call, MMStr = "mm_tabled_may_call" ; MM_TablingStatus = mm_tabled_will_not_call, MMStr = "mm_tabled_will_not_call" ; MM_TablingStatus = mm_tabled_conditional, MMStr = "mm_tabled_conditional" ), io.format(Stream, ":- pragma mm_tabling_info(%s, %s, %d, %d, %s).\n", [s(PorFStr), s(SymNameStr), i(Arity), i(ModeNum), s(MMStr)], !IO). %---------------------------------------------------------------------------% % % Output an obsolete_pred or obsolete_proc pragma. % :- pred mercury_output_pragma_obsolete_pred(io.text_output_stream::in, pragma_info_obsolete_pred::in, io::di, io::uo) is det. mercury_output_pragma_obsolete_pred(Stream, ObsoletePredInfo, !IO) :- ObsoletePredInfo = pragma_info_obsolete_pred(PredSpec, ObsoleteInFavourOf), PredSpec = pred_pfu_name_arity(PFU, PredName, Arity), PredStr = mercury_pred_pfu_name_arity_to_string(PFU, PredName, Arity), ObsoleteStrs = list.map(wrapped_sym_name_arity_to_string, ObsoleteInFavourOf), ObsoleteStr = string.join_list(", ", ObsoleteStrs), io.format(Stream, ":- pragma obsolete(%s, [%s]).\n", [s(PredStr), s(ObsoleteStr)], !IO). :- pred mercury_output_pragma_obsolete_proc(io.text_output_stream::in, output_lang::in, pragma_info_obsolete_proc::in, io::di, io::uo) is det. mercury_output_pragma_obsolete_proc(Stream, Lang, ObsoleteProcInfo, !IO) :- ObsoleteProcInfo = pragma_info_obsolete_proc(PredNameModesPF, ObsoleteInFavourOf), PredStr = proc_pf_name_modes_to_string(Lang, PredNameModesPF), ObsoleteStrs = list.map(wrapped_sym_name_arity_to_string, ObsoleteInFavourOf), ObsoleteStr = string.join_list(", ", ObsoleteStrs), io.format(Stream, ":- pragma obsolete_proc(%s, [%s]).\n", [s(PredStr), s(ObsoleteStr)], !IO). :- func wrapped_sym_name_arity_to_string(sym_name_arity) = string. wrapped_sym_name_arity_to_string(SNA) = Str :- SNA = sym_name_arity(SymName, Arity), Str = mercury_bracketed_sym_name_to_string(SymName) ++ "/" ++ string.int_to_string(Arity). %---------------------------------------------------------------------------% % % Output a format_call pragma. % :- pred mercury_output_pragma_format_call(io.text_output_stream::in, pragma_info_format_call::in, io::di, io::uo) is det. mercury_output_pragma_format_call(Stream, FormatCallInfo, !IO) :- FormatCallInfo = pragma_info_format_call(PredSpec, OoMFormatArgsSpecs), PredSpec = pred_pf_name_arity(PF, PredName, Arity), PredStr = mercury_pred_pf_name_arity_to_string(PF, PredName, Arity), OoMFormatArgsSpecs = one_or_more(HeadFormatArgsSpec, TailFormatArgsSpecs), ( TailFormatArgsSpecs = [], SecondArgStr = format_string_values_to_string(HeadFormatArgsSpec) ; TailFormatArgsSpecs = [_ | _], ArgsSpecsStrs = list.map(format_string_values_to_string, [HeadFormatArgsSpec | TailFormatArgsSpecs]), ArgsSpecsStr = string.join_list(", ", ArgsSpecsStrs), string.format("[%s]", [s(ArgsSpecsStr)], SecondArgStr) ), io.format(Stream, ":- pragma format_call(%s, [%s]).\n", [s(PredStr), s(SecondArgStr)], !IO). :- func format_string_values_to_string(format_string_values) = string. format_string_values_to_string(FormatStringValues) = Str :- FormatStringValues = format_string_values(OrigFS, OrigVL, _CurFS, _CurVL), string.format("format_string_values(%d, %d)", [i(OrigFS), i(OrigVL)], Str). %---------------------------------------------------------------------------% % % Output a require tail recursion pragma. % :- pred mercury_output_pragma_require_tail_rec(io.text_output_stream::in, output_lang::in, pragma_info_require_tail_rec::in, io::di, io::uo) is det. mercury_output_pragma_require_tail_rec(Stream, Lang, RequireTR, !IO) :- RequireTR = pragma_info_require_tail_rec(PredOrProcSpec, Info), ProcSpecStr = pred_or_proc_pfumm_name_to_string(Lang, PredOrProcSpec), ( Info = suppress_tailrec_warnings(_), io.format(Stream, ":- pragma warn_tail_recursion(%s, [none]).\n", [s(ProcSpecStr)], !IO) ; Info = enable_tailrec_warnings(WarnOrError, Type, _), warning_or_error_string(WarnOrError, WarnOrErrorStr), require_tailrec_type_string(Type, TypeStr), io.format(Stream, ":- pragma warn_tail_recursion(%s, [%s, %s]).\n", [s(ProcSpecStr), s(WarnOrErrorStr), s(TypeStr)], !IO) ). :- func pred_or_proc_pfumm_name_to_string(output_lang, pred_or_proc_pfumm_name) = string. pred_or_proc_pfumm_name_to_string(Lang, PredOrProcSpec) = PredOrProcSpecStr :- PredOrProcSpec = pred_or_proc_pfumm_name(PFUMM, PredName), ( PFUMM = pfumm_unknown(PredArity), PredOrProcSpecStr = mercury_pred_name_arity_to_string(PredName, PredArity) ; ( PFUMM = pfumm_predicate(ModesOrArity), PredOrFunc = pf_predicate ; PFUMM = pfumm_function(ModesOrArity), PredOrFunc = pf_function ), ( ModesOrArity = moa_arity(Arity), PredOrProcSpecStr = mercury_pred_pf_name_arity_to_string( PredOrFunc, PredName, Arity) ; ModesOrArity = moa_modes(Modes), MaybeDet = maybe.no, % XXX ARITY Compare to the corresponding code in % mercury_format_pragma_foreign_proc_export. varset.init(InstVarSet), % The varset isn't really used. ( PredOrFunc = pf_predicate, PredOrProcSpecStr = mercury_pred_mode_subdecl_to_string(Lang, InstVarSet, PredName, Modes, MaybeDet) ; PredOrFunc = pf_function, pred_args_to_func_args(Modes, ArgModes, RetMode), PredOrProcSpecStr = mercury_func_mode_subdecl_to_string(Lang, InstVarSet, PredName, ArgModes, RetMode, MaybeDet) ) ) ). %---------------------------------------------------------------------------% % % Output a tabled pragma. % :- pred mercury_output_pragma_tabled(io.text_output_stream::in, pragma_info_tabled::in, io::di, io::uo) is det. mercury_output_pragma_tabled(Stream, TabledInfo, !IO) :- TabledInfo = pragma_info_tabled(TabledMethod, PredOrProcSpec, MaybeAttributes), PragmaName = tabled_eval_method_to_pragma_name(TabledMethod), ( MaybeAttributes = yes(Attributes), Attributes = table_attributes(Strictness, MaybeSizeLimit, Stats, AllowReset, WarnForIgnore), some [!Strs] ( !:Strs = [], ( Strictness = cts_all_strict ; Strictness = cts_all_fast_loose, !:Strs = ["fast_loose" | !.Strs] ; Strictness = cts_specified(Args, HiddenArgMethod), ArgStrs = list.map(maybe_arg_tabling_method_to_string, Args), ArgsStr = string.join_list(", ", ArgStrs), ( HiddenArgMethod = table_hidden_arg_value, HiddenArgStr = "hidden_arg_value" ; HiddenArgMethod = table_hidden_arg_addr, HiddenArgStr = "hidden_arg_addr" ), SpecifiedStr = "specified([" ++ ArgsStr ++ "], " ++ HiddenArgStr ++ ")", !:Strs = [SpecifiedStr | !.Strs] ), ( MaybeSizeLimit = yes(SizeLimit), LimitStr = "limit(" ++ int_to_string(SizeLimit) ++ ")", !:Strs = [LimitStr | !.Strs] ; MaybeSizeLimit = no ), ( Stats = table_gather_statistics, !:Strs = ["statistics" | !.Strs] ; Stats = table_dont_gather_statistics ), ( AllowReset = table_allow_reset, !:Strs = ["allow_reset" | !.Strs] ; AllowReset = table_dont_allow_reset ), ( WarnForIgnore = table_attr_ignore_with_warning ; WarnForIgnore = table_attr_ignore_without_warning, !:Strs = ["disable_warning_if_ignored" | !.Strs] ), ( !.Strs = [], AfterStr = "" ; !.Strs = [_ | _], AfterStr = ", [" ++ string.join_list(", ", !.Strs) ++ "]" ) ) ; MaybeAttributes = no, AfterStr = "" ), mercury_format_pragma_decl_pred_or_proc_pfumm_name(PragmaName, PredOrProcSpec, AfterStr, Stream, !IO). %---------------------------------------------------------------------------% % % Output a fact_table pragma. % :- pred mercury_format_pragma_fact_table(pragma_info_fact_table::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_fact_table(FactTableInfo, S, !U) :- FactTableInfo = pragma_info_fact_table(PredSpec, FileName), add_string(":- pragma fact_table(", S, !U), PredSpec = pred_pfu_name_arity(PFU, PredName, UserArity), mercury_format_pred_pfu_name_arity(PFU, PredName, UserArity, S, !U), add_string(", ", S, !U), add_quoted_string(FileName, S, !U), add_string(").\n", S, !U). %---------------------------------------------------------------------------% % % Output an oisu (order independent state update) pragma. % :- pred mercury_output_pragma_oisu(io.text_output_stream::in, pragma_info_oisu::in, io::di, io::uo) is det. mercury_output_pragma_oisu(Stream, OISUInfo, !IO) :- mercury_format_pragma_oisu(OISUInfo, Stream, !IO). :- pred mercury_format_pragma_oisu(pragma_info_oisu::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_oisu(OISUInfo, S, !U) :- OISUInfo = pragma_info_oisu(TypeCtor, CreatorPreds, MutatorPreds, DestructorPreds), add_string(":- pragma oisu(", S, !U), TypeCtor = type_ctor(TypeName, TypeArity), mercury_format_bracketed_sym_name_ngt(next_to_graphic_token, TypeName, S, !U), add_string("/", S, !U), add_int(TypeArity, S, !U), add_string(",\n", S, !U), add_string("\tcreators([\n", S, !U), mercury_format_pred_pf_name_arity_list(CreatorPreds, S, !U), add_string("\t]),\n", S, !U), add_string("\tmutators([\n", S, !U), mercury_format_pred_pf_name_arity_list(MutatorPreds, S, !U), add_string("\t]),\n", S, !U), add_string("\tdestructors([\n", S, !U), mercury_format_pred_pf_name_arity_list(DestructorPreds, S, !U), add_string("\t])\n", S, !U), add_string(").\n", S, !U). :- pred mercury_format_pred_pf_name_arity_list(list(pred_pf_name_arity)::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pred_pf_name_arity_list([], _S, !U). mercury_format_pred_pf_name_arity_list([PredSpec | PredSpecs], S, !U) :- mercury_format_pred_pf_name_arity_list_lag(PredSpec, PredSpecs, S, !U). :- pred mercury_format_pred_pf_name_arity_list_lag(pred_pf_name_arity::in, list(pred_pf_name_arity)::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pred_pf_name_arity_list_lag(PredSpec, PredSpecs, S, !U) :- add_string("\t\t", S, !U), PredSpec = pred_pf_name_arity(PredOrFunc, PredName, UserArity), mercury_format_pred_pf_name_arity(PredOrFunc, PredName, UserArity, S, !U), ( PredSpecs = [], add_string("\n", S, !U) ; PredSpecs = [HeadPredSpec | TailPredSpecs], add_string(",\n", S, !U), mercury_format_pred_pf_name_arity_list_lag(HeadPredSpec, TailPredSpecs, S, !U) ). %---------------------------------------------------------------------------% % % Output a termination_info pragma. % write_pragma_termination_info(Stream, Lang, TermInfo, !IO) :- TermInfo = pragma_info_termination_info(PredNameModesPF, MaybeArgSize, MaybeTermination), PredStr = proc_pf_name_modes_to_string(Lang, PredNameModesPF), ArgSizeStr = maybe_arg_size_info_to_string(no, MaybeArgSize), TermStr = maybe_termination_info_to_string(no, MaybeTermination), io.format(Stream, ":- pragma termination_info(%s, %s, %s).\n", [s(PredStr), s(ArgSizeStr), s(TermStr)], !IO). maybe_arg_size_info_to_string(Verbose, MaybeArgSizeInfo) = Str :- ( MaybeArgSizeInfo = no, Str = "not_set" ; MaybeArgSizeInfo = yes(finite(Const, UsedArgs)), string.format("finite(%d, %s)", [i(Const), s(used_args_to_string(UsedArgs))], Str) ; MaybeArgSizeInfo = yes(infinite(ErrorInfo)), ( Verbose = no, Str = "infinite" ; Verbose = yes, string.format("infinite(%s)", [s(string.string(ErrorInfo))], Str) ) ). :- func used_args_to_string(list(bool)) = string. used_args_to_string(UsedArgs) = Str :- BoolStrs = list.map(bool_to_string, UsedArgs), string.format("[%s]", [s(string.join_list(", ", BoolStrs))], Str). :- func bool_to_string(bool) = string. bool_to_string(no) = "no". bool_to_string(yes) = "yes". maybe_termination_info_to_string(Verbose, MaybeTerminationInfo) = Str :- ( MaybeTerminationInfo = no, Str = "not_set" ; MaybeTerminationInfo = yes(cannot_loop(_)), Str = "cannot_loop" ; MaybeTerminationInfo = yes(can_loop(ErrorInfo)), ( Verbose = no, Str = "can_loop" ; Verbose = yes, string.format("can_loop(%s)", [s(string.string(ErrorInfo))], Str) ) ). %---------------------------------------------------------------------------% % % Output a termination2_info pragma. % write_pragma_termination2_info(Stream, Lang, Term2Info, !IO) :- Term2Info = pragma_info_termination2_info(PredNameModesPF, MaybeSuccess, MaybeFailure, MaybeTermination), PredStr = proc_pf_name_modes_to_string(Lang, PredNameModesPF), SuccessStr = maybe_pragma_constr_arg_size_info_to_string(MaybeSuccess), FailureStr = maybe_pragma_constr_arg_size_info_to_string(MaybeFailure), TermStr = maybe_pragma_termination_info_to_string(MaybeTermination), io.format(Stream, ":- pragma termination2_info(%s, %s, %s, %s).\n", [s(PredStr), s(SuccessStr), s(FailureStr), s(TermStr)], !IO). :- func maybe_pragma_constr_arg_size_info_to_string( maybe(pragma_constr_arg_size_info)) = string. maybe_pragma_constr_arg_size_info_to_string(no) = "not_set". maybe_pragma_constr_arg_size_info_to_string(yes(ArgSizeConstraints)) = Str :- ConstraintStrs = list.map(arg_size_constr_to_string, ArgSizeConstraints), ConstraintsStr = string.join_list(", ", ConstraintStrs), Str = string.format("constraints([%s])", [s(ConstraintsStr)]). :- func arg_size_constr_to_string(arg_size_constr) = string. arg_size_constr_to_string(Constraint) = Str :- ( Constraint = le(Terms, Constant), OpStr = "le" ; Constraint = eq(Terms, Constant), OpStr = "eq" ), TermStrs = list.map(arg_size_term_to_string, Terms), TermsStr = string.join_list(", ", TermStrs), Str = string.format("%s([%s], %s)", [s(OpStr), s(TermsStr), s(rat.to_rat_string(Constant))]). :- func arg_size_term_to_string(arg_size_term) = string. arg_size_term_to_string(arg_size_term(VarId, Coeff)) = string.format("term(%d, %s)", [i(VarId), s(rat.to_rat_string(Coeff))]). :- func maybe_pragma_termination_info_to_string(maybe(pragma_termination_info)) = string. maybe_pragma_termination_info_to_string(MaybeTermination) = Str :- ( MaybeTermination = no, Str = "not_set" ; MaybeTermination = yes(Termination), ( Termination = can_loop(_), Str = "can_loop" ; Termination = cannot_loop(_), Str = "cannot_loop" ) ). %---------------------------------------------------------------------------% % % Output a structure_sharing pragma. % write_pragma_structure_sharing_info(Stream, Lang, SharingInfo, !IO) :- SharingInfo = pragma_info_structure_sharing(PredNameModesPF, HeadVars, HeadVarTypes, VarSet, TVarSet, MaybeSharingAs), PredStr = proc_pf_name_modes_to_string(Lang, PredNameModesPF), io.format(Stream, ":- pragma structure_sharing(%s, ", [s(PredStr)], !IO), % write headvars and types: write_vars_and_types(Stream, VarSet, TVarSet, HeadVars, HeadVarTypes, !IO), % write structure sharing information. io.write_string(Stream, ", ", !IO), prog_ctgc.print_interface_structure_sharing_domain(Stream, vns_varset(VarSet), TVarSet, MaybeSharingAs, !IO), io.write_string(Stream, ").\n", !IO). %---------------------------------------------------------------------------% % % Output a structure_reuse pragma. % write_pragma_structure_reuse_info(Stream, Lang, ReuseInfo, !IO) :- ReuseInfo = pragma_info_structure_reuse(PredNameModesPF, HeadVars, HeadVarTypes, VarSet, TVarSet, MaybeStructureReuseDomain), PredStr = proc_pf_name_modes_to_string(Lang, PredNameModesPF), io.format(Stream, ":- pragma structure_reuse(%s, ", [s(PredStr)], !IO), % write headvars and types: write_vars_and_types(Stream, VarSet, TVarSet, HeadVars, HeadVarTypes, !IO), % write structure reuse information. io.write_string(Stream, ", ", !IO), prog_ctgc.print_interface_maybe_structure_reuse_domain(Stream, vns_varset(VarSet), TVarSet, MaybeStructureReuseDomain, !IO), io.write_string(Stream, ").\n", !IO). %---------------------------------------------------------------------------% % % Predicates used to help print both structure_sharing and structure_reuse % pragmas. % :- pred write_vars_and_types(io.text_output_stream::in, prog_varset::in, tvarset::in, prog_vars::in, list(mer_type)::in, io::di, io::uo) is det. write_vars_and_types(Stream, VarSet, TypeVarSet, HeadVars, HeadVarTypes, !IO) :- ( HeadVars = [], io.write_string(Stream, "vars, types", !IO) ; HeadVars = [_ | _], io.write_string(Stream, "vars(", !IO), mercury_output_vars_vs(VarSet, print_name_only, HeadVars, Stream, !IO), io.write_string(Stream, "), ", !IO), io.write_string(Stream, "types(", !IO), write_out_list(mercury_output_type(TypeVarSet, print_name_only), ", ", HeadVarTypes, Stream, !IO), io.write_string(Stream, ")", !IO) ). %---------------------------------------------------------------------------% % % Output a require_feature_set pragma. % :- pred mercury_format_pragma_require_feature_set( pragma_info_require_feature_set::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pragma_require_feature_set(RFSInfo, S, !U) :- RFSInfo = pragma_info_require_feature_set(Features0), Features = set.to_sorted_list(Features0), add_string(":- pragma require_feature_set(", S, !U), add_list(mercury_format_required_feature, ", ", Features, S, !U), add_string(").\n", S, !U). :- pred mercury_format_required_feature(required_feature::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_required_feature(Feature, S, !U) :- ( Feature = reqf_concurrency, Str = "concurrency" ; Feature = reqf_single_prec_float, Str = "single_prec_float" ; Feature = reqf_double_prec_float, Str = "double_prec_float" ; Feature = reqf_memo, Str = "memo" ; Feature = reqf_parallel_conj, Str = "parallel_conj" ; Feature = reqf_trailing, Str = "trailing" ; Feature = reqf_strict_sequential, Str = "strict_sequential" ; Feature = reqf_conservative_gc, Str = "conservative_gc" ), add_string(Str, S, !U). %---------------------------------------------------------------------------% % % Utility predicates. % :- func mercury_pred_name_arity_to_string(sym_name, user_arity) = string. mercury_pred_name_arity_to_string(PredName, UserArity) = String :- mercury_format_pred_name_arity(PredName, UserArity, unit, "", String). :- pred mercury_format_pred_name_arity(sym_name::in, user_arity::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pred_name_arity(PredName, user_arity(Arity), S, !U) :- NGT = next_to_graphic_token, mercury_format_bracketed_sym_name_ngt(NGT, PredName, S, !U), add_string("/", S, !U), add_int(Arity, S, !U). :- func mercury_pred_pf_name_arity_to_string(pred_or_func, sym_name, user_arity) = string. mercury_pred_pf_name_arity_to_string(PredOrFunc, PredName, Arity) = String :- mercury_format_pred_pf_name_arity(PredOrFunc, PredName, Arity, unit, "", String). :- pred mercury_format_pred_pf_name_arity(pred_or_func::in, sym_name::in, user_arity::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pred_pf_name_arity(PredOrFunc, PredName, UserArity, S, !U) :- add_string(pred_or_func_to_str(PredOrFunc), S, !U), add_string("(", S, !U), mercury_format_pred_name_arity(PredName, UserArity, S, !U), add_string(")", S, !U). :- func mercury_pred_pfu_name_arity_to_string(pred_func_or_unknown, sym_name, user_arity) = string. mercury_pred_pfu_name_arity_to_string(PFU, PredName, UserArity) = String :- mercury_format_pred_pfu_name_arity(PFU, PredName, UserArity, unit, "", String). :- pred mercury_format_pred_pfu_name_arity(pred_func_or_unknown::in, sym_name::in, user_arity::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_pred_pfu_name_arity(PFU, PredName, UserArity, S, !U) :- ( ( PFU = pfu_predicate, PredOrFunc = pf_predicate ; PFU = pfu_function, PredOrFunc = pf_function ), mercury_format_pred_pf_name_arity(PredOrFunc, PredName, UserArity, S, !U) ; PFU = pfu_unknown, mercury_format_pred_name_arity(PredName, UserArity, S, !U) ). %---------------------% :- func proc_pf_name_modes_to_string(output_lang, proc_pf_name_modes) = string. proc_pf_name_modes_to_string(Lang, PredNameModesPF) = Str :- PredNameModesPF = proc_pf_name_modes(PredOrFunc, SymName, Modes), varset.init(InstVarSet), MaybeDet = no, ( PredOrFunc = pf_predicate, Str = mercury_pred_mode_subdecl_to_string(Lang, InstVarSet, SymName, Modes, MaybeDet) ; PredOrFunc = pf_function, pred_args_to_func_args(Modes, FuncArgModes, ReturnArgMode), Str = mercury_func_mode_subdecl_to_string(Lang, InstVarSet, SymName, FuncArgModes, ReturnArgMode, MaybeDet) ). %---------------------------------------------------------------------------% :- func int_list_to_string(list(int)) = string. int_list_to_string(Ints) = Str :- mercury_format_int_list(Ints, unit, "", Str). :- pred mercury_format_int_list(list(int)::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_int_list([], _S, !U). mercury_format_int_list([Head | Tail], S, !U) :- add_int(Head, S, !U), mercury_format_int_list_2(Tail, S, !U). :- pred mercury_format_int_list_2(list(int)::in, S::in, U::di, U::uo) is det <= output(S, U). mercury_format_int_list_2([], _S, !U). mercury_format_int_list_2([Head | Tail], S, !U) :- add_string(", ", S, !U), add_int(Head, S, !U), mercury_format_int_list_2(Tail, S, !U). %---------------------------------------------------------------------------% :- end_module parse_tree.parse_tree_out_pragma. %---------------------------------------------------------------------------%