diff: more io__write improvements

[Fergus Henderson]

Hi,

Zoltan, can you please review this one?

library/io.m:
library/term_io.m:
	Change `io__write' and `term_io__write_term' so that they
	don't insert unnecessary parentheses or unnecessarily quote
	operators.  Also make sure that they parenthesize operators
	used as operands.

library/lexer.m:
	Export lexer__graphic_token_char/1, for use by term_io__quote_atom.

Index: lexer.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/lexer.m,v
retrieving revision 1.21
diff -u -r1.21 lexer.m
--- lexer.m	1997/02/19 05:32:59	1.21
+++ lexer.m	1997/04/28 16:53:28
@@ -58,6 +58,16 @@
 %	Convert a token to a human-readable string describing the token.
 
 %-----------------------------------------------------------------------------%
+:- implementation.
+%-----------------------------------------------------------------------------%
+:- interface.
+
+	% lexer__graphic_token_char(Char): true iff `Char'
+	% is "graphic token char" (ISO Prolog 6.4.2).
+	% This is exported for use by term_io__quote_atom.
+:- pred lexer__graphic_token_char(character).
+:- mode lexer__graphic_token_char(in) is semidet.
+%-----------------------------------------------------------------------------%
 
 :- implementation.
 :- import_module require.
@@ -232,9 +242,6 @@
 lexer__special_token(',', comma).
 lexer__special_token(';', name(";")).
 lexer__special_token('!', name("!")).
-
-:- pred lexer__graphic_token_char(character).
-:- mode lexer__graphic_token_char(in) is semidet.
 
 lexer__graphic_token_char('#').
 lexer__graphic_token_char('$').
Index: io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.117
diff -u -r1.117 io.m
--- io.m	1997/04/28 12:13:02	1.117
+++ io.m	1997/04/28 14:55:37
@@ -1229,6 +1229,13 @@
 :- mode io__write_univ(in, di, uo) is det.
 
 io__write_univ(Univ) -->
+	{ ops__max_priority(MaxPriority) },
+	io__write_univ(Univ, MaxPriority + 1).
+
+:- pred io__write_univ(univ, ops__priority, io__state, io__state).
+:- mode io__write_univ(in, in, di, uo) is det.
+
+io__write_univ(Univ, Priority) -->
 	%
 	% we need to special-case the builtin types:
 	%	int, char, float, string
@@ -1265,7 +1272,7 @@
 		{ varset__init(VarSet) },
 		term_io__write_term(VarSet, Term)
 	;
-		io__write_ordinary_term(Univ)
+		io__write_ordinary_term(Univ, Priority)
 	).
 
 :- pred io__write_univ_as_univ(univ, io__state, io__state).
@@ -1279,10 +1286,10 @@
 	io__write_string(type_name(univ_type(Univ))),
 	io__write_string(")").
 
-:- pred io__write_ordinary_term(T, io__state, io__state).
-:- mode io__write_ordinary_term(in, di, uo) is det.
+:- pred io__write_ordinary_term(univ, ops__priority, io__state, io__state).
+:- mode io__write_ordinary_term(in, in, di, uo) is det.
 
-io__write_ordinary_term(Term) -->
+io__write_ordinary_term(Term, Priority) -->
 	{ expand(Term, Functor, _Arity, Args) },
 	io__get_op_table(OpTable),
 	(
@@ -1307,46 +1314,67 @@
 		io__write_string(" }")
 	;
 		{ Args = [PrefixArg] },
-		{ ops__lookup_prefix_op(OpTable, Functor, _, _) }
+		{ ops__lookup_prefix_op(OpTable, Functor,
+			OpPriority, OpAssoc) }
 	->
-		io__write_char('('),
+		maybe_write_char('(', Priority, OpPriority),
 		term_io__quote_atom(Functor),
 		io__write_char(' '),
-		io__write_univ(PrefixArg),
-		io__write_char(')')
+		{ adjust_priority(OpPriority, OpAssoc, NewPriority) },
+		io__write_univ(PrefixArg, NewPriority),
+		maybe_write_char(')', Priority, OpPriority)
 	;
 		{ Args = [PostfixArg] },
-		{ ops__lookup_postfix_op(OpTable, Functor, _, _) }
+		{ ops__lookup_postfix_op(OpTable, Functor,
+			OpPriority, OpAssoc) }
 	->
-		io__write_char('('),
-		io__write_univ(PostfixArg),
+		maybe_write_char('(', Priority, OpPriority),
+		{ adjust_priority(OpPriority, OpAssoc, NewPriority) },
+		io__write_univ(PostfixArg, NewPriority),
 		io__write_char(' '),
 		term_io__quote_atom(Functor),
-		io__write_char(')')
+		maybe_write_char(')', Priority, OpPriority)
 	;
 		{ Args = [Arg1, Arg2] },
-		{ ops__lookup_infix_op(OpTable, Functor, _, _, _) }
+		{ ops__lookup_infix_op(OpTable, Functor, 
+			OpPriority, LeftAssoc, RightAssoc) }
 	->
-		io__write_char('('),
-		io__write_univ(Arg1),
+		maybe_write_char('(', Priority, OpPriority),
+		{ adjust_priority(OpPriority, LeftAssoc, LeftPriority) },
+		io__write_univ(Arg1, LeftPriority),
 		io__write_char(' '),
 		term_io__quote_atom(Functor),
 		io__write_char(' '),
-		io__write_univ(Arg2),
-		io__write_char(')')
+		{ adjust_priority(OpPriority, RightAssoc, RightPriority) },
+		io__write_univ(Arg2, RightPriority),
+		maybe_write_char(')', Priority, OpPriority)
 	;
 		{ Args = [Arg1, Arg2] },
-		{ ops__lookup_binary_prefix_op(OpTable, Functor, _, _, _) }
+		{ ops__lookup_binary_prefix_op(OpTable, Functor,
+			OpPriority, FirstAssoc, SecondAssoc) }
 	->
-		io__write_char('('),
+		maybe_write_char('(', Priority, OpPriority),
 		term_io__quote_atom(Functor),
 		io__write_char(' '),
-		io__write_univ(Arg1),
+		{ adjust_priority(OpPriority, FirstAssoc, FirstPriority) },
+		io__write_univ(Arg1, FirstPriority),
 		io__write_char(' '),
-		io__write_univ(Arg2),
-		io__write_char(')')
+		{ adjust_priority(OpPriority, SecondAssoc, SecondPriority) },
+		io__write_univ(Arg2, SecondPriority),
+		maybe_write_char(')', Priority, OpPriority)
 	;
-		term_io__quote_atom(Functor),
+		(
+			{ Args = [] },
+			{ ops__lookup_op(OpTable, Functor) },
+			{ ops__max_priority(MaxPriority) },
+			{ Priority =< MaxPriority }
+		->
+			io__write_char('('),
+			term_io__quote_atom(Functor),
+			io__write_char(')')
+		;
+			term_io__quote_atom(Functor)
+		),
 		(
 			{ Args = [X|Xs] }
 		->
@@ -1358,6 +1386,23 @@
 			[]
 		)
 	).
+
+:- pred maybe_write_char(char, ops__priority, ops__priority,
+			io__state, io__state).
+:- mode maybe_write_char(in, in, in, di, uo) is det.
+
+maybe_write_char(Char, Priority, OpPriority) -->
+	( { OpPriority > Priority } ->
+		io__write_char(Char)
+	;
+		[]
+	).
+
+:- pred adjust_priority(ops__priority, ops__assoc, ops__priority).
+:- mode adjust_priority(in, in, out) is det.
+
+adjust_priority(Priority, y, Priority).
+adjust_priority(Priority, x, Priority - 1).
 
 :- pred io__write_list_tail(univ, io__state, io__state).
 :- mode io__write_list_tail(in, di, uo) is det.
Index: term_io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/term_io.m,v
retrieving revision 1.41
diff -u -r1.41 term_io.m
--- term_io.m	1997/04/27 05:29:02	1.41
+++ term_io.m	1997/04/28 16:57:06
@@ -87,7 +87,7 @@
 
 :- implementation.
 :- import_module std_util, require.
-:- import_module parser, ops.
+:- import_module lexer, parser, ops.
 
 term_io__read_term(Result) -->
 	parser__read_term(Result).
@@ -140,10 +140,18 @@
 				io__state, io__state).
 :- mode term_io__write_term_2(in, in, in, out, out, di, uo) is det.
 
-term_io__write_term_2(term__variable(Id), VarSet0, N0, VarSet, N) -->
+term_io__write_term_2(Term, VarSet0, N0, VarSet, N) -->
+	{ ops__max_priority(MaxPriority) },
+	term_io__write_term_3(Term, MaxPriority + 1, VarSet0, N0, VarSet, N).
+
+:- pred term_io__write_term_3(term, ops__priority, varset, int, varset, int,
+				io__state, io__state).
+:- mode term_io__write_term_3(in, in, in, in, out, out, di, uo) is det.
+
+term_io__write_term_3(term__variable(Id), _, VarSet0, N0, VarSet, N) -->
 	term_io__write_variable_2(Id, VarSet0, N0, VarSet, N).
-term_io__write_term_2(term__functor(Functor, Args, _), VarSet0, N0, VarSet, N)
-		-->
+term_io__write_term_3(term__functor(Functor, Args, _), Priority,
+			VarSet0, N0, VarSet, N) -->
 	io__get_op_table(OpTable),
 	(
 		{ Functor = term__atom(".") },
@@ -170,49 +178,77 @@
 	;
 		{ Args = [PrefixArg] },
 		{ Functor = term__atom(OpName) },
-		{ ops__lookup_prefix_op(OpTable, OpName, _, _) }
+		{ ops__lookup_prefix_op(OpTable, OpName,
+			OpPriority, OpAssoc) }
 	->
-		io__write_char('('),
+		maybe_write_char('(', Priority, OpPriority),
 		term_io__write_constant(Functor),
 		io__write_char(' '),
-		term_io__write_term_2(PrefixArg, VarSet0, N0, VarSet, N),
-		io__write_char(')')
+		{ adjust_priority(OpPriority, OpAssoc, NewPriority) },
+		term_io__write_term_3(PrefixArg, NewPriority,
+				VarSet0, N0, VarSet, N),
+		maybe_write_char(')', Priority, OpPriority)
 	;
 		{ Args = [PostfixArg] },
 		{ Functor = term__atom(OpName) },
-		{ ops__lookup_postfix_op(OpTable, OpName, _, _) }
+		{ ops__lookup_postfix_op(OpTable, OpName,
+			OpPriority, OpAssoc) }
 	->
-		io__write_char('('),
-		term_io__write_term_2(PostfixArg, VarSet0, N0, VarSet, N),
+		maybe_write_char('(', Priority, OpPriority),
+		{ adjust_priority(OpPriority, OpAssoc, NewPriority) },
+		term_io__write_term_3(PostfixArg, NewPriority,
+				VarSet0, N0, VarSet, N),
 		io__write_char(' '),
 		term_io__write_constant(Functor),
-		io__write_char(')')
+		maybe_write_char(')', Priority, OpPriority)
 	;
 		{ Args = [Arg1, Arg2] },
 		{ Functor = term__atom(OpName) },
-		{ ops__lookup_infix_op(OpTable, OpName, _, _, _) }
+		{ ops__lookup_infix_op(OpTable, OpName,
+			OpPriority, LeftAssoc, RightAssoc) }
 	->
-		io__write_char('('),
-		term_io__write_term_2(Arg1, VarSet0, N0, VarSet1, N1),
+		maybe_write_char('(', Priority, OpPriority),
+		{ adjust_priority(OpPriority, LeftAssoc, LeftPriority) },
+		term_io__write_term_3(Arg1, LeftPriority,
+				VarSet0, N0, VarSet1, N1),
 		io__write_char(' '),
 		term_io__write_constant(Functor),
 		io__write_char(' '),
-		term_io__write_term_2(Arg2, VarSet1, N1, VarSet, N),
-		io__write_char(')')
+		{ adjust_priority(OpPriority, RightAssoc, RightPriority) },
+		term_io__write_term_3(Arg2, RightPriority,
+				VarSet1, N1, VarSet, N),
+		maybe_write_char(')', Priority, OpPriority)
 	;
 		{ Args = [Arg1, Arg2] },
 		{ Functor = term__atom(OpName) },
-		{ ops__lookup_binary_prefix_op(OpTable, OpName, _, _, _) }
+		{ ops__lookup_binary_prefix_op(OpTable, OpName,
+			OpPriority, FirstAssoc, SecondAssoc) }
 	->
-		io__write_char('('),
+		maybe_write_char('(', Priority, OpPriority),
 		term_io__write_constant(Functor),
 		io__write_char(' '),
-		term_io__write_term_2(Arg1, VarSet0, N0, VarSet1, N1),
+		{ adjust_priority(OpPriority, FirstAssoc, FirstPriority) },
+		term_io__write_term_3(Arg1, FirstPriority,
+				VarSet0, N0, VarSet1, N1),
 		io__write_char(' '),
-		term_io__write_term_2(Arg2, VarSet1, N1, VarSet, N),
-		io__write_char(')')
+		{ adjust_priority(OpPriority, SecondAssoc, SecondPriority) },
+		term_io__write_term_3(Arg2, SecondPriority,
+				VarSet1, N1, VarSet, N),
+		maybe_write_char(')', Priority, OpPriority)
 	;
-		term_io__write_constant(Functor),
+		(
+			{ Args = [] },
+			{ Functor = term__atom(Op) },
+			{ ops__lookup_op(OpTable, Op) },
+			{ ops__max_priority(MaxPriority) },
+			{ Priority =< MaxPriority }
+		->
+			io__write_char('('),
+			term_io__write_constant(Functor),
+			io__write_char(')')
+		;
+			term_io__write_constant(Functor)
+		),
 		(
 			{ Args = [X|Xs] }
 		->
@@ -226,6 +262,23 @@
 		)
 	).
 
+:- pred maybe_write_char(char, ops__priority, ops__priority,
+		io__state, io__state).
+:- mode maybe_write_char(in, in, in, di, uo) is det.
+
+maybe_write_char(Char, Priority, OpPriority) -->
+	( { OpPriority > Priority } ->
+		io__write_char(Char)
+	;
+		[]
+	).
+
+:- pred adjust_priority(ops__priority, ops__assoc, ops__priority).
+:- mode adjust_priority(in, in, out) is det.
+
+adjust_priority(Priority, y, Priority).
+adjust_priority(Priority, x, Priority - 1).
+
 :- pred term_io__write_list_tail(term, varset, int, varset, int,
 				io__state, io__state).
 :- mode term_io__write_list_tail(in, in, in, out, out, di, uo) is det.
@@ -286,9 +339,20 @@
 
 term_io__quote_atom(S) -->
 	(
-		{ string__first_char(S, FirstChar, Rest) },
-		{ char__is_lower(FirstChar) },
-		{ string__is_alnum_or_underscore(Rest) }
+		% I didn't make these rules up: see ISO Prolog 6.4.2
+		(
+			{ string__first_char(S, FirstChar, Rest) },
+			{ char__is_lower(FirstChar) },
+			{ string__is_alnum_or_underscore(Rest) }
+		;
+			{ S = ";" }
+		;
+			{ S = "!" }
+		;
+			{ string__to_char_list(S, Chars) },
+			{ \+ (  list__member(Char, Chars),
+				\+ lexer__graphic_token_char(Char)) }
+		)
 	->
 		io__write_string(S)
 	;

-- 
Fergus Henderson <fjh at cs.mu.oz.au>   |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>   |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3         |     -- the last words of T. S. Garp.