%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 1994-2006, 2009, 2011-2012 The University of Melbourne. % Copyright (C) 2014-2023 The Mercury team. % This file is distributed under the terms specified in COPYING.LIB. %---------------------------------------------------------------------------% % % File: term_io.m. % Main author: fjh. % Stability: medium to high. % % This module provides predicates to write out terms that use the ground % representation defined in term.m. % % Predicates to read in such terms are available in mercury_term_parser.m. % %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- module term_io. :- interface. :- import_module char. :- import_module io. :- import_module ops. :- import_module stream. :- import_module term. :- import_module varset. %---------------------------------------------------------------------------% % Writes a term to the current output stream or to the specified output % stream. Uses the variable names specified by the varset. % Writes _N for all unnamed variables, with N starting at 0. % :- pred write_term(varset(T)::in, term(T)::in, io::di, io::uo) is det. :- pred write_term(io.text_output_stream::in, varset(T)::in, term(T)::in, io::di, io::uo) is det. % As above, except uses the given operator table instead of the % standard Mercury operators. % :- pred write_term_with_op_table(OpTable::in, varset(T)::in, term(T)::in, io::di, io::uo) is det <= op_table(OpTable). :- pred write_term_with_op_table(io.text_output_stream::in, OpTable::in, varset(T)::in, term(T)::in, io::di, io::uo) is det <= op_table(OpTable). % As above, except it appends a period and new-line. % :- pred write_term_nl(varset(T)::in, term(T)::in, io::di, io::uo) is det. :- pred write_term_nl(io.text_output_stream::in, varset(T)::in, term(T)::in, io::di, io::uo) is det. % As above, except it appends a period and new-line. % :- pred write_term_nl_with_op_table(OpTable::in, varset(T)::in, term(T)::in, io::di, io::uo) is det <= op_table(OpTable). :- pred write_term_nl_with_op_table(io.text_output_stream::in, OpTable::in, varset(T)::in, term(T)::in, io::di, io::uo) is det <= op_table(OpTable). %---------------------% % Writes a constant (integer, float, string, or atom) to % the current output stream, or to the specified output stream. % :- pred write_constant(const::in, io::di, io::uo) is det. :- pred write_constant(io.text_output_stream::in, const::in, io::di, io::uo) is det. % Like write_constant, but return the result in a string. % :- func format_constant(const) = string. %---------------------% % Writes a variable to the current output stream, or to the % specified output stream. % :- pred write_variable(var(T)::in, varset(T)::in, io::di, io::uo) is det. :- pred write_variable(io.text_output_stream::in, var(T)::in, varset(T)::in, io::di, io::uo) is det. % As above, except uses the given operator table instead of the % standard Mercury operators. % :- pred write_variable_with_op_table(OpTable::in, var(T)::in, varset(T)::in, io::di, io::uo) is det <= op_table(OpTable). :- pred write_variable_with_op_table(io.text_output_stream::in, OpTable::in, var(T)::in, varset(T)::in, io::di, io::uo) is det <= op_table(OpTable). %---------------------% % Given a character C, write C in single-quotes, escaped if necessary, % to the current output stream, or to the specified output stream. % :- pred quote_char(char::in, io::di, io::uo) is det. :- pred quote_char(Stream::in, char::in, State::di, State::uo) is det <= (stream.writer(Stream, string, State), stream.writer(Stream, char, State)). % Like quote_char, but return the result in a string. % :- func quoted_char(char) = string. % Given a character C, write C, escaped if necessary, % to the current output stream, or to the specified output stream. % Do not enclose the character in quotes. % :- pred write_escaped_char(char::in, io::di, io::uo) is det. :- pred write_escaped_char(Stream::in, char::in, State::di, State::uo) is det <= (stream.writer(Stream, string, State), stream.writer(Stream, char, State)). % Like write_escaped_char, but return the result in a string. % :- func escaped_char(char) = string. % A reversible version of escaped_char. % :- pred string_is_escaped_char(char, string). :- mode string_is_escaped_char(in, out) is det. :- mode string_is_escaped_char(out, in) is semidet. %---------------------% % Given a string S, write S in double-quotes, with characters % escaped if necessary, to the current output stream, or to the % specified output stream. % :- pred quote_string(string::in, io::di, io::uo) is det. :- pred quote_string(Stream::in, string::in, State::di, State::uo) is det <= (stream.writer(Stream, string, State), stream.writer(Stream, char, State)). % Like quote_string, but return the result in a string. % :- func quoted_string(string) = string. % Given a string S, write S, with characters escaped if necessary. % Do not enclose the string in quotes. Write to the current output stream, % or to the specified output stream. % :- pred write_escaped_string(string::in, io::di, io::uo) is det. :- pred write_escaped_string(Stream::in, string::in, State::di, State::uo) is det <= (stream.writer(Stream, string, State), stream.writer(Stream, char, State)). % Like write_escaped_string, but return the result in a string. % :- func escaped_string(string) = string. %---------------------% % Given an atom-name A, write A, enclosed in single-quotes if necessary, % with characters escaped if necessary. Write to the current output stream, % or to the specified output stream. % :- pred quote_atom(string::in, io::di, io::uo) is det. :- pred quote_atom(Stream::in, string::in, State::di, State::uo) is det <= (stream.writer(Stream, string, State), stream.writer(Stream, char, State)). % Like quote_atom, but return the result in a string. % :- func quoted_atom(string) = string. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. % Everything below here is not intended to be part of the public interface, % and will not be included in the Mercury library reference manual. %---------------------------------------------------------------------------% :- interface. %---------------------------------------------------------------------------% % for use by io.m. :- type adjacent_to_graphic_token ---> maybe_adjacent_to_graphic_token ; not_adjacent_to_graphic_token. :- pred quote_atom_agt(string::in, adjacent_to_graphic_token::in, io::di, io::uo) is det. :- pred quote_atom_agt(Stream::in, string::in, adjacent_to_graphic_token::in, State::di, State::uo) is det <= (stream.writer(Stream, string, State), stream.writer(Stream, char, State)). :- func quoted_atom_agt(string, adjacent_to_graphic_token) = string. :- pragma type_spec(pred(term_io.quote_string/4), (Stream = io.text_output_stream, State = io.state)). :- pragma type_spec(pred(term_io.quote_atom/4), (Stream = io.text_output_stream, State = io.state)). :- pragma type_spec(pred(term_io.write_escaped_string/4), (Stream = io.text_output_stream, State = io.state)). :- pragma type_spec(pred(term_io.write_escaped_char/4), (Stream = io.text_output_stream, State = io.state)). :- pragma type_spec(pred(term_io.quote_char/4), (Stream = io.text_output_stream, State = io.state)). :- pragma type_spec(pred(term_io.quote_atom_agt/5), (Stream = io.text_output_stream, State = io.state)). %---------------------------------------------------------------------------% % Convert `integer_base' constant to its numeric value. % :- func integer_base_int(integer_base) = int. % Return the prefix for integer literals of the given base. % :- func integer_base_prefix(integer_base) = string. % Convert a character to the corresponding octal escape code. % % We use ISO-Prolog style octal escapes, which are of the form '\nnn\'; % note that unlike C octal escapes, they are terminated with a backslash. % % XXX Using this predicate in the compiler may cause problems interfacing % with versions of the compiler that have been built in grades which use % different character representations. % :- func mercury_escape_char(char) = string. % Succeed if the given character is a Mercury punctuation character. % :- pred is_mercury_punctuation_char(char::in) is semidet. % encode_escaped_char(Char, Str): % % Succeed in one of two cases: % % - Char is 'x', and Str is "x", where x is a valid Mercury source % character, or % - Char is '\x' and Str is "\x", where '\x' is a valid character % escape sequence. % :- pred encode_escaped_char(char, string). :- mode encode_escaped_char(in, out) is semidet. :- mode encode_escaped_char(out, in) is semidet. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module bool. :- import_module int. :- import_module integer. :- import_module list. :- import_module mercury_term_lexer. :- import_module string. :- import_module stream.string_writer. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% write_term(VarSet, Term, !IO) :- io.output_stream(OutStream, !IO), write_term(OutStream, VarSet, Term, !IO). write_term(OutStream, VarSet, Term, !IO) :- OpTable = init_mercury_op_table, write_term_with_op_table(OutStream, OpTable, VarSet, Term, !IO). write_term_with_op_table(OpTable, VarSet, Term, !IO) :- io.output_stream(OutStream, !IO), write_term_with_op_table(OutStream, OpTable, VarSet, Term, !IO). write_term_with_op_table(OutStream, OpTable, VarSet, Term, !IO) :- write_term_anon_vars(OutStream, OpTable, Term, VarSet, _, 0, _, !IO). %---------------------% write_term_nl(VarSet, Term, !IO) :- io.output_stream(OutStream, !IO), write_term_nl(OutStream, VarSet, Term, !IO). write_term_nl(OutStream, VarSet, Term, !IO) :- OpTable = init_mercury_op_table, write_term_nl_with_op_table(OutStream, OpTable, VarSet, Term, !IO). write_term_nl_with_op_table(OpTable, VarSet, Term, !IO) :- io.output_stream(OutStream, !IO), write_term_nl_with_op_table(OutStream, OpTable, VarSet, Term, !IO). write_term_nl_with_op_table(OutStream, OpTable, VarSet, Term, !IO) :- write_term_with_op_table(OutStream, OpTable, VarSet, Term, !IO), io.write_string(OutStream, ".\n", !IO). %---------------------------------------------------------------------------% :- pred write_term_anon_vars(io.text_output_stream::in, OpTable::in, term(T)::in, varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det <= op_table(OpTable). write_term_anon_vars(OutStream, OpTable, Term, !VarSet, !N, !IO) :- write_term_prio_anon_vars(OutStream, OpTable, Term, ops.universal_priority(OpTable), !VarSet, !N, !IO). :- pred write_term_prio_anon_vars(io.text_output_stream::in, OpTable::in, term(T)::in, ops.priority::in, varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det <= op_table(OpTable). write_term_prio_anon_vars(OutStream, OpTable, Term, Priority, !VarSet, !N, !IO) :- ( Term = term.variable(Var, _), write_variable_anon_vars(OutStream, OpTable, Var, !VarSet, !N, !IO) ; Term = term.functor(Functor, Args, _), ( if Functor = term.atom("[|]"), Args = [ListHead, ListTail] then io.write_char(OutStream, '[', !IO), write_term_arg(OutStream, OpTable, ListHead, !VarSet, !N, !IO), write_later_list_elements(OutStream, OpTable, ListTail, !VarSet, !N, !IO), io.write_char(OutStream, ']', !IO) else if Functor = term.atom("[]"), Args = [] then io.write_string(OutStream, "[]", !IO) else if Functor = term.atom("{}"), Args = [BracedTerm] then io.write_string(OutStream, "{ ", !IO), write_term_anon_vars(OutStream, OpTable, BracedTerm, !VarSet, !N, !IO), io.write_string(OutStream, " }", !IO) else if Functor = term.atom("{}"), Args = [BracedHead | BracedTail] then io.write_char(OutStream, '{', !IO), write_term_arg(OutStream, OpTable, BracedHead, !VarSet, !N, !IO), write_term_later_args(OutStream, OpTable, BracedTail, !VarSet, !N, !IO), io.write_char(OutStream, '}', !IO) else if % The empty functor '' is used for higher-order syntax: % Var(Arg, ...) gets parsed as ''(Var, Arg). When writing it out, % we want to use the nice syntax. Functor = term.atom(""), Args = [term.variable(Var, _), FirstArg | OtherArgs] then write_variable_anon_vars(OutStream, OpTable, Var, !VarSet, !N, !IO), io.write_char(OutStream, '(', !IO), write_term_arg(OutStream, OpTable, FirstArg, !VarSet, !N, !IO), write_term_later_args(OutStream, OpTable, OtherArgs, !VarSet, !N, !IO), io.write_char(OutStream, ')', !IO) else if Args = [PrefixArg], Functor = term.atom(OpName), ops.lookup_prefix_op(OpTable, OpName, OpPriority, OpGtOrGe) then maybe_write_paren(OutStream, '(', Priority, OpPriority, !IO), write_constant(OutStream, Functor, !IO), io.write_char(OutStream, ' ', !IO), NewPriority = min_priority_for_arg(OpPriority, OpGtOrGe), write_term_prio_anon_vars(OutStream, OpTable, PrefixArg, NewPriority, !VarSet, !N, !IO), maybe_write_paren(OutStream, ')', Priority, OpPriority, !IO) else if Args = [PostfixArg], Functor = term.atom(OpName), ops.lookup_postfix_op(OpTable, OpName, OpPriority, OpGtOrGe) then maybe_write_paren(OutStream, '(', Priority, OpPriority, !IO), NewPriority = min_priority_for_arg(OpPriority, OpGtOrGe), write_term_prio_anon_vars(OutStream, OpTable, PostfixArg, NewPriority, !VarSet, !N, !IO), io.write_char(OutStream, ' ', !IO), write_constant(OutStream, Functor, !IO), maybe_write_paren(OutStream, ')', Priority, OpPriority, !IO) else if Args = [Arg1, Arg2], Functor = term.atom(OpName), ops.lookup_infix_op(OpTable, OpName, OpPriority, LeftGtOrGe, RightGtOrGe) then maybe_write_paren(OutStream, '(', Priority, OpPriority, !IO), LeftPriority = min_priority_for_arg(OpPriority, LeftGtOrGe), write_term_prio_anon_vars(OutStream, OpTable, Arg1, LeftPriority, !VarSet, !N, !IO), ( if OpName = "," then io.write_string(OutStream, ", ", !IO) else if OpName = "." then % If the operator is '.'/2, then we must not put spaces % around it (or at the very least, we should not put spaces % afterwards) because that would make it appear as the % end-of-term token. However, we do have to quote it % if the right hand side can begin with a digit. ( if starts_with_digit(Arg2) then Dot = "'.'" else Dot = "." ), io.write_string(OutStream, Dot, !IO) else io.write_char(OutStream, ' ', !IO), write_constant(OutStream, Functor, !IO), io.write_char(OutStream, ' ', !IO) ), RightPriority = min_priority_for_arg(OpPriority, RightGtOrGe), write_term_prio_anon_vars(OutStream, OpTable, Arg2, RightPriority, !VarSet, !N, !IO), maybe_write_paren(OutStream, ')', Priority, OpPriority, !IO) else if Args = [Arg1, Arg2], Functor = term.atom(OpName), ops.lookup_binary_prefix_op(OpTable, OpName, OpPriority, FirstGtOrGe, SecondGtOrGe) then maybe_write_paren(OutStream, '(', Priority, OpPriority, !IO), write_constant(OutStream, Functor, !IO), io.write_char(OutStream, ' ', !IO), FirstPriority = min_priority_for_arg(OpPriority, FirstGtOrGe), write_term_prio_anon_vars(OutStream, OpTable, Arg1, FirstPriority, !VarSet, !N, !IO), io.write_char(OutStream, ' ', !IO), SecondPriority = min_priority_for_arg(OpPriority, SecondGtOrGe), write_term_prio_anon_vars(OutStream, OpTable, Arg2, SecondPriority, !VarSet, !N, !IO), maybe_write_paren(OutStream, ')', Priority, OpPriority, !IO) else ( if Args = [], Functor = term.atom(Op), ops.is_op(OpTable, Op), priority_ge(Priority, ops.loosest_op_priority(OpTable)) then io.write_char(OutStream, '(', !IO), write_constant(OutStream, Functor, !IO), io.write_char(OutStream, ')', !IO) else write_constant(OutStream, Functor, maybe_adjacent_to_graphic_token, !IO) ), ( Args = [X | Xs], io.write_char(OutStream, '(', !IO), write_term_arg(OutStream, OpTable, X, !VarSet, !N, !IO), write_term_later_args(OutStream, OpTable, Xs, !VarSet, !N, !IO), io.write_char(OutStream, ')', !IO) ; Args = [] ) ) ). :- pred write_term_arg(io.text_output_stream::in, OpTable::in, term(T)::in, varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det <= op_table(OpTable). write_term_arg(OutStream, OpTable, Term, !VarSet, !N, !IO) :- write_term_prio_anon_vars(OutStream, OpTable, Term, ops.arg_priority(OpTable), !VarSet, !N, !IO). % Write the remaining arguments. % :- pred write_term_later_args(io.text_output_stream::in, OpTable::in, list(term(T))::in, varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det <= op_table(OpTable). write_term_later_args(_, _, [], !VarSet, !N, !IO). write_term_later_args(OutStream, OpTable, [X | Xs], !VarSet, !N, !IO) :- io.write_string(OutStream, ", ", !IO), write_term_arg(OutStream, OpTable, X, !VarSet, !N, !IO), write_term_later_args(OutStream, OpTable, Xs, !VarSet, !N, !IO). :- pred write_later_list_elements(io.text_output_stream::in, OpTable::in, term(T)::in, varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det <= op_table(OpTable). write_later_list_elements(OutStream, OpTable, Term, !VarSet, !N, !IO) :- ( if Term = term.variable(Var, _), varset.search_var(!.VarSet, Var, Value) then write_later_list_elements(OutStream, OpTable, Value, !VarSet, !N, !IO) else if Term = term.functor(term.atom("[|]"), [ListHead, ListTail], _) then io.write_string(OutStream, ", ", !IO), write_term_arg(OutStream, OpTable, ListHead, !VarSet, !N, !IO), write_later_list_elements(OutStream, OpTable, ListTail, !VarSet, !N, !IO) else if Term = term.functor(term.atom("[]"), [], _) then true else io.write_string(OutStream, " | ", !IO), write_term_anon_vars(OutStream, OpTable, Term, !VarSet, !N, !IO) ). % Succeeds iff outputting the given term would start with a digit. % (This is a safe, conservative approximation and is used to decide % whether or not to quote infix '.'/2.) % :- pred starts_with_digit(term(T)::in) is semidet. starts_with_digit(functor(integer(_, _, _, _), _, _)). starts_with_digit(functor(float(_), _, _)). starts_with_digit(functor(atom(Op), Args, _)) :- ( Args = [Arg, _], ops.lookup_infix_op(ops.init_mercury_op_table, Op, _, _, _) ; Args = [Arg], ops.lookup_postfix_op(ops.init_mercury_op_table, Op, _, _) ), starts_with_digit(Arg). %---------------------------------------------------------------------------% write_constant(Const, !IO) :- io.output_stream(OutStream, !IO), write_constant(OutStream, Const, !IO). write_constant(OutStream, Const, !IO) :- write_constant(OutStream, Const, not_adjacent_to_graphic_token, !IO). :- pred write_constant(io.text_output_stream::in, const::in, adjacent_to_graphic_token::in, io::di, io::uo) is det. write_constant(OutStream, Const, AdjacentToGraphicToken, !IO) :- ( Const = term.integer(Base, I, Signedness, Size), Prefix = integer_base_prefix(Base), IntString = integer.to_base_string(I, integer_base_int(Base)), Suffix = integer_signedness_and_size_suffix(Signedness, Size), io.write_string(OutStream, Prefix, !IO), io.write_string(OutStream, IntString, !IO), io.write_string(OutStream, Suffix, !IO) ; Const = term.float(F), io.write_float(OutStream, F, !IO) ; Const = term.atom(A), term_io.quote_atom_agt(OutStream, A, AdjacentToGraphicToken, !IO) ; Const = term.string(S), term_io.quote_string(OutStream, S, !IO) ; Const = term.implementation_defined(N), io.write_char(OutStream, '$', !IO), io.write_string(OutStream, N, !IO) ). format_constant(Const) = term_io.format_constant_agt(Const, not_adjacent_to_graphic_token). :- func format_constant_agt(const, adjacent_to_graphic_token) = string. format_constant_agt(Const, AdjacentToGraphicToken) = Str :- ( Const = term.integer(Base, I, Signedness, Size), Str = integer_base_prefix(Base) ++ to_base_string(I, integer_base_int(Base)) ++ integer_signedness_and_size_suffix(Signedness, Size) ; Const = term.float(F), Str = string.float_to_string(F) ; Const = term.atom(A), Str = term_io.quoted_atom_agt(A, AdjacentToGraphicToken) ; Const = term.string(S), Str = term_io.quoted_string(S) ; Const = term.implementation_defined(N), Str = "$" ++ N ). :- func integer_signedness_and_size_suffix(term.signedness, term.integer_size) = string. integer_signedness_and_size_suffix(signed, size_word) = "". integer_signedness_and_size_suffix(signed, size_8_bit) = "i8". integer_signedness_and_size_suffix(signed, size_16_bit) = "i16". integer_signedness_and_size_suffix(signed, size_32_bit) = "i32". integer_signedness_and_size_suffix(signed, size_64_bit) = "i64". integer_signedness_and_size_suffix(unsigned, size_word) = "u". integer_signedness_and_size_suffix(unsigned, size_8_bit) = "u8". integer_signedness_and_size_suffix(unsigned, size_16_bit) = "u16". integer_signedness_and_size_suffix(unsigned, size_32_bit) = "u32". integer_signedness_and_size_suffix(unsigned, size_64_bit) = "u64". %---------------------------------------------------------------------------% write_variable(Var, VarSet, !IO) :- io.output_stream(OutStream, !IO), write_variable(OutStream, Var, VarSet, !IO). write_variable(OutStream, Var, VarSet, !IO) :- OpTable = init_mercury_op_table, term_io.write_variable_with_op_table(OutStream, OpTable, Var, VarSet, !IO). write_variable_with_op_table(OpTable, Var, VarSet, !IO) :- io.output_stream(OutStream, !IO), write_variable_with_op_table(OutStream, OpTable, Var, VarSet, !IO). write_variable_with_op_table(OutStream, OpTable, Var, VarSet, !IO) :- write_variable_anon_vars(OutStream, OpTable, Var, VarSet, _, 0, _, !IO). % Write a variable. % % There are two ways we could choose to write unnamed variables. % % 1 Convert the variable to the integer that represents it and write % `_N' where N is that integer. This has the advantage that % such variables get printed in a canonical way, so rearranging terms % containing such variables will not effect the way they are numbered % (this includes breaking up a term and printing the pieces separately). % % 2 Number the unnamed variables from 0 and write `_N' where % N is the next number in the sequence of such variables. % This has the advantage that such variables can be visually scanned % rather more easily (for example in error messages). % % An ideal solution would be to provide both, and a flag to choose % between the two. At the moment we provide only the first, though % the infrastructure for the second is present in the code. % That infrastructure is the threading of the (as yet unused) % !N state variables through the code that writes terms. % :- pred write_variable_anon_vars(io.text_output_stream::in, OpTable::in, var(T)::in, varset(T)::in, varset(T)::out, int::in, int::out, io::di, io::uo) is det <= op_table(OpTable). write_variable_anon_vars(OutStream, OpTable, Var, !VarSet, !N, !IO) :- ( if varset.search_var(!.VarSet, Var, Value) then write_term_anon_vars(OutStream, OpTable, Value, !VarSet, !N, !IO) else if varset.search_name(!.VarSet, Var, Name) then io.write_string(OutStream, Name, !IO) else % XXX The names we generate here, with either approach, % *could* clash with the name of an explicit-named variable. % This code implements the first approach described above. term.var_to_int(Var, VarNum), % This code would implement the second approach described above. % VarNum = !.N, % !:N = !.N + 1, string.int_to_string(VarNum, VarNumStr), VarName = "_" ++ VarNumStr, % Recording the name we have given Var in !VarSet is needed % only with the second approach. The first would give the same % name to the same variable even without it, but since it would % allocate memory on *every* occurrence of the variable rather than % on just the first one, we record the name anyway. varset.name_var(Var, VarName, !VarSet), io.write_string(OutStream, VarName, !IO) ). %---------------------------------------------------------------------------% quote_char(C, !IO) :- io.output_stream(OutStream, !IO), io.write_string(OutStream, term_io.quoted_char(C), !IO). quote_char(Stream, C, !State) :- stream.put(Stream, term_io.quoted_char(C), !State). quoted_char(C) = string.format("'%s'", [s(term_io.escaped_char(C))]). write_escaped_char(Char, !IO) :- io.output_stream(Stream, !IO), term_io.write_escaped_char(Stream, Char, !IO). write_escaped_char(Stream, Char, !State) :- % Note: the code of add_escaped_char and write_escaped_char % should be kept in sync. The code of both is similar to code in % compiler/parse_tree_out_pragma.m and MR_escape_string_quote % in runtime/mercury_string.c; any changes here may require similar % changes in those spots. ( if mercury_escape_special_char(Char, QuoteChar) then stream.put(Stream, ('\\'), !State), stream.put(Stream, QuoteChar, !State) else if is_mercury_source_char(Char) then stream.put(Stream, Char, !State) else stream.put(Stream, mercury_escape_char(Char), !State) ). escaped_char(Char) = String :- string_is_escaped_char(Char, String). :- pragma promise_equivalent_clauses(pred(string_is_escaped_char/2)). string_is_escaped_char(Char::in, String::out) :- ( if mercury_escape_special_char(Char, QuoteChar) then String = string.append("\\", string.char_to_string(QuoteChar)) else if is_mercury_source_char(Char) then String = string.char_to_string(Char) else String = mercury_escape_char(Char) ). string_is_escaped_char(Char::out, String::in) :- % XXX ILSEQ Decide what to do with ill-formed sequences. string.to_char_list(String, Chars), ( Chars = [Char], ( is_mercury_source_char(Char) ; mercury_escape_special_char(Char, _QuoteChar) ) ; Chars = ['\\', QuoteChar], mercury_escape_special_char(Char, QuoteChar) ; Chars = ['\\', Char1, Char2, Char3], NumChars = [Char1, Char2, Char3], string.from_char_list(NumChars, NumString), string.base_string_to_int(8, NumString, Int), char.to_int(Char, Int) ). % Succeed if Char is a character which is allowed in Mercury string % and character literals. % % Note: the code here is similar to code in the following spots: % % - compiler/parse_tree_out_pragma.m. % - runtime/mercury_trace_base.c % % Any changes here may require similar changes there. % :- pred is_mercury_source_char(char::in) is semidet. is_mercury_source_char(Char) :- ( char.is_alnum(Char) ; is_mercury_punctuation_char(Char) ; char.to_int(Char) >= 0xA0 % 0x7f - 0x9f are control characters. ). %---------------------------------------------------------------------------% % Note: the code here is similar to code in compiler/parse_tree_out_pragma.m; % any changes here may require similar changes there. quote_string(S, !IO) :- io.output_stream(Stream, !IO), term_io.quote_string(Stream, S, !IO). quote_string(Stream, S, !State) :- stream.put(Stream, '"', !State), term_io.write_escaped_string(Stream, S, !State), stream.put(Stream, '"', !State). quoted_string(S) = string.append_list(["""", term_io.escaped_string(S), """"]). write_escaped_string(String, !IO) :- io.output_stream(Stream, !IO), term_io.write_escaped_string(Stream, String, !IO). write_escaped_string(Stream, String, !State) :- % XXX ILSEQ Decide what to do with ill-formed sequences. string.foldl(term_io.write_escaped_char(Stream), String, !State). escaped_string(String0) = String :- % XXX ILSEQ Decide what to do with ill-formed sequences. string.foldl(add_escaped_char, String0, [], RevStrings), list.reverse(RevStrings, Strings), string.append_list(Strings, String). :- pred add_escaped_char(char::in, list(string)::in, list(string)::out) is det. add_escaped_char(Char, RevStrings0, RevStrings) :- % Note: the code of add_escaped_char and write_escaped_char % should be kept in sync. The code of both is similar to code in % compiler/parse_tree_out_pragma.m; any changes here may require % similar changes there. ( if mercury_escape_special_char(Char, QuoteChar) then RevStrings = [from_char_list(['\\', QuoteChar]) | RevStrings0] else if is_mercury_source_char(Char) then RevStrings = [string.char_to_string(Char) | RevStrings0] else RevStrings = [mercury_escape_char(Char) | RevStrings0] ). %---------------------------------------------------------------------------% quote_atom(Str, !IO) :- term_io.quote_atom_agt(Str, not_adjacent_to_graphic_token, !IO). quote_atom(Stream, S, !State) :- term_io.quote_atom_agt(Stream, S, not_adjacent_to_graphic_token, !State). quoted_atom(S) = term_io.quoted_atom_agt(S, not_adjacent_to_graphic_token). quote_atom_agt(Str, AdjacentToGraphicToken, !IO) :- io.output_stream(Stream, !IO), term_io.quote_atom_agt(Stream, Str, AdjacentToGraphicToken, !IO). quote_atom_agt(Stream, S, AdjacentToGraphicToken, !State) :- ShouldQuote = should_atom_be_quoted(S, AdjacentToGraphicToken), ( ShouldQuote = no, stream.put(Stream, S, !State) ; ShouldQuote = yes, stream.put(Stream, '''', !State), term_io.write_escaped_string(Stream, S, !State), stream.put(Stream, '''', !State) ). quoted_atom_agt(S, AdjacentToGraphicToken) = String :- ShouldQuote = should_atom_be_quoted(S, AdjacentToGraphicToken), ( ShouldQuote = no, String = S ; ShouldQuote = yes, ES = term_io.escaped_string(S), String = string.append_list(["'", ES, "'"]) ). :- func should_atom_be_quoted(string, adjacent_to_graphic_token) = bool. should_atom_be_quoted(S, AdjacentToGraphicToken) = ShouldQuote :- ( if % I didn't make these rules up: see ISO Prolog 6.3.1.3 and 6.4.2. -fjh ( % Letter digit token (6.4.2) string.index(S, 0, FirstChar), char.is_lower(FirstChar), string.is_all_alnum_or_underscore(S) ; % Semicolon token (6.4.2) S = ";" ; % Cut token (6.4.2) S = "!" ; % Graphic token (6.4.2) string.all_match(mercury_term_lexer.graphic_token_char, S), S \= "", % We need to quote tokens starting with '#', because Mercury uses % '#' to start source line number indicators. not string.index(S, 0, '#'), % If the token could be the last token in a term, and the term % could be followed with ".\n", then we need to quote the token, % otherwise the "." would be considered part of the same graphic % token. We can only leave it unquoted if we're sure it won't be % adjacent to any graphic token. AdjacentToGraphicToken = not_adjacent_to_graphic_token ; % 6.3.1.3: atom = open list, close list ; S = "[]" ; % 6.3.1.3: atom = open curly, close curly ; S = "{}" ) then ShouldQuote = no else % Anything else must be output as a quoted token (6.4.2). ShouldQuote = yes ). %---------------------------------------------------------------------------% integer_base_int(base_2) = 2. integer_base_int(base_8) = 8. integer_base_int(base_10) = 10. integer_base_int(base_16) = 16. integer_base_prefix(base_2) = "0b". integer_base_prefix(base_8) = "0o". integer_base_prefix(base_10) = "". integer_base_prefix(base_16) = "0x". %---------------------------------------------------------------------------% mercury_escape_char(Char) = EscapeCode :- char.to_int(Char, Int), string.int_to_base_string(Int, 8, OctalString0), string.pad_left(OctalString0, '0', 3, OctalString), EscapeCode = "\\" ++ OctalString ++ "\\". %---------------------------------------------------------------------------% % Currently we only allow the following characters. % XXX should we just use is_printable(Char) instead? % % Note: the code here is similar to code in runtime/mercury_trace_base.c; % any changes here may require similar changes there. % Codepoints in 0x20..0x2f. is_mercury_punctuation_char(' '). is_mercury_punctuation_char('!'). is_mercury_punctuation_char('"'). is_mercury_punctuation_char('#'). is_mercury_punctuation_char('$'). is_mercury_punctuation_char('%'). is_mercury_punctuation_char('&'). is_mercury_punctuation_char(''''). is_mercury_punctuation_char('('). is_mercury_punctuation_char(')'). is_mercury_punctuation_char('*'). is_mercury_punctuation_char('+'). is_mercury_punctuation_char(','). is_mercury_punctuation_char('-'). is_mercury_punctuation_char('.'). is_mercury_punctuation_char('/'). % Codepoints in 0x3a..0x40. is_mercury_punctuation_char(':'). is_mercury_punctuation_char(';'). is_mercury_punctuation_char('<'). is_mercury_punctuation_char('='). is_mercury_punctuation_char('>'). is_mercury_punctuation_char('?'). is_mercury_punctuation_char('@'). % Codepoints in 0x5b..0x60. is_mercury_punctuation_char('['). is_mercury_punctuation_char('\\'). is_mercury_punctuation_char(']'). is_mercury_punctuation_char('^'). is_mercury_punctuation_char('_'). is_mercury_punctuation_char('`'). % Codepoints in 0x7b..0x7e. is_mercury_punctuation_char('{'). is_mercury_punctuation_char('|'). is_mercury_punctuation_char('~'). is_mercury_punctuation_char('}'). %---------------------------------------------------------------------------% :- pragma promise_equivalent_clauses(pred(encode_escaped_char/2)). encode_escaped_char(Char::in, Str::out) :- ( if mercury_escape_special_char(Char, EscapeChar) then string.from_char_list(['\\', EscapeChar], Str) else if is_mercury_source_char(Char) then string.from_char_list([Char], Str) else fail ). encode_escaped_char(Char::out, Str::in) :- % XXX ILSEQ Decide what to do with ill-formed sequences. string.to_char_list(Str, Chars), ( Chars = [Char] ; Chars = ['\\', EscapedChar], mercury_escape_special_char(Char, EscapedChar) ). % mercury_escape_special_char(Char, EscapeChar) is true iff Char % is character for which there is a special backslash-escape character % EscapeChar that can be used after a backslash in string literals or % atoms to represent Char. % % Note: the code here is similar to code in compiler/mercury_to_mercury.m; % any changes here may require similar changes there. % Likewise for the similar code in library/rtti_implementation.m. % :- pred mercury_escape_special_char(char, char). :- mode mercury_escape_special_char(in, out) is semidet. :- mode mercury_escape_special_char(out, in) is semidet. mercury_escape_special_char('\a', 'a'). mercury_escape_special_char('\b', 'b'). mercury_escape_special_char('\f', 'f'). mercury_escape_special_char('\n', 'n'). mercury_escape_special_char('\r', 'r'). mercury_escape_special_char('\t', 't'). mercury_escape_special_char('\v', 'v'). mercury_escape_special_char('\\', '\\'). mercury_escape_special_char('''', ''''). mercury_escape_special_char('"', '"'). %---------------------------------------------------------------------------% :- end_module term_io. %---------------------------------------------------------------------------%