%-----------------------------------------------------------------------------% % Copyright (C) 1993-2004 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. %-----------------------------------------------------------------------------% :- module parse_tree__prog_out. % Main author: fjh. % This module defines some predicates which output various parts % of the parse tree created by prog_io. % WARNING - this module is mostly junk at the moment! % Only the first hundred lines or so are meaningful. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- interface. :- import_module parse_tree__prog_data. :- import_module bool, list, io. :- pred maybe_report_stats(bool::in, io::di, io::uo) is det. :- pred maybe_write_string(bool::in, string::in, io::di, io::uo) is det. :- pred maybe_flush_output(bool::in, io::di, io::uo) is det. :- pred report_error(string::in, io::di, io::uo) is det. :- pred report_error(io__output_stream::in, string::in, io::di, io::uo) is det. :- pred prog_out__write_messages(message_list, io__state, io__state). :- mode prog_out__write_messages(in, di, uo) is det. :- pred prog_out__write_context(prog_context, io__state, io__state). :- mode prog_out__write_context(in, di, uo) is det. :- pred prog_out__context_to_string(prog_context, string). :- mode prog_out__context_to_string(in, out) is det. % Write out a symbol name, with special characters escaped, % but without any quotes. This is suitable for use in % error messages, where the caller should print out an % enclosing forward/backward-quote pair (`...'). :- pred prog_out__write_sym_name(sym_name, io__state, io__state). :- mode prog_out__write_sym_name(in, di, uo) is det. :- pred prog_out__write_sym_name_and_arity(sym_name_and_arity, io__state, io__state). :- mode prog_out__write_sym_name_and_arity(in, di, uo) is det. % Write out a symbol name, enclosed in single forward quotes ('...') % if necessary, and with any special characters escaped. % The output should be a syntactically valid Mercury term. :- pred prog_out__write_quoted_sym_name(sym_name, io__state, io__state). :- mode prog_out__write_quoted_sym_name(in, di, uo) is det. % sym_name_to_string(SymName, String): % convert a symbol name to a string, % with module qualifiers separated by % the standard Mercury module qualifier operator. :- pred prog_out__sym_name_to_string(sym_name, string). :- mode prog_out__sym_name_to_string(in, out) is det. :- func prog_out__sym_name_to_string(sym_name) = string. % sym_name_to_string(SymName, String): % convert a symbol name and arity to a "/" string, % with module qualifiers separated by % the standard Mercury module qualifier operator. :- pred prog_out__sym_name_and_arity_to_string(sym_name_and_arity, string). :- mode prog_out__sym_name_and_arity_to_string(in, out) is det. :- func prog_out__sym_name_and_arity_to_string(sym_name_and_arity) = string. % sym_name_to_string(SymName, Separator, String): % convert a symbol name to a string, % with module qualifiers separated by Separator. :- pred prog_out__sym_name_to_string(sym_name, string, string). :- mode prog_out__sym_name_to_string(in, in, out) is det. :- func prog_out__sym_name_to_string(sym_name, string) = string. :- pred prog_out__write_module_spec(module_specifier, io__state, io__state). :- mode prog_out__write_module_spec(in, di, uo) is det. :- pred prog_out__write_module_list(list(module_name), io__state, io__state). :- mode prog_out__write_module_list(in, di, uo) is det. :- pred prog_out__write_list(list(T), pred(T, io__state, io__state), io__state, io__state). :- mode prog_out__write_list(in, pred(in, di, uo) is det, di, uo) is det. :- pred prog_out__write_promise_type(promise_type, io__state, io__state). :- mode prog_out__write_promise_type(in, di, uo) is det. :- func prog_out__promise_to_string(promise_type) = string. :- mode prog_out__promise_to_string(in) = out is det. :- mode prog_out__promise_to_string(out) = in is semidet. :- mode prog_out__promise_to_string(out) = out is multi. % Print "predicate" or "function" depending on the given value. :- pred write_pred_or_func(pred_or_func::in, io::di, io::uo) is det. % Return "predicate" or "function" depending on the given value. :- func pred_or_func_to_full_str(pred_or_func) = string. % Return "pred" or "func" depending on the given value. :- func pred_or_func_to_str(pred_or_func) = string. % Print out a purity name. :- pred write_purity(purity::in, io::di, io::uo) is det. % Get a purity name as a string. :- pred purity_name(purity, string). :- mode purity_name(in, out) is det. :- mode purity_name(out, in) is semidet. % Print out a purity prefix. % This works under the assumptions that all purity names but `pure' % are operators, and that we never need `pure' indicators/declarations. :- pred write_purity_prefix(purity::in, io::di, io::uo) is det. :- func purity_prefix_to_string(purity) = string. % Convert an evaluation method to a string. :- func eval_method_to_string(eval_method) = string. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module term, varset, term_io. :- import_module require, string, std_util, term, term_io, varset, int. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% maybe_report_stats(yes) --> io__report_stats. maybe_report_stats(no) --> []. maybe_write_string(yes, String) --> io__write_string(String). maybe_write_string(no, _) --> []. maybe_flush_output(yes) --> io__flush_output. maybe_flush_output(no) --> []. report_error(ErrorMessage) --> io__write_string("Error: "), io__write_string(ErrorMessage), io__write_string("\n"), io__set_exit_status(1). report_error(Stream, ErrorMessage) --> io__set_output_stream(Stream, OldStream), report_error(ErrorMessage), io__set_output_stream(OldStream, _). % write out the list of error/warning messages which is % returned when a module is parsed. prog_out__write_messages([]) --> []. prog_out__write_messages([Message | Messages]) --> prog_out__write_message(Message), prog_out__write_messages(Messages). :- pred prog_out__write_message(pair(string, term), io__state, io__state). :- mode prog_out__write_message(in, di, uo) is det. prog_out__write_message(Msg - Term) --> ( { Term = term__functor(_Functor, _Args, Context0) } -> { Context0 = term__context(File, Line) }, { Context = term__context(File, Line) }, prog_out__write_context(Context) ; [] ), io__write_string(Msg), ( { Term = term__functor(term__atom(""), [], _Context2) } -> io__write_string(".\n") ; io__write_string(": "), { varset__init(VarSet) }, % XXX variable names in error messages term_io__write_term_nl(VarSet, Term) ). %-----------------------------------------------------------------------------% % Write out the information in term context (at the moment, just % the line number) in a form suitable for the beginning of an % error message. prog_out__write_context(Context) --> { prog_out__context_to_string(Context, ContextMessage) }, io__write_string(ContextMessage). %-----------------------------------------------------------------------------% % Write to a string the information in term context (at the moment, % just the line number) in a form suitable for the beginning of an % error message. prog_out__context_to_string(Context, ContextMessage) :- term__context_file(Context, FileName), term__context_line(Context, LineNumber), ( FileName = "" -> ContextMessage = "" ; string__format("%s:%03d: ", [s(FileName), i(LineNumber)], ContextMessage) ). %-----------------------------------------------------------------------------% % write out a (possibly qualified) symbol name prog_out__write_sym_name(qualified(ModuleSpec,Name)) --> prog_out__write_module_spec(ModuleSpec), io__write_string("."), term_io__write_escaped_string(Name). prog_out__write_sym_name(unqualified(Name)) --> term_io__write_escaped_string(Name). prog_out__write_sym_name_and_arity(Name / Arity) --> prog_out__write_sym_name(Name), io__write_string("/"), io__write_int(Arity). prog_out__write_quoted_sym_name(SymName) --> io__write_string("'"), prog_out__write_sym_name(SymName), io__write_string("'"). prog_out__sym_name_to_string(SymName, String) :- prog_out__sym_name_to_string(SymName, ".", String). prog_out__sym_name_to_string(SymName) = String :- prog_out__sym_name_to_string(SymName, String). prog_out__sym_name_to_string(SymName, Separator, String) :- prog_out__sym_name_to_string_2(SymName, Separator, Parts, []), string__append_list(Parts, String). prog_out__sym_name_to_string(SymName, Separator) = String :- prog_out__sym_name_to_string(SymName, Separator, String). :- pred prog_out__sym_name_to_string_2(sym_name::in, string::in, list(string)::out, list(string)::in) is det. prog_out__sym_name_to_string_2(qualified(ModuleSpec,Name), Separator) --> prog_out__sym_name_to_string_2(ModuleSpec, Separator), [Separator, Name]. prog_out__sym_name_to_string_2(unqualified(Name), _) --> [Name]. prog_out__sym_name_and_arity_to_string(SymName/Arity, String) :- prog_out__sym_name_to_string(SymName, SymNameString), string__int_to_string(Arity, ArityString), string__append_list([SymNameString, "/", ArityString], String). prog_out__sym_name_and_arity_to_string(SymName/Arity) = String :- prog_out__sym_name_and_arity_to_string(SymName/Arity, String). % write out a module specifier prog_out__write_module_spec(ModuleSpec) --> prog_out__write_sym_name(ModuleSpec). %-----------------------------------------------------------------------------% prog_out__write_module_list(Modules) --> prog_out__write_list(Modules, write_module). :- pred write_module(module_name::in, io__state::di, io__state::uo) is det. write_module(Module) --> io__write_string("`"), prog_out__write_sym_name(Module), io__write_string("'"). prog_out__write_list([Import1, Import2, Import3 | Imports], Writer) --> call(Writer, Import1), io__write_string(", "), prog_out__write_list([Import2, Import3 | Imports], Writer). prog_out__write_list([Import1, Import2], Writer) --> call(Writer, Import1), io__write_string(" and "), call(Writer, Import2). prog_out__write_list([Import], Writer) --> call(Writer, Import). prog_out__write_list([], _) --> { error("prog_out__write_module_list") }. prog_out__promise_to_string(true) = "promise". prog_out__promise_to_string(exclusive) = "promise_exclusive". prog_out__promise_to_string(exhaustive) = "promise_exhaustive". prog_out__promise_to_string(exclusive_exhaustive) = "promise_exclusive_exhaustive". prog_out__write_promise_type(PromiseType) --> io__write_string(prog_out__promise_to_string(PromiseType)). write_pred_or_func(PorF, !IO) :- io__write_string(pred_or_func_to_full_str(PorF), !IO). pred_or_func_to_full_str(predicate) = "predicate". pred_or_func_to_full_str(function) = "function". pred_or_func_to_str(predicate) = "pred". pred_or_func_to_str(function) = "func". write_purity_prefix(Purity, !IO) :- ( Purity = pure -> true ; write_purity(Purity, !IO), io__write_string(" ", !IO) ). purity_prefix_to_string(Purity) = String :- ( Purity = pure -> String = "" ; purity_name(Purity, PurityName), String = string__append(PurityName, " ") ). write_purity(Purity, !IO) :- purity_name(Purity, String), io__write_string(String, !IO). purity_name(pure, "pure"). purity_name((semipure), "semipure"). purity_name((impure), "impure"). eval_method_to_string(eval_normal) = "normal". eval_method_to_string(eval_loop_check) = "loop_check". eval_method_to_string(eval_memo) = "memo". eval_method_to_string(eval_minimal) = "minimal_model". eval_method_to_string(eval_table_io(IsDecl, IsUnitize)) = Str :- ( IsDecl = table_io_decl, DeclStr = "decl, " ; IsDecl = table_io_proc, DeclStr = "proc, " ), ( IsUnitize = table_io_unitize, UnitizeStr = "unitize" ; IsUnitize = table_io_alone, UnitizeStr = "alone" ), Str = "table_io(" ++ DeclStr ++ UnitizeStr ++ ")". %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % THE REMAINDER OF THIS FILE IS JUNK THAT IS NOT USED. % It has been made obsolete by mercury_to_mercury.m. % However, the code below handles operator precedence better % than mercury_to_mercury.m. % % % Please note that this code is the property of % % the University of Melbourne and is Copyright 1985, 1986, 1987, 1988 by it. % % % % All rights are reserved. % % % % Author: Philip Dart, 1988 % % Based on a theme by Lawrence Byrd and Lee Naish. % % Fixed again by Lee Naish 9/88 % % % May bear some vague resemblance to some code written by Lawrence Byrd % % at Edinburgh a long time ago. % % prog_out__writeDCGClause(Head, Body, VarSet) --> % % prog_out__get_op_prec("-->", 1, Prec), % { Prec = 1199 }, % prog_out__qwrite(Prec, VarSet, Head), % io__write_string(" -->"), % prog_out__write_goal(Body, 1, ',', VarSet). % % :- type context ---> '(' ; (';') ; (then) ; (else) ; ','. % % :- pred prog_out__write_goal(goal, int, context, varset, io, io). % :- mode prog_out__write_goal(in, in, in, in, di, uo) is det. % % prog_out__write_goal(fail, I0, T, _VarSet) --> % prog_out__beforelit(T, I0), % io__write_string("fail"). % % prog_out__write_goal(true, I0, T, _VarSet) --> % prog_out__beforelit(T, I0), % io__write_string("true"). % % prog_out__write_goal(some(Vars,Goal), I0, T, VarSet) --> % prog_out__beforelit(T, I0), % io__write_string("some ["), % prog_out__write_var_list(Vars, VarSet), % io__write_string("] ("), % { I1 is I0 + 1 }, % prog_out__write_goal(Goal, I1, '(', VarSet), % io__write_string("\n"), % prog_out__indent(I0), % io__write_string(")"). % % prog_out__write_goal(all(Vars,Goal), I0, T, VarSet) --> % prog_out__beforelit(T, I0), % io__write_string("all ["), % prog_out__write_var_list(Vars, VarSet), % io__write_string("] ("), % { I1 is I0 + 1 }, % prog_out__write_goal(Goal, I1, '(', VarSet), % io__write_string("\n"), % prog_out__indent(I0), % io__write_string(")"). % % prog_out__write_goal((P, Q), I0, T, VarSet) --> % prog_out__write_goal(P, I0, T, VarSet), % io__write_string(","), % {if T = (',') then I = I0 else I is I0 + 1}, % prog_out__write_goal(Q, I, (','), VarSet). % % prog_out__write_goal(if_then_else(Vars,C,A,B), I, T, VarSet) --> % {if T = (then) then I1 is I + 1 else I1 = I}, % (if {T = (else)} then % [] % else % io__write_string("\n"), % prog_out__indent(I1) % ), % io__write_string(" if "), % prog_out__write_some_vars(VarSet, Vars), % prog_out__write_goal(C, I, '(', VarSet), % io__write_string(" then"), % prog_out__write_goal(A, I1, (then), VarSet), % io__write_string("\n"), % prog_out__indent(I1), % io__write_string("else"), % prog_out__write_goal(B, I1, (else), VarSet), % (if {T = (else)} then % [] % else % io__write_string("\n"), % prog_out__indent(I1), % io__write_string(")") % ). % % prog_out__write_goal(if_then(Vars,C,A), I, T, VarSet) --> % {if T = (then) then I1 is I + 1 else I1 = I}, % (if {T = (else)} then % [] % else % io__write_string("\n"), % prog_out__indent(I1) % ), % io__write_string(" if "), % prog_out__write_some_vars(VarSet, Vars), % prog_out__write_goal(C, I, '(', VarSet), % io__write_string(" then"), % prog_out__write_goal(A, I1, (then), VarSet), % (if {T = (else)} then % [] % else % io__write_string("\n"), % prog_out__indent(I1), % io__write_string(")") % ). % % prog_out__write_goal((P ; Q), I, T, VarSet) --> % (if {T = (;)} then % io__write_string("\t\n"), % prog_out__write_goal(P, I, (;), VarSet) % else % io__write_string("\n"), % prog_out__indent(I), % io__write_string("("), % prog_out__write_goal(P, I, '(', VarSet) % ), % io__write_string("\n"), % prog_out__indent(I), % io__write_string(";"), % prog_out__write_goal(Q, I, (;), VarSet), % (if {T = (;)} then % [] % else % io__write_string("\n"), % prog_out__indent(I), % io__write_string(")") % ). % % prog_out__write_goal(not(A), I, _, VarSet) --> % io__write_string("not("), % prog_out__write_goal(A, I, '(', VarSet), % io__write_string(")"). % % prog_out__write_goal(call(X), I, T, VarSet) --> % prog_out__beforelit(T, I), % % Pos 1 of (,) has lowest prec of constructs % % prog_out__get_op_prec(",", 1, Prec), % { Prec = 999 }, % prog_out__qwrite(Prec, VarSet, X). % % prog_out__write_var_list(_VarSet, Vars) --> % io__write_anything(Vars). % % prog_out__write_some_vars(_VarSet, Vars) --> % io__write_string("some "), % io__write_anything(Vars). % XXX % % :- pred prog_out__beforelit(context, int, io__state, io__state). % :- mode prog_out__beforelit(in, in, di, uo) is det. % % prog_out__beforelit('(', _) --> % io__write_string("\t"). % prog_out__beforelit((;), I) --> % io__write_string("\n"), % { I1 is I + 1 }, % prog_out__indent(I1), % io__write_string("\t"). % prog_out__beforelit((then), I) --> % io__write_string("\n"), % { I1 is I + 1 }, % prog_out__indent(I1). % prog_out__beforelit((else), I) --> % io__write_string("\n"), % { I1 is I + 1 }, % prog_out__indent(I1). % prog_out__beforelit(',', I) --> % io__write_string("\n"), % prog_out__indent(I). % % :- pred prog_out__indent(int, io__state, io__state). % :- mode prog_out__indent(int, di, uo) is det. % prog_out__indent(N) --> % (if {N > 0} then % io__write_string("\t"), % { N1 is N - 1 }, % prog_out__indent(N1) % else % [] % ). % % :- pred prog_out__qwrite(int, varset, term, io__state, io__state). % :- mode prog_out__qwrite(in, in, in, di, uo) is det. % % % XXX problems with precedence % % prog_out__qwrite(_Prec, VarSet, X) --> % term_io__write_term(VarSet, X). % % :- pred prog_out__get_op_prec(string, int, int, io__state, io__state). % :- mode prog_out__get_op_prec(in, in, out, di, uo) is det. % % prog_out__get_op_prec(Op, Pos, Prec) --> % term_io__current_ops(Ops), % { get_prec_and_type(Op, Ops, Prec1, Type), % prog_out__op_adj(Pos, Type, Adj), % Prec is Prec1 - Adj % }. % % get_prec_and_type(ThisOp, [Op|Ops], Prec, Type) :- % (if some [Prec1, Type1] % Op = op(Prec1, Type1, ThisOp) % then % Prec = Prec1, % Type = Type1 % else % get_prec_and_type(ThisOp, Ops, Prec, Type) % ). % % :- pred prog_out__op_adj(int, op_type, int). % :- mode prog_out__op_adj(in, in, out) is det. % % prog_out__op_adj(1, xfx, 1). % prog_out__op_adj(1, xfy, 1). % prog_out__op_adj(1, fxy, 1). % prog_out__op_adj(1, fxx, 1). % prog_out__op_adj(1, yfx, 0). % % prog_out__op_adj(1, yfy, 0). % prog_out__op_adj(1, fyx, 0). % prog_out__op_adj(1, fyy, 0). % prog_out__op_adj(2, xfx, 1). % prog_out__op_adj(2, xfy, 0). % prog_out__op_adj(2, fxy, 0). % prog_out__op_adj(2, fxx, 1). % prog_out__op_adj(2, yfx, 1). % % prog_out__op_adj(2, yfy, 0). % prog_out__op_adj(2, fyx, 1). % prog_out__op_adj(2, fyy, 0). % prog_out__op_adj(1, xf, 1). % prog_out__op_adj(1, fx, 1). % prog_out__op_adj(1, yf, 0). % prog_out__op_adj(1, fy, 0). % % ******************************/